diff --git a/cime_config/acme/config_files.xml b/cime_config/acme/config_files.xml index 81746dac89a8..747f0c8a03eb 100644 --- a/cime_config/acme/config_files.xml +++ b/cime_config/acme/config_files.xml @@ -66,7 +66,7 @@ char - $CIMEROOT/scripts/Testing/Testcases/config_tests.xml + $CIMEROOT/cime_config/config_tests.xml test env_test.xml file containing system test descriptions diff --git a/cime_config/acme/machines/config_batch.xml b/cime_config/acme/machines/config_batch.xml index 71a4e05df786..3d3a0f511b99 100644 --- a/cime_config/acme/machines/config_batch.xml +++ b/cime_config/acme/machines/config_batch.xml @@ -79,7 +79,7 @@ qselect qsub #PBS - ^(\d+)\. + ^(\d+) -W depend=afterok:jobid %H:%M:%S @@ -164,10 +164,8 @@ - ^(\d+) -A {{ project }} - -l mppwidth={{ mppwidth }} -l nodes={{ num_nodes }} diff --git a/cime_config/acme/machines/config_machines.xml b/cime_config/acme/machines/config_machines.xml index bd79c243d960..de852e369f5f 100644 --- a/cime_config/acme/machines/config_machines.xml +++ b/cime_config/acme/machines/config_machines.xml @@ -371,6 +371,7 @@ module + git/2.1.3 python/2.7.9 gcc/5.1.0/openmpi/1.8.7 cmake/2.8.12 @@ -1014,11 +1015,11 @@ intel mpich,mpi-serial $ENV{HOME}/acme_scratch/$PROJECT - $MEMBERWORK/$PROJECT/$CASE/run + $ENV{MEMBERWORK}/$PROJECT/$CASE/run $CESMSCRATCHROOT/$CASE/bld /lustre/atlas1/cli900/world-shared/cesm/inputdata /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 - $MEMBERWORK/$PROJECT/archive/$CASE + $ENV{MEMBERWORK}/$PROJECT/archive/$CASE csm/$CASE /lustre/atlas1/cli900/world-shared/cesm/baselines /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.eos @@ -1039,12 +1040,64 @@ -n {{ num_tasks }} -N {{ tasks_per_node }} -d {{ thread_count }} - -cc {{ numa_node }} + -cc numa_node + + $MODULESHOME/init/sh + $MODULESHOME/init/csh + $MODULESHOME/init/perl.pm + $MODULESHOME/init/python.py + module + module + $MODULESHOME/bin/modulecmd perl + $MODULESHOME/bin/modulecmd python + + intel + cray + cray-parallel-netcdf + cray-libsci + cray-netcdf + cray-netcdf-hdf5parallel + netcdf + + + intel/16.0.1.150 + papi + + + PrgEnv-cray + cce cce/8.1.9 + cray-libsci/12.1.00 + + + PrgEnv-gnu + gcc gcc/4.8.0 + cray-libsci/12.1.00 + + + cray-netcdf/4.3.2 + + + cray-netcdf-hdf5parallel/4.3.3.1 + cray-parallel-netcdf/1.6.1 + + + cmake/2.8.11.2 + python/2.7.9 + + + 1 + 1 + + 64M + + + diff --git a/cime_config/cesm/config_archive.xml b/cime_config/cesm/config_archive.xml index 4e9afe97c368..92cced05564f 100644 --- a/cime_config/cesm/config_archive.xml +++ b/cime_config/cesm/config_archive.xml @@ -134,33 +134,33 @@ \.r.* unset - rpointer$NINST_STRING.wav - - $CASE.dwav$NINST_STRING.r.$DATENAME.nc,$CASE.dwav$NINST_STRING.rs1.$DATENAME.bin - + + rpointer$NINST_STRING.wav + $CASE.dwav$NINST_STRING.r.$DATENAME.nc,$CASE.dwav$NINST_STRING.rs1.$DATENAME.bin + + inflate_restart.* True_State.* Prior_Diag.* Posterior_Diag.* obs_seq.* - inflate_restart.* unset - rpointer.unset - - unset - + + rpointer.unset + unset + \.r\..* \.h.* unset - rpointer.cpl - - $CASE.cpl.r.$DATENAME.nc - + + rpointer.cpl + $CASE.cpl.r.$DATENAME.nc + diff --git a/cime_config/cesm/config_files.xml b/cime_config/cesm/config_files.xml index bcbb55130d00..1e9c4afb1b6a 100644 --- a/cime_config/cesm/config_files.xml +++ b/cime_config/cesm/config_files.xml @@ -66,7 +66,7 @@ char - $CIMEROOT/scripts/Testing/Testcases/config_tests.xml + $CIMEROOT/cime_config/config_tests.xml test env_test.xml file containing system test descriptions diff --git a/cime_config/cesm/machines/config_batch.xml b/cime_config/cesm/machines/config_batch.xml index 12c31b06e3b8..0d2fe946825e 100644 --- a/cime_config/cesm/machines/config_batch.xml +++ b/cime_config/cesm/machines/config_batch.xml @@ -424,7 +424,8 @@ - caldera + hpss + caldera regular capability diff --git a/cime_config/cesm/machines/config_build.xml b/cime_config/cesm/machines/config_build.xml index 4f743be80b24..dd0f2f12ef15 100644 --- a/cime_config/cesm/machines/config_build.xml +++ b/cime_config/cesm/machines/config_build.xml @@ -340,13 +340,9 @@ for mct, etc. -r8 - - - - - - - -Wp,-macro=no_com -convert=BIG_ENDIAN -mismatch_all + + + -Wp,-macro=no_com -convert=BIG_ENDIAN -indirect CIMEROOT/cime_config/cesm/machines/nag_mpi_argument.txt -ieee=full -O2 @@ -354,6 +350,11 @@ for mct, etc. -C=all -g -time -f2003 -ieee=stop -gline -openmp + + -mismatch_all FFLAGS @@ -944,15 +945,19 @@ for mct, etc. -DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY /usr/lib64 - mpi mpich + NETCDF_PATH NETCDF_PATH/bin/nf-config --flibs + + -lifcore + + -lifcore -mcmodel medium @@ -961,6 +966,7 @@ for mct, etc. -Wl,-rpath,COMPILER_PATH/lib/intel64 -Wl,-rpath,COMPILER_PATH/mkl/lib/intel64 -Wl,-rpath,MPI_PATH/lib + -lifcore /home/santos/pFUnit/pFUnit_Intel_3_0 @@ -1033,36 +1039,6 @@ for mct, etc. - - /usr/lib64 - mpi - - NETCDF_PATH/bin/nf-config --flibs - - - - - - -Wl,-rpath,NETCDF_PATH/lib - -Wl,-rpath,COMPILER_PATH/lib/intel64 - - - - - - -O2 - - - -O2 - - - -lgomp - -Wl,-RNETCDF_PATH/lib - -Wl,-RCOMPILER_PATH/lib - -Wl,-RCOMPILER_PATH/libso - - - /projects/install/rhel6-x86_64/ACME/AlbanyTrilinos/Albany/build/install @@ -1235,11 +1211,11 @@ for mct, etc. - -DHAVE_NANOTIME TACC_NETCDF_DIR lustre + TACC_PNETCDF_DIR @@ -1253,12 +1229,6 @@ for mct, etc. -LTACC_HDF5_LIB -lhdf5 - mpicc - mpicxx - mpif90 - icc - icpc - ifort NETCDF_PATH/bin/nf-config --flibs -LTACC_HDF5_LIB -lhdf5 @@ -1367,6 +1337,8 @@ for mct, etc. /glade/apps/opt/papi/5.3.0/intel/12.1.5/lib64 CESMDATAROOT/tools/pFUnit/pFUnit3.1_Intel15.0.1_MPI + icc + ifort MPICC MPIFC diff --git a/cime_config/cesm/machines/config_compilers.xml b/cime_config/cesm/machines/config_compilers.xml index 2e26ba7a3d70..e106a13acb36 100644 --- a/cime_config/cesm/machines/config_compilers.xml +++ b/cime_config/cesm/machines/config_compilers.xml @@ -901,17 +901,11 @@ for mct, etc. lustre $(TACC_NETCDF_DIR) - + $(TACC_PNETCDF_DIR) -DHAVE_NANOTIME - mpicc - mpif90 - mpicxx - ifort - icc - icpc -xHost -xHost $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -L$(TACC_HDF5_LIB) -lhdf5 diff --git a/cime_config/cesm/machines/config_machines.xml b/cime_config/cesm/machines/config_machines.xml index 42a883a65e24..93cd757f145e 100644 --- a/cime_config/cesm/machines/config_machines.xml +++ b/cime_config/cesm/machines/config_machines.xml @@ -95,28 +95,28 @@ PrgEnv-pgi - pgi pgi/15.10.0 + pgi pgi/16.3.0 PrgEnv-gnu/4.2.84 gcc gcc/4.8.2 - PrgEnv-cray/4.2.34 - cce cce/8.2.6 + PrgEnv-cray + cce cce/8.4.6 papi/5.3.2 - cray-mpich cray-mpich/7.3.0 - cray-libsci cray-libsci/13.3.0 - torque/5.0.1 + cray-mpich cray-mpich/7.3.3 + cray-libsci cray-libsci/16.03.1 + torque/6.0.2 - cray-netcdf-hdf5parallel/4.3.3.1 - cray-parallel-netcdf/1.6.1 + cray-netcdf-hdf5parallel/4.4.0 + cray-parallel-netcdf/1.7.0 - cray-netcdf/4.3.3.1 + cray-netcdf/4.4.0 cmake/3.1.3 @@ -554,16 +554,16 @@ cray-hdf5/1.8.16 - cray-netcdf/4.3.3.1 + cray-netcdf/4.4.0 - cray-netcdf-hdf5parallel/4.3.3.1 + cray-netcdf-hdf5parallel/4.4.0 cray-hdf5-parallel/1.8.16 - cray-parallel-netcdf/1.6.1 + cray-parallel-netcdf/1.7.0 perl/5.20.0 - cmake/3.0.0 + cmake/3.3.2 @@ -629,9 +629,9 @@ compiler/nag/6.1 - + compiler/gnu/4.8.5 diff --git a/cime_config/cesm/machines/config_pio.xml b/cime_config/cesm/machines/config_pio.xml index 4a90a9572900..591a47e3408d 100644 --- a/cime_config/cesm/machines/config_pio.xml +++ b/cime_config/cesm/machines/config_pio.xml @@ -49,6 +49,7 @@ netcdf netcdf netcdf + netcdf netcdf diff --git a/scripts/Testing/Testcases/config_tests.xml b/cime_config/config_tests.xml similarity index 87% rename from scripts/Testing/Testcases/config_tests.xml rename to cime_config/config_tests.xml index 1931be4632bd..5c86ade09e51 100644 --- a/scripts/Testing/Testcases/config_tests.xml +++ b/cime_config/config_tests.xml @@ -4,13 +4,15 @@ The following are the test functionality categories: 1) smoke tests - 2) restart tests - 3) threading/pe-count modification tests - 4) sequencing (layout) modification tests - 5) multi-instance tests - 6) archiving (short-term and long-term) tests - 7) performance tests - 8) spinup tests + 2) basic reproducibility tests + 3) restart tests + 4) threading/pe-count modification tests + 5) sequencing (layout) modification tests + 6) multi-instance tests + 7) archiving (short-term and long-term) tests + 8) performance tests + 9) spinup tests + 10) other component-specific tests NOTES: - unless otherwise noted everything is run in one executable directory @@ -29,6 +31,12 @@ SMS smoke startup test (default length) SBN smoke build-namelist test (just run preview_namelist and check_input_data) +====================================================================== + Basic reproducibility Tests +====================================================================== + +REP reproducibility: do two identical runs give the same results? + ====================================================================== Restart Tests ====================================================================== @@ -143,6 +151,13 @@ SPO smoke spinup-ocean test LAR long term archive test +====================================================================== + Other component-specific tests +====================================================================== + +LII CLM initial condition interpolation test + + --> @@ -217,6 +232,16 @@ LAR long term archive test FALSE + + For testing infra only. Insta-fail build step by failing to init. + 1 + 0 + ndays + 11 + FALSE + FALSE + + For testing infra only. Insta-fail run step. 1 @@ -227,6 +252,16 @@ LAR long term archive test FALSE + + For testing infra only. Insta-fail run step via exception. + 1 + 0 + ndays + 11 + FALSE + FALSE + + For testing infra only. Insta-pass run step. 1 @@ -303,16 +338,22 @@ LAR long term archive test CLM initial condition interpolation test (requires configuration with non-blank finidat) 1 0 - none FALSE + FALSE + never + $STOP_OPTION + $STOP_N single pe bfb test (default length) 1 - never 1 FALSE + FALSE + never + $STOP_OPTION + $STOP_N @@ -329,7 +370,10 @@ LAR long term archive test 1 TRUE TRUE - never + FALSE + none + $STOP_OPTION + $STOP_N 1 FALSE @@ -377,6 +421,17 @@ LAR long term archive test FALSE + + reproducibility test: do two runs give the same answers? + 0 + 1 + FALSE + FALSE + never + $STOP_OPTION + $STOP_N + + smoke build-namelist test (just run preview_namelist and check_input_data) 1 diff --git a/cime_config/xml_schemas/archive.xsd b/cime_config/xml_schemas/archive.xsd index 37992efaea81..12a351f9d3fd 100644 --- a/cime_config/xml_schemas/archive.xsd +++ b/cime_config/xml_schemas/archive.xsd @@ -1,49 +1,47 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - + + diff --git a/components/data_comps/dice/bld/build-namelist b/components/data_comps/dice/bld/build-namelist index 9abf6cca743e..faa1dab5fda6 100755 --- a/components/data_comps/dice/bld/build-namelist +++ b/components/data_comps/dice/bld/build-namelist @@ -306,6 +306,9 @@ if (defined $opts{'infile'}) { my %xmlvars = (); SetupTools::getxmlvars(${CASEROOT},\%xmlvars); +# need to expand DIN_LOC_ROOT first +$xmlvars{DIN_LOC_ROOT}=SetupTools::expand_xml_var($xmlvars{DIN_LOC_ROOT}, \%xmlvars); + foreach my $attr (keys %xmlvars) { $xmlvars{$attr} = SetupTools::expand_xml_var($xmlvars{$attr}, \%xmlvars); } diff --git a/components/stub_comps/satm/cpl/atm_comp_esmf.F90 b/components/stub_comps/satm/cpl/atm_comp_esmf.F90 deleted file mode 100644 index 7dc4aec95a23..000000000000 --- a/components/stub_comps/satm/cpl/atm_comp_esmf.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module atm_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: atm_init_esmf - public :: atm_run_esmf - public :: atm_final_esmf - public :: atm_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine atm_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In atm register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - atm_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - atm_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - atm_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_init_esmf -! -! !DESCRIPTION: -! initialize dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="atm_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="atm_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SATM", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Atmosphere Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Atmosphere", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "IndividualName", "Cecile Hannay", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "IndividualEmailAddress", & -! "hannay@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine atm_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_run_esmf -! -! !DESCRIPTION: -! run method for dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine atm_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine atm_final_esmf -!=============================================================================== -#endif - -end module atm_comp_esmf diff --git a/components/stub_comps/sesp/cpl/esp_comp_esmf.F90 b/components/stub_comps/sesp/cpl/esp_comp_esmf.F90 deleted file mode 100644 index 099431d210ec..000000000000 --- a/components/stub_comps/sesp/cpl/esp_comp_esmf.F90 +++ /dev/null @@ -1,164 +0,0 @@ -module esp_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: esp_init_esmf - public :: esp_run_esmf - public :: esp_final_esmf - public :: esp_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - subroutine esp_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In esp register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - esp_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - esp_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - esp_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - end subroutine esp_register_esmf - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: esp_init_esmf -! -! !DESCRIPTION: -! initialize stub esp model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - - subroutine esp_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify stub components - call ESMF_AttributeSet(export_state, name="esp_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="esp_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SESP", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "External System Processing Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2016", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "External System Processing", & - convention=convCIM, purpose=purpComp, rc=rc) -#endif - - end subroutine esp_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: esp_run_esmf -! -! !DESCRIPTION: -! run method for stub esp model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - - subroutine esp_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - - end subroutine esp_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: esp_final_esmf -! -! !DESCRIPTION: -! finalize method for stub model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - - subroutine esp_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - - end subroutine esp_final_esmf -!=============================================================================== -#endif - -end module esp_comp_esmf diff --git a/components/stub_comps/sglc/cpl/glc_comp_esmf.F90 b/components/stub_comps/sglc/cpl/glc_comp_esmf.F90 deleted file mode 100644 index 5c58235f0626..000000000000 --- a/components/stub_comps/sglc/cpl/glc_comp_esmf.F90 +++ /dev/null @@ -1,182 +0,0 @@ -module glc_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: glc_init_esmf - public :: glc_run_esmf - public :: glc_final_esmf - public :: glc_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine glc_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In glc register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - glc_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - glc_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - glc_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_init_esmf -! -! !DESCRIPTION: -! initialize dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="glc_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glclnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glcocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glcice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SGLC", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Ice Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Stephen Price", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "sprice@lanl.gov", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine glc_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_run_esmf -! -! !DESCRIPTION: -! run method for dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine glc_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine glc_final_esmf -!=============================================================================== -#endif - -end module glc_comp_esmf diff --git a/components/stub_comps/sice/cpl/ice_comp_esmf.F90 b/components/stub_comps/sice/cpl/ice_comp_esmf.F90 deleted file mode 100644 index 9d5b79a840bf..000000000000 --- a/components/stub_comps/sice/cpl/ice_comp_esmf.F90 +++ /dev/null @@ -1,176 +0,0 @@ -module ice_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ice_init_esmf - public :: ice_run_esmf - public :: ice_final_esmf - public :: ice_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine ice_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ice register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ice_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ice_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ice_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_init_esmf -! -! !DESCRIPTION: -! initialize dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="ice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="ice_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="iceberg_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SICE", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Ice Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine ice_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_run_esmf -! -! !DESCRIPTION: -! run method for dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine ice_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine ice_final_esmf -!=============================================================================== -#endif - -end module ice_comp_esmf diff --git a/components/stub_comps/slnd/cpl/lnd_comp_esmf.F90 b/components/stub_comps/slnd/cpl/lnd_comp_esmf.F90 deleted file mode 100644 index e975a9c720fb..000000000000 --- a/components/stub_comps/slnd/cpl/lnd_comp_esmf.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module lnd_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: lnd_init_esmf - public :: lnd_run_esmf - public :: lnd_final_esmf - public :: lnd_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine lnd_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In lnd register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - lnd_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - lnd_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - lnd_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_init_esmf -! -! !DESCRIPTION: -! initialize dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="lnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SLND", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Sam Levis", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "slevis@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine lnd_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_run_esmf -! -! !DESCRIPTION: -! run method for dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine lnd_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine lnd_final_esmf -!=============================================================================== -#endif - -end module lnd_comp_esmf diff --git a/components/stub_comps/socn/cpl/ocn_comp_esmf.F90 b/components/stub_comps/socn/cpl/ocn_comp_esmf.F90 deleted file mode 100644 index ece7a885ef9b..000000000000 --- a/components/stub_comps/socn/cpl/ocn_comp_esmf.F90 +++ /dev/null @@ -1,176 +0,0 @@ -module ocn_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ocn_init_esmf - public :: ocn_run_esmf - public :: ocn_final_esmf - public :: ocn_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine ocn_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ocn register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ocn_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ocn_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ocn_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_init_esmf -! -! !DESCRIPTION: -! initialize dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="ocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="ocn_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="ocnrof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SOCN", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Ocean Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Ocean", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Susan Bates", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "bates@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine ocn_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_run_esmf -! -! !DESCRIPTION: -! run method for dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine ocn_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine ocn_final_esmf -!=============================================================================== -#endif - -end module ocn_comp_esmf diff --git a/components/stub_comps/srof/cpl/rof_comp_esmf.F90 b/components/stub_comps/srof/cpl/rof_comp_esmf.F90 deleted file mode 100644 index 4bf6f66235d3..000000000000 --- a/components/stub_comps/srof/cpl/rof_comp_esmf.F90 +++ /dev/null @@ -1,182 +0,0 @@ -module rof_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: rof_init_esmf - public :: rof_run_esmf - public :: rof_final_esmf - public :: rof_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine rof_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In rof register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - rof_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - rof_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - rof_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_init_esmf -! -! !DESCRIPTION: -! initialize dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="rof_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rofice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="flood_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SROF", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "River Runoff Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2012", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "River Runoff", & - convention=convCIM, purpose=purpComp, rc=rc) - - ! call ESMF_AttributeSet(comp, "Name", "someone", & - ! convention=convCIM, purpose=purpComp, rc=rc) - ! call ESMF_AttributeSet(comp, "EmailAddress", & - ! "someon@ucar.edu", & - ! convention=convCIM, purpose=purpComp, rc=rc) - ! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & - ! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine rof_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_run_esmf -! -! !DESCRIPTION: -! run method for dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine rof_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine rof_final_esmf -!=============================================================================== -#endif - -end module rof_comp_esmf diff --git a/components/stub_comps/swav/cpl/wav_comp_esmf.F90 b/components/stub_comps/swav/cpl/wav_comp_esmf.F90 deleted file mode 100644 index f4eebc32ef65..000000000000 --- a/components/stub_comps/swav/cpl/wav_comp_esmf.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module wav_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: wav_init_esmf - public :: wav_run_esmf - public :: wav_final_esmf - public :: wav_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine wav_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In wav register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - wav_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - wav_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - wav_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_init_esmf -! -! !DESCRIPTION: -! initialize dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="wav_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="wav_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SWAV", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Wav Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Wav", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine wav_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_run_esmf -! -! !DESCRIPTION: -! run method for dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine wav_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine wav_final_esmf -!=============================================================================== -#endif - -end module wav_comp_esmf diff --git a/components/xcpl_comps/xatm/cpl/atm_comp_esmf.F90 b/components/xcpl_comps/xatm/cpl/atm_comp_esmf.F90 deleted file mode 100644 index dada3de41542..000000000000 --- a/components/xcpl_comps/xatm/cpl/atm_comp_esmf.F90 +++ /dev/null @@ -1,559 +0,0 @@ -module atm_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_a2x_fields, & - flds_x2d => seq_flds_x2a_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: atm_init_esmf - public :: atm_run_esmf - public :: atm_final_esmf - public :: atm_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'atm' ! user defined model name - integer(IN) :: ncomp =1 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data atmosphere component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine atm_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In atm register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - atm_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - atm_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - atm_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_init_esmf -! -! !DESCRIPTION: -! initialize dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - real(R8) :: nextsw_cday ! calendar of next atm shortwave - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(atm_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(atm_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(atm_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(atm_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(atm_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(atm_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(atm_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="atm_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('atm_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xatm_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xatm nxg') - call shr_mpi_bcast(nyg ,mpicom,'xatm nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xatm decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xatm nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xatm seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xatm input from file= xatm_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="atm_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="atm_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - - call seq_timemgr_EClockGetData(EClock, next_cday=nextsw_cday) - call ESMF_AttributeSet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XATM", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Atmosphere Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Atmosphere", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Cecile Hannay", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "hannay@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine atm_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_run_esmf -! -! !DESCRIPTION: -! run method for dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - real(R8) :: nextsw_cday ! calendar of next atm shortwave - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(atm_run_esmf) " - character(*), parameter :: F04 = "('(atm_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - ! update nextsw_cday - call seq_timemgr_EClockGetData (EClock, next_cday=nextsw_cday) - call ESMF_AttributeSet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine atm_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(atm_final_esmf) " - character(*), parameter :: F00 = "('(atm_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(atm_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine atm_final_esmf -!=============================================================================== -#endif - -end module atm_comp_esmf diff --git a/components/xcpl_comps/xglc/cpl/glc_comp_esmf.F90 b/components/xcpl_comps/xglc/cpl/glc_comp_esmf.F90 deleted file mode 100644 index 9bbfd675261d..000000000000 --- a/components/xcpl_comps/xglc/cpl/glc_comp_esmf.F90 +++ /dev/null @@ -1,561 +0,0 @@ -module glc_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_g2x_fields, & - flds_x2d => seq_flds_x2g_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: glc_init_esmf - public :: glc_run_esmf - public :: glc_final_esmf - public :: glc_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'glc' ! user defined model name - integer(IN) :: ncomp = 5 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data glc component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine glc_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In glc register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - glc_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - glc_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - glc_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_init_esmf -! -! !DESCRIPTION: -! initialize dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(glc_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(glc_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(glc_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(glc_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(glc_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(glc_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(glc_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="glc_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('glc_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xglc_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xglc nxg') - call shr_mpi_bcast(nyg ,mpicom,'xglc nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xglc decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xglc nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xglc seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xglc input from file= xglc_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="glc_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glclnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="glc_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glclnd_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XGLC", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Ice Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Stephen Price", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "sprice@lanl.gov", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine glc_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_run_esmf -! -! !DESCRIPTION: -! run method for dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(glc_run_esmf) " - character(*), parameter :: F04 = "('(glc_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine glc_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(glc_final_esmf) " - character(*), parameter :: F00 = "('(glc_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(glc_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine glc_final_esmf -!=============================================================================== -#endif - -end module glc_comp_esmf diff --git a/components/xcpl_comps/xice/cpl/ice_comp_esmf.F90 b/components/xcpl_comps/xice/cpl/ice_comp_esmf.F90 deleted file mode 100644 index e62f8f24dde3..000000000000 --- a/components/xcpl_comps/xice/cpl/ice_comp_esmf.F90 +++ /dev/null @@ -1,557 +0,0 @@ -module ice_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_i2x_fields, & - flds_x2d => seq_flds_x2i_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ice_init_esmf - public :: ice_run_esmf - public :: ice_final_esmf - public :: ice_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'ice' ! user defined model name - integer(IN) :: ncomp = 3 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data ice component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine ice_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ice register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ice_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ice_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ice_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_init_esmf -! -! !DESCRIPTION: -! initialize dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(ice_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(ice_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(ice_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(ice_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(ice_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(ice_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(ice_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="ice_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('ice_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xice_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xice nxg') - call shr_mpi_bcast(nyg ,mpicom,'xice nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xice decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xice nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xice seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xice input from file= xice_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="ice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="iceberg_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="ice_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="iceberg_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XICE", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Ice Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ice_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_run_esmf -! -! !DESCRIPTION: -! run method for dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(ice_run_esmf) " - character(*), parameter :: F04 = "('(ice_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - nf = esmfshr_util_ArrayGetIndex(d2x_a, "Si_ifrac", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - fptr(nf, :) = min(1.0_R8,max(0.0_R8, fptr(nf,:))) - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ice_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(ice_final_esmf) " - character(*), parameter :: F00 = "('(ice_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(ice_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine ice_final_esmf -!=============================================================================== -#endif - -end module ice_comp_esmf diff --git a/components/xcpl_comps/xlnd/cpl/lnd_comp_esmf.F90 b/components/xcpl_comps/xlnd/cpl/lnd_comp_esmf.F90 deleted file mode 100644 index 3543f9c69183..000000000000 --- a/components/xcpl_comps/xlnd/cpl/lnd_comp_esmf.F90 +++ /dev/null @@ -1,527 +0,0 @@ -module lnd_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_cdata_mod - - use seq_flds_mod , only: flds_dom => seq_flds_dom_fields, & - flds_d2x => seq_flds_l2x_fields, & - flds_x2d => seq_flds_x2l_fields - - use esmfshr_mod - -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: lnd_init_esmf - public :: lnd_run_esmf - public :: lnd_final_esmf - public :: lnd_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'lnd' ! user defined model name - integer(IN) :: ncomp = 2 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data land component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine lnd_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In lnd register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - lnd_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - lnd_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - lnd_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_init_esmf -! -! !DESCRIPTION: -! initialize dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - - integer(IN), allocatable :: gindex(:) ! global index - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! temporary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - type(ESMF_Array) :: dom_a - type(ESMF_Array) :: d2x_a, x2d_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(lnd_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(lnd_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(lnd_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(lnd_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(lnd_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(lnd_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(lnd_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xlnd_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - - close (unitn) - call shr_file_freeUnit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xlnd nxg') - call shr_mpi_bcast(nyg ,mpicom,'xlnd nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xlnd decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xlnd nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xlnd seg_len') - - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domains - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="lnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="lnd_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - - call ESMF_AttributeSet(export_state, name="lnd_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="lnd_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XLND", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Sam Levis", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "slevis@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine lnd_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_run_esmf -! -! !DESCRIPTION: -! run method for dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:),blat(:) - real(R8), pointer :: fptr(:,:) - integer :: lsize - - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - character(*), parameter :: subName = "(lnd_run_esmf) " - character(*), parameter :: F04 = "('(lnd_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a , lsize2=lsize) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - allocate(blon(lsize),blat(lsize)) - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData( EClock, curr_ymd=CurrentYMD, curr_tod=CurrentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine lnd_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: dom_a - type(ESMF_Array) :: d2x_a, x2d_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(lnd_final_esmf) " - character(*), parameter :: F00 = "('(lnd_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(lnd_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destroy Arrays - !---------------------------- - - call esmfshr_util_StateADistgridDestroy(export_state, array_name="domain", rc=rc) - call esmfshr_util_StateArrayDestroy(export_state, array_name="domain", rc=rc) - call esmfshr_util_StateArrayDestroy(export_state, array_name="d2x", rc=rc) - call esmfshr_util_StateArrayDestroy(import_state, array_name="x2d", rc=rc) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine lnd_final_esmf -!=============================================================================== -#endif - -end module lnd_comp_esmf diff --git a/components/xcpl_comps/xocn/cpl/ocn_comp_esmf.F90 b/components/xcpl_comps/xocn/cpl/ocn_comp_esmf.F90 deleted file mode 100644 index 583ac0c21c4e..000000000000 --- a/components/xcpl_comps/xocn/cpl/ocn_comp_esmf.F90 +++ /dev/null @@ -1,553 +0,0 @@ -module ocn_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_o2x_fields, & - flds_x2d => seq_flds_x2o_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ocn_init_esmf - public :: ocn_run_esmf - public :: ocn_final_esmf - public :: ocn_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'ocn' ! user defined model name - integer(IN) :: ncomp = 4 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data ocn component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine ocn_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ocn register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ocn_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ocn_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ocn_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_init_esmf -! -! !DESCRIPTION: -! initialize dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - type(ESMF_DistGrid) :: distgrid - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(ocn_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(ocn_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(ocn_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(ocn_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(ocn_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(ocn_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(ocn_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="ocn_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('ocn_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xocn_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xocn nxg') - call shr_mpi_bcast(nyg ,mpicom,'xocn nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xocn decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xocn nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xocn seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xocn input from file= xocn_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="ocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocnrof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="ocn_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocnrof_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "OCN", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Ocean Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Ocean", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Susan Bates", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "bates@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ocn_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_run_esmf -! -! !DESCRIPTION: -! run method for dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(ocn_run_esmf) " - character(*), parameter :: F04 = "('(ocn_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ocn_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(ocn_final_esmf) " - character(*), parameter :: F00 = "('(ocn_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(ocn_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine ocn_final_esmf -!=============================================================================== -#endif - -end module ocn_comp_esmf diff --git a/components/xcpl_comps/xrof/cpl/rof_comp_esmf.F90 b/components/xcpl_comps/xrof/cpl/rof_comp_esmf.F90 deleted file mode 100644 index 4780d1ffaa16..000000000000 --- a/components/xcpl_comps/xrof/cpl/rof_comp_esmf.F90 +++ /dev/null @@ -1,564 +0,0 @@ -module rof_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_r2x_fields, & - flds_x2d => seq_flds_x2r_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: rof_init_esmf - public :: rof_run_esmf - public :: rof_final_esmf - public :: rof_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'rof' ! user defined model name - integer(IN) :: ncomp = 6 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data rof component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine rof_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In rof register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - rof_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - rof_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - rof_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_init_esmf -! -! !DESCRIPTION: -! initialize dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - logical :: flood ! flood flag - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(rof_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(rof_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(rof_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(rof_init_esmf) ',a,i8,a)" - character(*), parameter :: F04 = "('(rof_init_esmf) ',a,l4)" - character(*), parameter :: F90 = "('(rof_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(rof_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(rof_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="rof_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('rof_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - flood = .false. - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xrof_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - read(unitn,*) flood - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xrof nxg') - call shr_mpi_bcast(nyg ,mpicom,'xrof nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xrof decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xrof nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xrof seg_len') - call shr_mpi_bcast(flood ,mpicom,'xrof flood') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xrof input from file= xrof_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F04) ' Flood mode : ',flood - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="rof_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rofice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="flood_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="rof_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rofice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="flood_present", value=flood, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XROF", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Rof Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Rof", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine rof_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_run_esmf -! -! !DESCRIPTION: -! run method for dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(rof_run_esmf) " - character(*), parameter :: F04 = "('(rof_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf+1) * 1.0_R8 -! lon = blon(n) -! lat = blat(n) -! fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & -! * cos (SHR_CONST_PI*lat/180.0_R8) & -! * sin((SHR_CONST_PI*lon/180.0_R8) & -! - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & -! + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine rof_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(rof_final_esmf) " - character(*), parameter :: F00 = "('(rof_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(rof_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine rof_final_esmf -!=============================================================================== -#endif - -end module rof_comp_esmf diff --git a/components/xcpl_comps/xwav/cpl/wav_comp_esmf.F90 b/components/xcpl_comps/xwav/cpl/wav_comp_esmf.F90 deleted file mode 100644 index 09dff485d4b7..000000000000 --- a/components/xcpl_comps/xwav/cpl/wav_comp_esmf.F90 +++ /dev/null @@ -1,553 +0,0 @@ -module wav_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_w2x_fields, & - flds_x2d => seq_flds_x2w_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: wav_init_esmf - public :: wav_run_esmf - public :: wav_final_esmf - public :: wav_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'wav' ! user defined model name - integer(IN) :: ncomp = 7 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data wav component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine wav_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In wav register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - wav_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - wav_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - wav_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_init_esmf -! -! !DESCRIPTION: -! initialize dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(wav_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(wav_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(wav_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(wav_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(wav_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(wav_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(wav_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="wav_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('wav_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xwav_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xwav nxg') - call shr_mpi_bcast(nyg ,mpicom,'xwav nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xwav decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xwav nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xwav seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xwav input from file= xwav_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="wav_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="wav_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XWAV", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Wave Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2013", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Wave", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine wav_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_run_esmf -! -! !DESCRIPTION: -! run method for dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(wav_run_esmf) " - character(*), parameter :: F04 = "('(wav_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine wav_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(wav_final_esmf) " - character(*), parameter :: F00 = "('(wav_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(wav_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !tcraig, Mar 2013, return here to avoid esmf abort on the destroy, bug tcx - return - - !---------------------------- - ! Destroy Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine wav_final_esmf -!=============================================================================== -#endif - -end module wav_comp_esmf diff --git a/driver_cpl/bld/build-namelist b/driver_cpl/bld/build-namelist index f98787b45f22..0e235e5b4159 100755 --- a/driver_cpl/bld/build-namelist +++ b/driver_cpl/bld/build-namelist @@ -47,7 +47,7 @@ OPTIONS NOTE: The precedence for setting the values of namelist variables is (highest to lowest): 1. values read from the file specified by -infile, - 2. values from the namelist defaults file + 2. values from the namelist defaults file EOF } @@ -192,7 +192,7 @@ EOF (-f "$perl5lib_dir/Build/Namelist.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"Build/Namelist.pm\" in directory \"$perl5lib_dir\" ** EOF -my @nl_definition_filenames = ( "namelist_definition_drv.xml", +my @nl_definition_filenames = ( "namelist_definition_drv.xml", "namelist_definition_drv_flds.xml", "namelist_definition_modio.xml" ); my @nl_definition_paths; @@ -276,34 +276,22 @@ if (defined $opts{'infile'}) { $nl->merge_nl($nl_infile_valid); } +unshift @INC, "${CIMEROOT}/utils/perl5lib"; +require Config::SetupTools; + #----------------------------------------------------------------------------------------------- # Determine xml variables #----------------------------------------------------------------------------------------------- -my %xmlvars = (); -my @files = <${CASEROOT}/*xml>; -foreach my $file (@files) { - my $xml = XML::Lite->new( "$file" ); - my @e = $xml->elements_by_name('entry'); - while ( my $e = shift @e ) { - my %a = $e->get_attributes(); - $xmlvars{$a{'id'}} = $a{'value'}; - } -} -my $DIN_LOC_ROOT = $xmlvars{'DIN_LOC_ROOT'}; -if ($print>=2) { print "inputdata root directory: $DIN_LOC_ROOT$eol"; } - -# Note - $USER is not in the config_defintion.xml file - it is only in the environment -$xmlvars{'USER'} = $ENV{'USER'}; -unshift @INC, "${CIMEROOT}/utils/perl5lib"; -require Config::SetupTools; - my %xmlvars = (); SetupTools::getxmlvars($CASEROOT, \%xmlvars); foreach my $attr (keys %xmlvars) { $xmlvars{$attr} = SetupTools::expand_xml_var($xmlvars{$attr}, \%xmlvars); } +my $DIN_LOC_ROOT = $xmlvars{'DIN_LOC_ROOT'}; +if ($print>=2) { print "inputdata root directory: $DIN_LOC_ROOT$eol"; } + #----------------------------------------------------------------------------------------------- # Read in versions fo the drv_flds_in file from different components and merge them together # Abort if there is a conflict @@ -324,14 +312,14 @@ foreach my $fldsin ( @fldsinfiles ) { if ($@) { die "$ProgName - ERROR: Invalid namelist variable in '-infile' $opts{'infile'}.\n $@"; } - + # Merge input values into namelist. Die if a conflict is found. $nl->merge_nl($nl_infile_valid, die_on_conflict=>1); } } #----------------------------------------------------------------------------------------------- -# Determine drv namelist +# Determine drv namelist #----------------------------------------------------------------------------------------------- ############################################# @@ -758,9 +746,12 @@ add_default($nl, 'pio_buffer_size_limit'); if($opts{pio_version} == 1){ add_default($nl, 'pio_rearr_comm_type', 'PIO_REARR_COMM_TYPE'=>"$xmlvars{'PIO_REARR_COMM_TYPE'}"); add_default($nl, 'pio_rearr_comm_fcd', 'PIO_REARR_COMM_FCD'=>"$xmlvars{'PIO_REARR_COMM_FCD'}"); - add_default($nl, 'pio_rearr_comm_max_pend_req', 'PIO_REARR_COMM_MAX_PEND_REQ'=>"$xmlvars{'PIO_REARR_COMM_MAX_PEND_REQ'}"); - add_default($nl, 'pio_rearr_comm_enable_hs', 'PIO_REARR_COMM_ENABLE_HS'=>"$xmlvars{'PIO_REARR_COMM_ENABLE_HS'}"); - add_default($nl, 'pio_rearr_comm_enable_isend', 'PIO_REARR_COMM_ENABLE_ISEND'=>"$xmlvars{'PIO_REARR_COMM_ENABLE_ISEND'}"); + add_default($nl, 'pio_rearr_comm_max_pend_req_comp2io', 'PIO_REARR_COMM_MAX_PEND_REQ_COMP2IO'=>"$xmlvars{'PIO_REARR_COMM_MAX_PEND_REQ_COMP2IO'}"); + add_default($nl, 'pio_rearr_comm_enable_hs_comp2io', 'PIO_REARR_COMM_ENABLE_HS_COMP2IO'=>"$xmlvars{'PIO_REARR_COMM_ENABLE_HS_COMP2IO'}"); + add_default($nl, 'pio_rearr_comm_enable_isend_comp2io', 'PIO_REARR_COMM_ENABLE_ISEND_COMP2IO'=>"$xmlvars{'PIO_REARR_COMM_ENABLE_ISEND_COMP2IO'}"); + add_default($nl, 'pio_rearr_comm_max_pend_req_io2comp', 'PIO_REARR_COMM_MAX_PEND_REQ_IO2COMP'=>"$xmlvars{'PIO_REARR_COMM_MAX_PEND_REQ_IO2COMP'}"); + add_default($nl, 'pio_rearr_comm_enable_hs_io2comp', 'PIO_REARR_COMM_ENABLE_HS_IO2COMP'=>"$xmlvars{'PIO_REARR_COMM_ENABLE_HS_IO2COMP'}"); + add_default($nl, 'pio_rearr_comm_enable_isend_io2comp', 'PIO_REARR_COMM_ENABLE_ISEND_IO2COMP'=>"$xmlvars{'PIO_REARR_COMM_ENABLE_ISEND_IO2COMP'}"); } # Note: pio_async_interface=.true. is not yet supported # If pio_async_interface is .true. or {component}_PIO_* variable is not set or set to -99 @@ -882,7 +873,7 @@ $definition->validate($nl); # (1) Write output namelist files (drv_in, and drv_flds_in) #----------------------------------------------------------------------------------------------- -# Write out drv_in namelist groups +# Write out drv_in namelist groups my @groups = qw(seq_cplflds_inparm seq_cplflds_userspec seq_infodata_inparm @@ -901,7 +892,7 @@ if ($print>=2) { print "Writing driver namelist to $outfile $eol"; } my $outfile = "./drv_flds_in"; $nl->write($outfile, 'groups'=>\@groups); if ($print>=2) { print "Writing driver fields namelist to $outfile $eol"; } - + #----------------------------------------------------------------------------------------------- # (2) Write out seq_map.rc file #----------------------------------------------------------------------------------------------- @@ -925,7 +916,7 @@ print $fh <<"EOF"; # if necessary # # NOTE: For bfb on different processor counts, set all maptypes to "X". -################################################################## +################################################################## EOF $fh->close(); diff --git a/driver_cpl/bld/namelist_files/namelist_defaults_drv.xml b/driver_cpl/bld/namelist_files/namelist_defaults_drv.xml index 625ebad5ed42..1f2925388d6a 100644 --- a/driver_cpl/bld/namelist_files/namelist_defaults_drv.xml +++ b/driver_cpl/bld/namelist_files/namelist_defaults_drv.xml @@ -180,11 +180,16 @@ .false. $PIO_REARR_COMM_TYPE $PIO_REARR_COMM_FCD -$PIO_REARR_COMM_MAX_PEND_REQ -.true. -.false. -.true. -.false. +$PIO_REARR_COMM_MAX_PEND_REQ_COMP2IO +.true. +.false. +.true. +.false. +$PIO_REARR_COMM_MAX_PEND_REQ_IO2COMP +.true. +.false. +.true. +.false. diff --git a/driver_cpl/bld/namelist_files/namelist_definition_drv.xml b/driver_cpl/bld/namelist_files/namelist_definition_drv.xml index afa439058850..b9ba7f131c7a 100644 --- a/driver_cpl/bld/namelist_files/namelist_definition_drv.xml +++ b/driver_cpl/bld/namelist_files/namelist_definition_drv.xml @@ -2116,28 +2116,54 @@ valid values: 2denable,io2comp,comp2io,disable,default -pio rearranger communication max pending req +pio rearranger communication max pending req (comp2io) -pio rearranger communication option: Enable handshake +pio rearranger communication option: Enable handshake (comp2io) default: .true. -pio rearranger communication option: Enable isends +pio rearranger communication option: Enable isends (comp2io) +default: .false. + + + +pio rearranger communication max pending req (io2comp) + + + +pio rearranger communication option: Enable handshake (io2comp) +default: .true. + + + +pio rearranger communication option: Enable isends (io2comp) default: .false. diff --git a/driver_cpl/cime_config/config_component.xml b/driver_cpl/cime_config/config_component.xml index 6528b60a1112..7abe633670c0 100644 --- a/driver_cpl/cime_config/config_component.xml +++ b/driver_cpl/cime_config/config_component.xml @@ -154,7 +154,7 @@ char - UNSET + $ENV{USER} case_desc env_case.xml case user name @@ -1146,14 +1146,6 @@ number of wav cells in j direction - DO NOT EDIT (for experts only) - - char - UNSET - build_grid - env_build.xml - grid mask - DO NOT EDIT (for experts only) - - logical TRUE,FALSE @@ -1766,14 +1758,6 @@ Machine name - - char - - case_def - env_case.xml - full pathname of file specifying supported machines location - - char @@ -2417,31 +2401,60 @@ pio rearranger communication flow control direction - + integer - 64 + 0 run_pio env_run.xml - pio rearranger communication max pending requests + pio rearranger communication max pending requests (comp2io) : 0 implies that CIME internally calculates the value ( = max(64, 2 * PIO_NUMTASKS) ), -1 implies no bound on max pending requests - + logical TRUE,FALSE TRUE run_pio env_run.xml - pio rearranger communiation options: TRUE implies enable handshake + pio rearranger communiation options (comp2io) : TRUE implies enable handshake + + + + logical + TRUE,FALSE + FALSE + run_pio + env_run.xml + pio rearranger communiation options (comp2io) : TRUE implies enable isend + + + + integer + + 64 + run_pio + env_run.xml + pio rearranger communication max pending requests (io2comp) : -1 implies no bound on max pending requests - + + + logical TRUE,FALSE FALSE run_pio env_run.xml - pio rearranger communiation options: TRUE implies enable isend + pio rearranger communiation options (io2comp) : TRUE implies enable handshake + + + + logical + TRUE,FALSE + TRUE + run_pio + env_run.xml + pio rearranger communiation options (io2comp) : TRUE implies enable isend diff --git a/externals/pio1/pio/box_rearrange.F90.in b/externals/pio1/pio/box_rearrange.F90.in index 0423d80a4a6c..cf2a87416b35 100644 --- a/externals/pio1/pio/box_rearrange.F90.in +++ b/externals/pio1/pio/box_rearrange.F90.in @@ -189,8 +189,8 @@ subroutine box_rearrange_comp2io_{TYPE} (IOsystem, ioDesc, s1, src, niodof, & ! The rearranger options in IODESC overrides the defaults if(IOsystem%rearr_opts%comm_type == PIO_rearr_comm_p2p) then - if( (IOsystem%rearr_opts%comm_fc_opts%fcd == PIO_rearr_comm_fc_2d_disable) .or.& - (IOsystem%rearr_opts%comm_fc_opts%fcd == PIO_rearr_comm_fc_1d_io2comp) ) then + if( (IOsystem%rearr_opts%fcd == PIO_rearr_comm_fc_2d_disable) .or.& + (IOsystem%rearr_opts%fcd == PIO_rearr_comm_fc_1d_io2comp) ) then pio_option = POINT_TO_POINT else pio_option = FLOW_CONTROL @@ -210,9 +210,9 @@ subroutine box_rearrange_comp2io_{TYPE} (IOsystem, ioDesc, s1, src, niodof, & endif if (pio_option == FLOW_CONTROL) then - pio_hs = IOsystem%rearr_opts%comm_fc_opts%enable_hs - pio_isend = IOsystem%rearr_opts%comm_fc_opts%enable_isend - pio_maxreq = IOsystem%rearr_opts%comm_fc_opts%max_pend_req + pio_hs = IOsystem%rearr_opts%comm_fc_opts_comp2io%enable_hs + pio_isend = IOsystem%rearr_opts%comm_fc_opts_comp2io%enable_isend + pio_maxreq = IOsystem%rearr_opts%comm_fc_opts_comp2io%max_pend_req ! The rearranger options passed to this function overrides ! both the default and the options in IODESC @@ -488,8 +488,8 @@ subroutine box_rearrange_io2comp_{TYPE} (IOsystem,ioDesc,s1, iobuf,s2, compbuf, ! The rearranger options in IODESC overrides the defaults if(IOsystem%rearr_opts%comm_type == PIO_rearr_comm_p2p) then - if( (IOsystem%rearr_opts%comm_fc_opts%fcd == PIO_rearr_comm_fc_2d_disable) .or.& - (IOsystem%rearr_opts%comm_fc_opts%fcd == PIO_rearr_comm_fc_1d_comp2io) ) then + if( (IOsystem%rearr_opts%fcd == PIO_rearr_comm_fc_2d_disable) .or.& + (IOsystem%rearr_opts%fcd == PIO_rearr_comm_fc_1d_comp2io) ) then pio_option = POINT_TO_POINT else pio_option = FLOW_CONTROL @@ -509,9 +509,9 @@ subroutine box_rearrange_io2comp_{TYPE} (IOsystem,ioDesc,s1, iobuf,s2, compbuf, endif if (pio_option == FLOW_CONTROL) then - pio_hs = IOsystem%rearr_opts%comm_fc_opts%enable_hs - pio_isend = IOsystem%rearr_opts%comm_fc_opts%enable_isend - pio_maxreq = IOsystem%rearr_opts%comm_fc_opts%max_pend_req + pio_hs = IOsystem%rearr_opts%comm_fc_opts_io2comp%enable_hs + pio_isend = IOsystem%rearr_opts%comm_fc_opts_io2comp%enable_isend + pio_maxreq = IOsystem%rearr_opts%comm_fc_opts_io2comp%max_pend_req ! The rearranger options passed to this function overrides ! both the default and the options in IODESC diff --git a/externals/pio1/pio/pio_types.F90 b/externals/pio1/pio/pio_types.F90 index 336d0d04b00e..3c6f0c78af62 100644 --- a/externals/pio1/pio/pio_types.F90 +++ b/externals/pio1/pio/pio_types.F90 @@ -79,14 +79,12 @@ module pio_types !! @defgroup PIO_rearr_comm_fc_options PIO_rearr_comm_fc_options !! @brief Type that defines the PIO rearranger options !! @details -!! - fcd : @copydoc PIO_rearr_comm_dir -!! - enable_hs : Enable handshake (true/false) +!! - enable_hs : Enable handshake (true/false) !! - enable_isend : Enable Isends (true/false) !! - max_pend_req : Maximum pending requests (To indicated unlimited !! number of requests use PIO_REARR_COMM_UNLIMITED_PEND_REQ) !> type, public :: PIO_rearr_comm_fc_opt_t - integer :: fcd ! Flow control direction logical :: enable_hs ! Enable handshake? logical :: enable_isend ! Enable isends? integer :: max_pend_req ! Maximum pending requests @@ -98,11 +96,14 @@ module pio_types !! @brief Type that defines the PIO rearranger options !! @details !! - comm_type : @copydoc PIO_rearr_comm_t +!! - fcd : @copydoc PIO_rearr_comm_dir !! - comm_fc_opts : @copydoc PIO_rearr_comm_fc_options !> type, public :: PIO_rearr_opt_t integer :: comm_type - type(PIO_rearr_comm_fc_opt_t) :: comm_fc_opts + integer :: fcd ! Flow control direction + type(PIO_rearr_comm_fc_opt_t) :: comm_fc_opts_comp2io + type(PIO_rearr_comm_fc_opt_t) :: comm_fc_opts_io2comp end type PIO_rearr_opt_t public :: PIO_rearr_comm_p2p, PIO_rearr_comm_coll,& diff --git a/externals/pio1/pio/piolib_mod.F90 b/externals/pio1/pio/piolib_mod.F90 index 2302cfb6ca56..85993aa9e38e 100644 --- a/externals/pio1/pio/piolib_mod.F90 +++ b/externals/pio1/pio/piolib_mod.F90 @@ -1600,21 +1600,25 @@ subroutine init_iosystem_rearr_options(iosystem) #endif #ifdef _NO_FLOW_CONTROL - iosystem%rearr_opts%comm_fc_opts%fcd = PIO_rearr_comm_fc_2d_disable + iosystem%rearr_opts%fcd = PIO_rearr_comm_fc_2d_disable #else - ! We ignore the following flags + ! We ignore the following flags ! 1) _MPISERIAL : The flow control code is never used when _MPISERIAL is set ! 2) _USE_COMP2IO_FC/_USE_IO2COMP_FC : These flags are not currently used ! (These were experimental flags). The user can explicitly control ! these options (comp2io and io2comp flow control) via rearranger ! options passed to pio_init() - iosystem%rearr_opts%comm_fc_opts%fcd = PIO_rearr_comm_fc_2d_enable + iosystem%rearr_opts%fcd = PIO_rearr_comm_fc_2d_enable #endif ! the following will be ignored if not p2p with flow control - iosystem%rearr_opts%comm_fc_opts%enable_hs = DEF_P2P_HANDSHAKE - iosystem%rearr_opts%comm_fc_opts%enable_isend = DEF_P2P_ISEND - iosystem%rearr_opts%comm_fc_opts%max_pend_req = DEF_P2P_MAXREQ + iosystem%rearr_opts%comm_fc_opts_comp2io%enable_hs = DEF_P2P_HANDSHAKE + iosystem%rearr_opts%comm_fc_opts_comp2io%enable_isend = DEF_P2P_ISEND + iosystem%rearr_opts%comm_fc_opts_comp2io%max_pend_req = DEF_P2P_MAXREQ + + iosystem%rearr_opts%comm_fc_opts_io2comp%enable_hs = DEF_P2P_HANDSHAKE + iosystem%rearr_opts%comm_fc_opts_io2comp%enable_isend = DEF_P2P_ISEND + iosystem%rearr_opts%comm_fc_opts_io2comp%max_pend_req = DEF_P2P_MAXREQ end subroutine init_iosystem_rearr_options diff --git a/externals/pio2/CMakeLists.txt b/externals/pio2/CMakeLists.txt index 7ddaf9a15b88..ecf7c2ad9e8f 100644 --- a/externals/pio2/CMakeLists.txt +++ b/externals/pio2/CMakeLists.txt @@ -14,18 +14,34 @@ mark_as_advanced(VERSION_MAJOR VERSION_MINOR VERSION_PATCH) #===== Library Options ===== option (PIO_ENABLE_FORTRAN "Enable the Fortran library builds" ON) option (PIO_ENABLE_TIMING "Enable the use of the GPTL timing library" ON) +option (PIO_ENABLE_ASYNC "Enable the use of asychronus IO operations" OFF) +option (PIO_ENABLE_LOGGING "Enable debug logging (large output possible)" OFF) option (PIO_TEST_BIG_ENDIAN "Enable test to see if machine is big endian" ON) option (PIO_USE_MPIIO "Enable support for MPI-IO auto detect" ON) option (PIO_USE_MPISERIAL "Enable mpi-serial support (instead of MPI)" OFF) option (PIO_USE_MALLOC "Use native malloc (instead of bget package)" OFF) option (WITH_PNETCDF "Require the use of PnetCDF" ON) +# Set a variable that appears in the config.h.in file. if(PIO_USE_MALLOC) set(USE_MALLOC 1) else() set(USE_MALLOC 0) endif() +# Set a variable that appears in the config.h.in file. +if(PIO_ENABLE_LOGGING) + set(ENABLE_LOGGING 1) +else() + set(ENABLE_LOGGING 0) +endif() + +if(PIO_USE_MPISERIAL) + set(USE_MPI_SERIAL 1) +else() + set(USE_MPI_SERIAL 0) +endif() + #===== Library Variables ===== set (PIO_FILESYSTEM_HINTS IGNORE CACHE STRING "Filesystem hints (lustre or gpfs)") diff --git a/externals/pio2/ctest/CTestEnvironment-nwsc.cmake b/externals/pio2/ctest/CTestEnvironment-nwsc.cmake index 9289e3d2cc64..bc0f5194e996 100644 --- a/externals/pio2/ctest/CTestEnvironment-nwsc.cmake +++ b/externals/pio2/ctest/CTestEnvironment-nwsc.cmake @@ -10,7 +10,7 @@ # set with existing environment variables: NETCDF, PNETCDF, HDF5, etc. # Define the extra CMake configure options -set (CTEST_CONFIGURE_OPTIONS "-DCMAKE_VERBOSE_MAKEFILE=TRUE") +set (CTEST_CONFIGURE_OPTIONS "-DCMAKE_VERBOSE_MAKEFILE=TRUE -DPIO_ENABLE_ASYNC=TRUE") # If MPISERIAL environment variable is set, then enable MPISERIAL if (DEFINED ENV{MPISERIAL}) diff --git a/externals/pio2/ctest/runcdash-cgd-nag.sh b/externals/pio2/ctest/runcdash-cgd-nag.sh index 44ced7862005..f81102d8ff14 100755 --- a/externals/pio2/ctest/runcdash-cgd-nag.sh +++ b/externals/pio2/ctest/runcdash-cgd-nag.sh @@ -8,8 +8,8 @@ else fi module purge -module load compiler/nag/6.0 -module load tool/parallel-netcdf/1.6.1/nag/openmpi +module load compiler/nag/6.1 +module load tool/parallel-netcdf/1.7.0/nag/mvapich2 export CC=mpicc export FC=mpif90 @@ -17,7 +17,7 @@ export PIO_DASHBOARD_SITE="cgd" export PIO_DASHBOARD_ROOT=/scratch/cluster/katec/dashboard export CTEST_SCRIPT_DIRECTORY=${PIO_DASHBOARD_ROOT}/src export PIO_DASHBOARD_SOURCE_DIR=${CTEST_SCRIPT_DIRECTORY} -export PIO_COMPILER_ID=Nag-6.0-gcc-`gcc --version | head -n 1 | cut -d' ' -f3` +export PIO_COMPILER_ID=Nag-6.1-gcc-`gcc --version | head -n 1 | cut -d' ' -f3` if [ ! -d "$PIO_DASHBOARD_ROOT" ]; then mkdir "$PIO_DASHBOARD_ROOT" diff --git a/externals/pio2/ctest/runctest-cgd.sh b/externals/pio2/ctest/runctest-cgd.sh index 02c99d10b4a1..34233e20cf07 100755 --- a/externals/pio2/ctest/runctest-cgd.sh +++ b/externals/pio2/ctest/runctest-cgd.sh @@ -29,7 +29,7 @@ echo "\$CTESTCMD -S ${scrdir}/CTestScript-Test.cmake,${model} -V" >> runctest.sh chmod +x runctest.sh # Submit the job to the queue -jobid=`/usr/local/bin/qsub -l nodes=1:ppn=4 runctest.sh` +jobid=`/usr/local/bin/qsub -l nodes=1:ppn=4 runctest.sh -q short` # Wait for the job to complete before exiting while true; do diff --git a/externals/pio2/doc/CMakeLists.txt b/externals/pio2/doc/CMakeLists.txt index 8e0ffa2e5878..0294c950a40c 100644 --- a/externals/pio2/doc/CMakeLists.txt +++ b/externals/pio2/doc/CMakeLists.txt @@ -5,17 +5,30 @@ #============================================================================== find_package(Doxygen) + +# This supports the build with/witout async code. Once async code is +# fully merged, remove the definition of C_SRC_FILES and its mention +# in Doxyfile.in for simplicity. +if (PIO_ENABLE_ASYNC) + SET(C_SRC_FILES "@CMAKE_CURRENT_SOURCE_DIR@/../src/clib/bget.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pioc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pioc_sc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_darray_async.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_get_nc_async.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_internal.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_nc4.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_put_nc_async.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_spmd.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/bget.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pioc_support.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_lists.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_nc_async.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_varm.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/dtypes.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_file.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_msg.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_rearrange.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/topology.c") +else () + SET(C_SRC_FILES "@CMAKE_CURRENT_SOURCE_DIR@/../src/clib/bget.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pioc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pioc_sc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_internal.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_nc4.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_spmd.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/bget.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pioc_support.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_darray.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_get_nc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_lists.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_put_nc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_varm.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/dtypes.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_file.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio.h @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_msg.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_nc.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/pio_rearrange.c @CMAKE_CURRENT_SOURCE_DIR@/../src/clib/topology.c") +endif () + if(DOXYGEN_FOUND) - configure_file(${CMAKE_CURRENT_SOURCE_DIR}/Doxyfile.in - ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile @ONLY) - add_custom_target(doc - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/customdoxygen.css - ${CMAKE_CURRENT_BINARY_DIR} - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/DoxygenLayout.xml - ${CMAKE_CURRENT_BINARY_DIR} - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/doxygen.sty - ${CMAKE_CURRENT_BINARY_DIR} - COMMAND ${DOXYGEN_EXECUTABLE} ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile - WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} - COMMENT "Generating API documentation with Doxygen" VERBATIM) + # Process the Doxyfile using options set during configure. + configure_file(${CMAKE_CURRENT_SOURCE_DIR}/Doxyfile.in + ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile @ONLY) + + # Copy necessary files. + add_custom_target(doc + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/customdoxygen.css + ${CMAKE_CURRENT_BINARY_DIR} + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/DoxygenLayout.xml + ${CMAKE_CURRENT_BINARY_DIR} + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/doxygen.sty + ${CMAKE_CURRENT_BINARY_DIR} + COMMAND ${DOXYGEN_EXECUTABLE} ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Generating API documentation with Doxygen" VERBATIM) endif(DOXYGEN_FOUND) diff --git a/externals/pio2/doc/Doxyfile.in b/externals/pio2/doc/Doxyfile.in index 0cafd81717d0..c39e69b13d28 100644 --- a/externals/pio2/doc/Doxyfile.in +++ b/externals/pio2/doc/Doxyfile.in @@ -291,7 +291,7 @@ OPTIMIZE_OUTPUT_VHDL = NO # Note that for custom extensions you also need to set FILE_PATTERNS otherwise # the files are not read by doxygen. -EXTENSION_MAPPING = F90=FortranFree +EXTENSION_MAPPING = F90=FortranFree # If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments # according to the Markdown format, which allows for more readable @@ -769,11 +769,15 @@ WARN_LOGFILE = # Note: If this tag is empty the current directory is searched. INPUT = @CMAKE_CURRENT_SOURCE_DIR@/source \ - @CMAKE_CURRENT_SOURCE_DIR@/../src/clib \ @CMAKE_CURRENT_SOURCE_DIR@/../src/flib \ @CMAKE_CURRENT_SOURCE_DIR@/../examples/c \ @CMAKE_CURRENT_SOURCE_DIR@/../examples/f03 \ - @CMAKE_BINARY_DIR@/src/flib + @CMAKE_BINARY_DIR@/src/clib \ + @CMAKE_BINARY_DIR@/src/flib \ + @C_SRC_FILES@ + +# Uncomment this after the async code is fully merged into PIO. +# @CMAKE_CURRENT_SOURCE_DIR@/../src/clib # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses diff --git a/externals/pio2/doc/source/Error.txt b/externals/pio2/doc/source/Error.txt index 774e11039d77..72c0da23e205 100644 --- a/externals/pio2/doc/source/Error.txt +++ b/externals/pio2/doc/source/Error.txt @@ -1,19 +1,19 @@ /****************************************************************************** * + * * - * - * Copyright (C) 2009 + * Copyright (C) 2009 * * Permission to use, copy, modify, and distribute this software and its - * documentation under the terms of the GNU General Public License is hereby - * granted. No representations are made about the suitability of this software + * documentation under the terms of the GNU General Public License is hereby + * granted. No representations are made about the suitability of this software * for any purpose. It is provided "as is" without express or implied warranty. * See the GNU General Public License for more details. * * Documents produced by Doxygen are derivative works derived from the * input used in their production; they are not affected by this license. * - */ /*! + */ /*! \page error Error Handling By default, PIO handles errors internally by printing a string @@ -21,9 +21,6 @@ describing the error and then calling mpi_abort. Application developers can change this behaivior with a call to \ref PIO_seterrorhandling -For example, if a developer wanted -to see if an input netcdf file contained the variable 'U' they might do the following: - \verbinclude errorhandle \copydoc PIO_error_method diff --git a/externals/pio2/doc/source/Examples.txt b/externals/pio2/doc/source/Examples.txt index 85da90cddfdd..e18d2926c7c0 100644 --- a/externals/pio2/doc/source/Examples.txt +++ b/externals/pio2/doc/source/Examples.txt @@ -1,12 +1,12 @@ /****************************************************************************** * + * * - * - * Copyright (C) 2009 + * Copyright (C) 2009 * * Permission to use, copy, modify, and distribute this software and its - * documentation under the terms of the GNU General Public License is hereby - * granted. No representations are made about the suitability of this software + * documentation under the terms of the GNU General Public License is hereby + * granted. No representations are made about the suitability of this software * for any purpose. It is provided "as is" without express or implied warranty. * See the GNU General Public License for more details. * @@ -41,11 +41,13 @@ The Fortran examples are in the examples/f03 subdirectory. - examplePio.f90 A simple example showing a write, then read, of a 1D variable. - PIO has been implemented in several geophysical component models, including the -Community Atmosphere Model (CAM), the Community Land Model (CLM), the Parallel Ocean Program -(POP), the Community Ice CodE (CICE), and coupler for used by CCSM4.0 (CPL7). We also provide -several simpler example code as well as a test code that is suitable for regression testing and -benchmarking. +### Other Examples + + PIO has been implemented in several geophysical component models, including the +Community Atmosphere Model (CAM), the Community Land Model (CLM), the Parallel Ocean Program +(POP), the Community Ice CodE (CICE), and coupler for used by CCSM4.0 (CPL7). We also provide +several simpler example code as well as a test code that is suitable for regression testing and +benchmarking. - \subpage CAMexample - \subpage testpio_example diff --git a/externals/pio2/doc/source/Installing.txt b/externals/pio2/doc/source/Installing.txt index cf4cec0101e1..6f2811522488 100644 --- a/externals/pio2/doc/source/Installing.txt +++ b/externals/pio2/doc/source/Installing.txt @@ -1,12 +1,12 @@ /****************************************************************************** * - * + * * * Copyright (C) 2013 * * Permission to use, copy, modify, and distribute this software and its - * documentation under the terms of the GNU General Public License is hereby - * granted. No representations are made about the suitability of this software + * documentation under the terms of the GNU General Public License is hereby + * granted. No representations are made about the suitability of this software * for any purpose. It is provided "as is" without express or implied warranty. * See the GNU General Public License for more details. * @@ -20,9 +20,9 @@ The PIO code is currently stored on github at setenv DAV_CORES 4 + > execca ctest + +## PIO2 Performance Test + +To run the performance tests, you will need to add two files to the **tests/performance** subdirectory of the PIO build directory. First, you will need a decomp file. You can download one from our google code page here: +https://svn-ccsm-piodecomps.cgd.ucar.edu/trunk/ . +You can use any of these files, and save them to your home or base work directory. Secondly, you will need to add a namelist file, named "pioperf.nl". Save this file in the directory with your **pioperf** executable (this is found in the **tests/performance** subdirectory of the PIO build directory). + + +The contents of the namelist file should look like: + + &pioperf + + decompfile = "/u/home/user/piodecomp30tasks01dims06.dat" + + pio_typenames = 'pnetcdf' + + niotasks = 30 + + rearrangers = 1 + + nvars = 2 + + / + +Here, the second line ("decompfile") points to the path for your decomp file (wherever you saved it). For the rest of the lines, each item added to the list adds another test to be run. For instance, to test all of the types of supported IO, your pio_typenames would look like: + + pio_typenames = 'pnetcdf','netcdf','netcdf4p','netcdf4c' + +HDF5 is netcdf4p, and Parallel-Netcdf is pnetcdf. + +To test with different numbers of IO tasks, you could do: + + niotasks = 30,15,5 + +(These tasks are the subset of the run tasks that are designated IO tasks) + +To test with both of the rearranger algorithms: + + rearrangers = 1,2 + +(Each rearranger is a different algorithm for converting from data in memory to data in a file on disk. The first one, BOX, is the older method from PIO1, the second, SUBSET, is a newer method that seems to be more efficient in large numbers of tasks) + +To test with different numbers of variables: + + nvars = 8,5,3,2 + +(The more variables you use, the higher data throughput goes, usually) + +To run, submit a job with 'pioperf' as the executable, and at least as many tasks as you have specified in the decomposition file. On yellowstone, a submit script could look like: + + #!/bin/tcsh + + #BSUB -P P00000000 # project code + #BSUB -W 00:10 # wall-clock time (hrs:mins) + #BSUB -n 30 # number of tasks in job + #BSUB -R "span[ptile=16]" # run 16 MPI tasks per node + #BSUB -J pio_perftest # job name + #BSUB -o pio_perftest.%J.out # output file name in which %J is replaced by the job ID + #BSUB -e pio_perftest.%J.err # error file name in which %J is replaced by the job ID + #BSUB -q small # queue + + #run the executable + mpirun.lsf /glade/p/work/katec/pio_work/pio_build/tests/performance/pioperf + +The result(s) will look like a line in the output file such as: +~~~~~~~~~~~~~~ +RESULT: write BOX 4 30 2 16.9905924688 +~~~~~~~~~~~~~~ + +You can decode this as: +1. Read/write describes the io operation performed +2. BOX/SUBSET is the algorithm for the rearranger (as described above) +3. 4 [1-4] is the io library used for the operation. The options here are [1] Parallel-netcdf [2] NetCDF3 [3] NetCDF4-Compressed [4] NetCDF4-Parallel +4. 30 [any number] is the number of io-specific tasks used in the operation. Must be less than the number of MPI tasks used in the test. +5. 2 [any number] is the number of variables read or written during the operation +6. 16.9905924688 [any number] is the Data Rate of the operation in MB/s. This is the important value for determining performance of the system. The higher this numbre is, the better the PIO2 library is performing for the given operation. + +_Last updated: 05-17-2016_ +*/ diff --git a/externals/pio2/doc/source/base.txt b/externals/pio2/doc/source/base.txt index 41c5b21089df..2108786f13cd 100644 --- a/externals/pio2/doc/source/base.txt +++ b/externals/pio2/doc/source/base.txt @@ -1,20 +1,20 @@ /****************************************************************************** * + * * - * - * Copyright (C) 2009 + * Copyright (C) 2009 * * Permission to use, copy, modify, and distribute this software and its - * documentation under the terms of the GNU General Public License is hereby - * granted. No representations are made about the suitability of this software + * documentation under the terms of the GNU General Public License is hereby + * granted. No representations are made about the suitability of this software * for any purpose. It is provided "as is" without express or implied warranty. * See the GNU General Public License for more details. * * Documents produced by Doxygen are derivative works derived from the * input used in their production; they are not affected by this license. * - */ -/*! + */ +/*! \mainpage Parallel I/O library (PIO) @@ -35,13 +35,15 @@ PIO2 represents a significant rewrite of the PIO library and includes a C API as well as the original F90 API. A new decomposition strategy has been introduced which gives the user more ability to tune io communications. -This user's guide provides information about the PIO library and examples on how it can be used. +This user's guide provides information about the PIO library and examples on how it can be used. Please review the ChangeLog that is included with the distribution for up-to-date release information. - \ref intro - \ref install + - \ref mach_walkthrough - \ref decomp - \ref error + - \ref test - \ref examp - \ref faq - \ref api diff --git a/externals/pio2/doc/source/mach_walkthrough.txt b/externals/pio2/doc/source/mach_walkthrough.txt index 7741c44e8e4c..a208e132956c 100644 --- a/externals/pio2/doc/source/mach_walkthrough.txt +++ b/externals/pio2/doc/source/mach_walkthrough.txt @@ -44,7 +44,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load git/2.3.0
%> module load cmake/3.0.2
%> module load netcdf-mpi/4.3.3.1
- %> module load pnetcdf/1.6.0
+ %> module load pnetcdf/1.6.1
+ GNU @@ -54,7 +54,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load git/2.3.0
%> module load cmake/3.0.2
%> module load netcdf-mpi/4.3.3.1
- %> module load pnetcdf/1.6.0
+ %> module load pnetcdf/1.6.1
+ PGI @@ -64,7 +64,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load git/2.3.0
%> module load cmake/3.0.2
%> module load netcdf-mpi/4.3.3.1
- %> module load pnetcdf/1.6.0
+ %> module load pnetcdf/1.6.1
  • Environment Variables @@ -103,7 +103,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load cmake/3.0.0
    %> module load cray-hdf5-parallel/1.8.14
    %> module load cray-netcdf-hdf5parallel/4.3.3.1
    - %> module load cray-parallel-netcdf/1.6.0
    + %> module load cray-parallel-netcdf/1.6.1
    + GNU @@ -117,7 +117,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load cmake/3.0.0
    %> module load cray-hdf5-parallel/1.8.14
    %> module load cray-netcdf-hdf5parallel/4.3.3.1
    - %> module load cray-parallel-netcdf/1.6.0
    + %> module load cray-parallel-netcdf/1.6.1
    + Cray @@ -132,7 +132,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load cmake/3.0.0
    %> module load cray-hdf5-parallel/1.8.14
    %> module load cray-netcdf-hdf5parallel/4.3.3.1
    - %> module load cray-parallel-netcdf/1.6.0
    + %> module load cray-parallel-netcdf/1.6.1
  • Environment Variables @@ -178,7 +178,7 @@ And then set the following environment variables to add in the rest of the libra %> setenv LIBZ /soft/libraries/alcf/current/xl/ZLIB
    %> setenv HDF5 /soft/libraries/hdf5/1.8.14/cnk-xl/V1R2M2-20150213
    %> setenv NETCDF /soft/libraries/netcdf/4.3.3-f4.4.1/cnk-xl/V1R2M2-20150213
    - %> setenv PNETCDF /soft/libraries/pnetcdf/1.6.0/cnk-xl/V1R2M2-20150213
    + %> setenv PNETCDF /soft/libraries/pnetcdf/1.6.1/cnk-xl/V1R2M2-20150213
    %> setenv CC /soft/compilers/wrappers/xl/mpixlc_r
    %> setenv FC /soft/compilers/wrappers/xl/mpixlf90_r
    @@ -209,7 +209,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load cmake
    %> module load cray-hdf5-parallel/1.8.14
    %> module load cray-netcdf-hdf5parallel/4.3.3.1
    - %> module load cray-parallel-netcdf/1.6.0
    + %> module load cray-parallel-netcdf/1.6.1
    + PGI @@ -219,7 +219,7 @@ Modules required for installation depend on your prefered compiler. Issue the co %> module load cmake
    %> module load cray-hdf5-parallel/1.8.14
    %> module load cray-netcdf-hdf5parallel/4.3.3.1
    - %> module load cray-parallel-netcdf/1.6.0
    + %> module load cray-parallel-netcdf/1.6.1
  • Environment Variables @@ -477,5 +477,5 @@ variables to these tests will increase the time significantly. -_Last updated: 11-18-2015_ +_Last updated: 05-16-2016_ */ diff --git a/externals/pio2/examples/c/example2.c b/externals/pio2/examples/c/example2.c index f4b75d075b74..d86af67774c0 100644 --- a/externals/pio2/examples/c/example2.c +++ b/externals/pio2/examples/c/example2.c @@ -48,8 +48,8 @@ * responsibilty for writing and reading them will be spread between * all the processors used to run this example. */ /**@{*/ -#define X_DIM_LEN 400 -#define Y_DIM_LEN 400 +#define X_DIM_LEN 20 +#define Y_DIM_LEN 30 /**@}*/ /** The number of timesteps of data to write. */ diff --git a/externals/pio2/examples/c/valsupp_example1.supp b/externals/pio2/examples/c/valsupp_example1.supp new file mode 100644 index 000000000000..63f3e073836d --- /dev/null +++ b/externals/pio2/examples/c/valsupp_example1.supp @@ -0,0 +1,15 @@ +{ + cond_jump_1 + Memcheck:Cond + fun:MPIC_Waitall + fun:MPIR_Alltoallw_intra + fun:MPIR_Alltoallw + fun:MPIR_Alltoallw_impl + fun:PMPI_Alltoallw + fun:pio_swapm + fun:rearrange_comp2io + fun:PIOc_write_darray_multi + fun:flush_buffer + fun:PIOc_sync + fun:main +} \ No newline at end of file diff --git a/externals/pio2/examples/f03/examplePio.f90 b/externals/pio2/examples/f03/examplePio.f90 index 555998aed436..d2baddf20966 100644 --- a/externals/pio2/examples/f03/examplePio.f90 +++ b/externals/pio2/examples/f03/examplePio.f90 @@ -10,7 +10,7 @@ module pioExample use pio, only : PIO_nowrite, PIO_openfile implicit none - save + private include 'mpif.h' @@ -20,7 +20,7 @@ module pioExample integer, parameter :: LEN = 16 !> @brief Value used for array that will be written to netcdf file. - integer, parameter :: VAL = 42 + integer, parameter :: VAL = 42 !> @brief Error code if anything goes wrong. integer, parameter :: ERR_CODE = 99 @@ -40,7 +40,7 @@ module pioExample integer :: niotasks !> @brief Stride in the mpi rank between io tasks. - integer :: stride + integer :: stride !> @brief Number of aggregator. integer :: numAggregator @@ -181,7 +181,7 @@ subroutine init(this) this%pioIoSystem, & ! iosystem base=this%optBase) ! base (optional argument) - ! + ! ! set up some data that we will write to a netcdf file ! @@ -353,7 +353,7 @@ end module pioExample !! - read the sample data with @ref PIO_read_darray. !! !! - close the netCDF file with @ref PIO_closefile. -!! +!! !! - clean up local memory, ParallelIO library resources with @ref !! PIO_freedecomp and @ref PIO_finalize, and MPI library resources. !! diff --git a/externals/pio2/src/clib/CMakeLists.txt b/externals/pio2/src/clib/CMakeLists.txt index bb08376a3c37..8c01336969c5 100644 --- a/externals/pio2/src/clib/CMakeLists.txt +++ b/externals/pio2/src/clib/CMakeLists.txt @@ -14,15 +14,21 @@ set (PIO_C_SRCS topology.c pioc_sc.c pio_spmd.c pio_rearrange.c - pio_darray.c + pio_nc4.c bget.c) -set (PIO_GENNC_SRCS ${CMAKE_CURRENT_BINARY_DIR}/pio_nc.c - ${CMAKE_CURRENT_BINARY_DIR}/pio_nc4.c - ${CMAKE_CURRENT_BINARY_DIR}/pio_put_nc.c - ${CMAKE_CURRENT_BINARY_DIR}/pio_get_nc.c) +set (PIO_GENNC_SRCS ${CMAKE_CURRENT_BINARY_DIR}/pio_put_nc.c + ${CMAKE_CURRENT_BINARY_DIR}/pio_get_nc.c + ${CMAKE_CURRENT_BINARY_DIR}/pio_nc.c) -add_library (pioc ${PIO_C_SRCS} ${PIO_GENNC_SRCS}) +if (PIO_ENABLE_ASYNC) + set (PIO_ADDL_SRCS pio_nc_async.c pio_put_nc_async.c pio_get_nc_async.c + pio_msg.c pio_varm.c pio_darray_async.c) +else () + set (PIO_ADDL_SRCS pio_darray.c ${PIO_GENNC_SRCS}) +endif () + +add_library (pioc ${PIO_C_SRCS} ${PIO_ADDL_SRCS}) # set up include-directories include_directories( @@ -67,7 +73,7 @@ install (FILES ${CMAKE_CURRENT_SOURCE_DIR}/pio.h DESTINATION include) #============================================================================== # DEFINE THE DEPENDENCIES #============================================================================== - + #===== MPI ===== if (PIO_USE_MPISERIAL) find_package (MPISERIAL COMPONENTS C REQUIRED) @@ -90,7 +96,7 @@ if (PIO_ENABLE_TIMING) find_package (GPTL COMPONENTS C QUIET) if (GPTL_C_FOUND) message (STATUS "Found GPTL C: ${GPTL_C_LIBRARIES}") - target_include_directories (pioc + target_include_directories (pioc PUBLIC ${GPTL_C_INCLUDE_DIRS}) target_link_libraries (pioc PUBLIC ${GPTL_C_LIBRARIES}) @@ -106,18 +112,18 @@ endif () #===== NetCDF-C ===== find_package (NetCDF "4.3.3" COMPONENTS C) if (NetCDF_C_FOUND) - target_include_directories (pioc + target_include_directories (pioc PUBLIC ${NetCDF_C_INCLUDE_DIRS}) - target_compile_definitions (pioc + target_compile_definitions (pioc PUBLIC _NETCDF) target_link_libraries (pioc PUBLIC ${NetCDF_C_LIBRARIES}) if (${NetCDF_C_HAS_PARALLEL}) - target_compile_definitions (pioc + target_compile_definitions (pioc PUBLIC _NETCDF4) endif () else () - target_compile_definitions (pioc + target_compile_definitions (pioc PUBLIC _NONETCDF) endif () @@ -126,9 +132,9 @@ if (WITH_PNETCDF) find_package (PnetCDF "1.6" COMPONENTS C REQUIRED) endif () if (PnetCDF_C_FOUND) - target_include_directories (pioc + target_include_directories (pioc PUBLIC ${PnetCDF_C_INCLUDE_DIRS}) - target_compile_definitions (pioc + target_compile_definitions (pioc PUBLIC _PNETCDF) target_link_libraries (pioc PUBLIC ${PnetCDF_C_LIBRARIES}) @@ -140,9 +146,9 @@ if (PnetCDF_C_FOUND) target_compile_definitions(pioc PUBLIC USE_PNETCDF_VARN PUBLIC USE_PNETCDF_VARN_ON_READ) - endif() + endif() else () - target_compile_definitions (pioc + target_compile_definitions (pioc PUBLIC _NOPNETCDF) endif () @@ -156,7 +162,7 @@ target_compile_options (pioc target_compile_definitions (pioc PUBLIC ${PIO_C_EXTRA_COMPILE_DEFINITIONS}) if (PIO_C_EXTRA_LINK_FLAGS) - set_target_properties(pioc PROPERTIES + set_target_properties(pioc PROPERTIES LINK_FLAGS ${PIO_C_EXTRA_LINK_FLAGS}) endif () @@ -172,7 +178,7 @@ if (PnetCDF_C_FOUND AND NetCDF_C_FOUND AND PIO_GENERATE_SOURCES_FROM_TEMPLATES) pio_c_put_template.c COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/pio_c_get_template.c pio_c_get_template.c - COMMAND ${PERL_EXECUTABLE} ${CMAKE_CURRENT_SOURCE_DIR}/ncputgetparser.pl + COMMAND ${PERL_EXECUTABLE} ${CMAKE_CURRENT_SOURCE_DIR}/ncputgetparser.pl ${NetCDF_C_INCLUDE_DIR} ${PnetCDF_C_INCLUDE_DIR} COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/pio_c_template.c pio_c_template.c @@ -186,7 +192,7 @@ if (PnetCDF_C_FOUND AND NetCDF_C_FOUND AND PIO_GENERATE_SOURCES_FROM_TEMPLATES) else () message (FATAL_ERROR "Need Perl to create PIO C source files from templates") endif () - + # If both NetCDF and PnetCDF are NOT found, then just copy existing source files else () add_custom_command (OUTPUT ${PIO_GENNC_SRCS} @@ -196,12 +202,9 @@ else () pio_get_nc.c COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/pio_nc.c pio_nc.c - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/pio_nc4.c - pio_nc4.c DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/pio_put_nc.c ${CMAKE_CURRENT_SOURCE_DIR}/pio_get_nc.c - ${CMAKE_CURRENT_SOURCE_DIR}/pio_nc.c - ${CMAKE_CURRENT_SOURCE_DIR}/pio_nc4.c) + ${CMAKE_CURRENT_SOURCE_DIR}/pio_nc.c) endif () diff --git a/externals/pio2/src/clib/bget.c b/externals/pio2/src/clib/bget.c index a7f4744a3e16..020fb724b765 100644 --- a/externals/pio2/src/clib/bget.c +++ b/externals/pio2/src/clib/bget.c @@ -397,7 +397,6 @@ BGET CONFIGURATION ================== */ -//#define PIO_USE_MALLOC 1 #ifdef PIO_USE_MALLOC #include #endif @@ -419,7 +418,7 @@ #define BufValid 1 /* Define this symbol to enable the bpoolv() function for validating - a buffer pool. */ + a buffer pool. */ #define DumpData 1 /* Define this symbol to enable the bufdump() function which allows @@ -439,7 +438,7 @@ pointers into released buffers. */ //#define BestFit 1 -#undef BestFit +#undef BestFit /* Use a best fit algorithm when searching for space for an allocation request. This uses @@ -577,7 +576,7 @@ void bpoolrelease() numpblk = 0; /* Number of pool blocks */ numpget = 0; numprel = 0; /* Number of block gets and rels */ - numdget = 0; + numdget = 0; numdrel = 0; /* Number of direct gets and rels */ #endif /* BECtl */ #endif /* BufStats */ @@ -587,7 +586,7 @@ void bpoolrelease() compfcn = NULL; acqfcn = NULL; relfcn = NULL; - exp_incr = 0; + exp_incr = 0; pool_len = 0; #endif @@ -618,7 +617,7 @@ void *bget(requested_size) buf = malloc(requested_size); // printf("bget allocate %ld %x\n",requested_size,buf); return(buf); -#endif +#endif if(size<=0) @@ -773,7 +772,7 @@ void *bget(requested_size) /*only let this happen once */ printf("%s %d memory request exceeds block size %d %d %x\n",__FILE__,__LINE__,size,exp_incr,buf); exp_incr = size+sizeof(struct bhead); - + return buf; } @@ -881,7 +880,7 @@ void brel(buf) // printf("bget free %d %x\n",__LINE__,buf); free(buf); return; -#endif +#endif if(buf==NULL) return; /* allow for null buffer */ diff --git a/externals/pio2/src/clib/config.h.in b/externals/pio2/src/clib/config.h.in index ded06e0aa429..1722872c3056 100644 --- a/externals/pio2/src/clib/config.h.in +++ b/externals/pio2/src/clib/config.h.in @@ -1,4 +1,4 @@ -/** @file +/** @file * * This is the template for the config.h file, which is created at * build-time by cmake. @@ -19,4 +19,7 @@ * will use the included bget() package for memory management. */ #define PIO_USE_MALLOC @USE_MALLOC@ +/** Set to non-zero to turn on logging. Output may be large. */ +#define PIO_ENABLE_LOGGING @ENABLE_LOGGING@ + #endif /* _PIO_CONFIG_ */ diff --git a/externals/pio2/src/clib/pio.h b/externals/pio2/src/clib/pio.h index 5b8446bf21ef..07f4b8b20c55 100644 --- a/externals/pio2/src/clib/pio.h +++ b/externals/pio2/src/clib/pio.h @@ -1,11 +1,8 @@ /** * @file + * Public headers for the PIO C interface. * @author Jim Edwards * @date 2014 - * @brief Public headers for the PIO C interface. - * - * - * * * @see http://code.google.com/p/parallelio/ */ @@ -43,209 +40,292 @@ /** The maximum number of variables allowed in a netCDF file. */ #define PIO_MAX_VARS NC_MAX_VARS - /** - * @brief Variable description structure - * - * The variable record is the index into the unlimited dimension in the netcdf file - * typically this is the time dimension. - * ndims is the number of dimensions on the file for this variable - * request is the id of each outstanding pnetcdf request for this variable - * nreqs is the number of outstanding pnetcdf requests for this variable - * fillbuf is a memory buffer to hold fill values for this variable (write only) - * iobuf is a memory buffer to hold (write only) -*/ + * Variable description structure. + */ typedef struct var_desc_t { - int record; - int ndims; + /** The unlimited dimension in the netCDF file (typically the time + * dimension). -1 if there is no unlimited dimension. */ + int record; + + /** Number of dimensions for this variable. */ + int ndims; + + /** ID of each outstanding pnetcdf request for this variable. */ + int *request; - int *request; // used for pnetcdf iput calls - int nreqs; - void *fillbuf; - void *iobuf; + /** Number of requests bending with pnetcdf. */ + int nreqs; + /** Buffer that contains the fill value for this variable. */ + void *fillbuf; + + /** ??? */ + void *iobuf; } var_desc_t; /** - * @brief io region structure + * IO region structure. * * Each IO region is a unit of data which can be described using start and count - * arrays. Each IO task may in general have multiple io regions per variable. The + * arrays. Each IO task may in general have multiple io regions per variable. The * box rearranger will have at most one io region per variable. * -*/ + */ typedef struct io_region { - int loffset; - PIO_Offset *start; - PIO_Offset *count; - struct io_region *next; + int loffset; + PIO_Offset *start; + PIO_Offset *count; + struct io_region *next; } io_region; /** - * @brief io descriptor structure + * IO descriptor structure. * * This structure defines the mapping for a given variable between * compute and IO decomposition. - * -*/ + */ typedef struct io_desc_t { - int ioid; - int async_id; - int nrecvs; - int ndof; - int ndims; - int num_aiotasks; - int rearranger; - int maxregions; - bool needsfill; // Does this decomp leave holes in the field (true) or write everywhere (false) - int maxbytes; // maximum number of bytes of this iodesc before flushing - MPI_Datatype basetype; - PIO_Offset llen; - int maxiobuflen; - PIO_Offset *gsize; - - int *rfrom; - int *rcount; - int *scount; - PIO_Offset *sindex; - PIO_Offset *rindex; - - MPI_Datatype *rtype; - MPI_Datatype *stype; - int num_stypes; - int holegridsize; - int maxfillregions; - io_region *firstregion; - io_region *fillregion; - - - bool handshake; - bool isend; - int max_requests; + /** The ID of this io_desc_t. */ + int ioid; + int async_id; + int nrecvs; + int ndof; + int ndims; + int num_aiotasks; + int rearranger; + int maxregions; + bool needsfill; // Does this decomp leave holes in the field (true) or write everywhere (false) + + /** The maximum number of bytes of this iodesc before flushing. */ + int maxbytes; + MPI_Datatype basetype; + PIO_Offset llen; + int maxiobuflen; + PIO_Offset *gsize; + + int *rfrom; + int *rcount; + int *scount; + PIO_Offset *sindex; + PIO_Offset *rindex; + + MPI_Datatype *rtype; + MPI_Datatype *stype; + int num_stypes; + int holegridsize; + int maxfillregions; + io_region *firstregion; + io_region *fillregion; + + bool handshake; + bool isend; + int max_requests; - MPI_Comm subset_comm; - struct io_desc_t *next; + MPI_Comm subset_comm; + + /** Pointer to the next io_desc_t in the list. */ + struct io_desc_t *next; } io_desc_t; /** - * @brief io system descriptor structure + * IO system descriptor structure. * - * This structure contains the general IO subsystem data - * and MPI structure - * -*/ + * This structure contains the general IO subsystem data and MPI + * structure + */ typedef struct iosystem_desc_t { - int iosysid; - MPI_Comm union_comm; - MPI_Comm io_comm; - MPI_Comm comp_comm; - MPI_Comm intercomm; - MPI_Comm my_comm; - - /** This MPI group contains the processors involved in - * computation. It is created in PIOc_Init_Intracomm(), and freed my - * PIO_finalize(). */ - MPI_Group compgroup; + /** The ID of this iosystem_desc_t. This will be obtained by + * calling PIOc_Init_Intercomm() or PIOc_Init_Intracomm(). */ + int iosysid; + + /** This is an MPI intra communicator that includes all the tasks in + * both the IO and the computation communicators. */ + MPI_Comm union_comm; + + /** This is an MPI intra communicator that includes all the tasks + * involved in IO. */ + MPI_Comm io_comm; + + /** This is an MPI intra communicator that includes all the tasks + * involved in computation. */ + MPI_Comm comp_comm; + + /** This is an MPI inter communicator between IO communicator and + * computation communicator. */ + MPI_Comm intercomm; + + /** This is a copy (but not an MPI copy) of either the comp (for + * non-async) or the union (for async) communicator. */ + MPI_Comm my_comm; + + /** This MPI group contains the processors involved in + * computation. */ + MPI_Group compgroup; - /** This MPI group contains the processors involved in I/O. It is - * created in PIOc_Init_Intracomm(), and freed my PIOc_finalize(). */ - MPI_Group iogroup; - - int num_iotasks; - int num_comptasks; + /** This MPI group contains the processors involved in I/O. */ + MPI_Group iogroup; - int union_rank; - int comp_rank; - int io_rank; + /** The number of tasks in the IO communicator. */ + int num_iotasks; - bool iomaster; - bool compmaster; + /** The number of tasks in the computation communicator. */ + int num_comptasks; - int ioroot; - int comproot; - int *ioranks; + /** Rank of this task in the union communicator. */ + int union_rank; - int error_handler; - int default_rearranger; + /** The rank of this process in the computation communicator, or -1 + * if this process is not part of the computation communicator. */ + int comp_rank; - bool async_interface; - bool ioproc; - - MPI_Info info; - struct iosystem_desc_t *next; + /** The rank of this process in the IO communicator, or -1 if this + * process is not part of the IO communicator. */ + int io_rank; + + /** Set to MPI_ROOT if this task is the master of IO communicator, 0 + * otherwise. */ + int iomaster; + + /** Set to MPI_ROOT if this task is the master of comp communicator, 0 + * otherwise. */ + int compmaster; + + /** Rank of IO root task (which is rank 0 in io_comm) in the union + * communicator. */ + int ioroot; + + /** Rank of computation root task (which is rank 0 in + * comm_comms[cmp]) in the union communicator. */ + int comproot; + + /** An array of the ranks of all IO tasks within the union + * communicator. */ + int *ioranks; + + /** Controls handling errors. */ + int error_handler; + + /** The rearranger decides which parts of a distributed array are + * handled by which IO tasks. */ + int default_rearranger; + + /** True if asynchronous interface is in use. */ + bool async_interface; + + /** True if this task is a member of the IO communicator. */ + bool ioproc; + + /** MPI Info object. */ + MPI_Info info; + + /** Pointer to the next iosystem_desc_t in the list. */ + struct iosystem_desc_t *next; } iosystem_desc_t; /** - * @brief multi buffer - * -*/ + * multi buffer. + */ typedef struct wmulti_buffer { - int ioid; - int validvars; - int arraylen; - int *vid; - int *frame; - void *fillvalue; - void *data; - struct wmulti_buffer *next; + int ioid; + int validvars; + int arraylen; + int *vid; + int *frame; + void *fillvalue; + void *data; + struct wmulti_buffer *next; } wmulti_buffer; - - /** - * @brief io system descriptor structure + * File descriptor structure. * * This structure holds information associated with each open file - * -*/ + */ typedef struct file_desc_t { - iosystem_desc_t *iosystem; - PIO_Offset buffsize; - int fh; - int iotype; - struct var_desc_t varlist[PIO_MAX_VARS]; - int mode; - struct wmulti_buffer buffer; - struct file_desc_t *next; + /** The IO system ID used to open this file. */ + iosystem_desc_t *iosystem; + + /** The buffersize does not seem to be used anywhere. */ + /* PIO_Offset buffsize;*/ + + /** The ncid returned for this file by the underlying library + * (netcdf or pnetcdf). */ + int fh; + + /** The PIO_TYPE value that was used to open this file. */ + int iotype; + + /** List of variables in this file. */ + struct var_desc_t varlist[PIO_MAX_VARS]; + + /** ??? */ + int mode; + + /** ??? */ + struct wmulti_buffer buffer; + + /** Pointer to the next file_desc_t in the list of open files. */ + struct file_desc_t *next; + + /** True if this task should participate in IO (only true for one + * task with netcdf serial files. */ + int do_io; } file_desc_t; /** - * @brief These are the supported output formats - * -*/ + * These are the supported methods of reading/writing netCDF + * files. (Not all methods can be used with all netCDF files.) + */ +enum PIO_IOTYPE +{ + /** Parallel Netcdf (parallel) */ + PIO_IOTYPE_PNETCDF = 1, -enum PIO_IOTYPE{ - PIO_IOTYPE_PNETCDF=1, //< Parallel Netcdf (parallel) - PIO_IOTYPE_NETCDF=2, //< Netcdf3 Classic format (serial) - PIO_IOTYPE_NETCDF4C=3, //< NetCDF4 (HDF5) compressed format (serial) - PIO_IOTYPE_NETCDF4P=4 //< NetCDF4 (HDF5) parallel + /** Netcdf3 Classic format (serial) */ + PIO_IOTYPE_NETCDF = 2, + + /** NetCDF4 (HDF5) compressed format (serial) */ + PIO_IOTYPE_NETCDF4C = 3, + + /** NetCDF4 (HDF5) parallel */ + PIO_IOTYPE_NETCDF4P = 4 }; /** - * @brief These are the supported output data rearrangement methods - * -*/ -enum PIO_REARRANGERS{ - PIO_REARR_BOX = 1, - PIO_REARR_SUBSET = 2 + * These are the supported output data rearrangement methods. + */ +enum PIO_REARRANGERS +{ + /** Box rearranger. */ + PIO_REARR_BOX = 1, + + /** Subset rearranger. */ + PIO_REARR_SUBSET = 2 }; /** - * @brief These are the supported error handlers - * -*/ -enum PIO_ERROR_HANDLERS{ - PIO_INTERNAL_ERROR=(-51), //< Errors cause abort - PIO_BCAST_ERROR=(-52), //< Error codes are broadcast to all tasks - PIO_RETURN_ERROR=(-53) //< Errors are returned to caller with no internal action + * These are the supported error handlers. + */ +enum PIO_ERROR_HANDLERS +{ + /** Errors cause abort. */ + PIO_INTERNAL_ERROR = (-51), + + /** Error codes are broadcast to all tasks. */ + PIO_BCAST_ERROR = (-52), + + /** Errors are returned to caller with no internal action. */ + PIO_RETURN_ERROR = (-53) }; +/** Define the netCDF-based error codes. */ #if defined( _PNETCDF) || defined(_NETCDF) #define PIO_GLOBAL NC_GLOBAL #define PIO_UNLIMITED NC_UNLIMITED @@ -338,269 +418,283 @@ enum PIO_ERROR_HANDLERS{ #define PIO_EBADCHUNK NC_EBADCHUNK #define PIO_ENOTBUILT NC_ENOTBUILT #define PIO_EDISKLESS NC_EDISKLESS - #define PIO_FILL_DOUBLE NC_FILL_DOUBLE #define PIO_FILL_FLOAT NC_FILL_FLOAT #define PIO_FILL_INT NC_FILL_INT #define PIO_FILL_CHAR NC_FILL_CHAR +#endif /* defined( _PNETCDF) || defined(_NETCDF) */ -#endif +/** Define the extra error codes for the parallel-netcdf library. */ #ifdef _PNETCDF #define PIO_EINDEP NC_EINDEP -#else +#else /* _PNETCDF */ #define PIO_EINDEP (-203) -#endif -#if defined(__cplusplus) -extern "C" { -#endif +#endif /* _PNETCDF */ + +/** Define error codes for PIO. */ #define PIO_EBADIOTYPE -255 + +/** ??? */ #define PIO_REQ_NULL (NC_REQ_NULL-1) -int PIOc_freedecomp(int iosysid, int ioid); -int PIOc_inq_att (int ncid, int varid, const char *name, nc_type *xtypep, PIO_Offset *lenp); -int PIOc_inq_format (int ncid, int *formatp); -int PIOc_inq_varid (int ncid, const char *name, int *varidp); -int PIOc_inq_varnatts (int ncid, int varid, int *nattsp); -int PIOc_def_var (int ncid, const char *name, nc_type xtype, int ndims, const int *dimidsp, int *varidp); -int PIOc_def_var_deflate(int ncid, int varid, int shuffle, int deflate, - int deflate_level); -int PIOc_inq_var_deflate(int ncid, int varid, int *shufflep, - int *deflatep, int *deflate_levelp); -int PIOc_inq_var_szip(int ncid, int varid, int *options_maskp, int *pixels_per_blockp); -int PIOc_def_var_chunking(int ncid, int varid, int storage, const PIO_Offset *chunksizesp); -int PIOc_inq_var_chunking(int ncid, int varid, int *storagep, PIO_Offset *chunksizesp); -int PIOc_def_var_fill(int ncid, int varid, int no_fill, const void *fill_value); -int PIOc_inq_var_fill(int ncid, int varid, int *no_fill, void *fill_valuep); -int PIOc_def_var_endian(int ncid, int varid, int endian); -int PIOc_inq_var_endian(int ncid, int varid, int *endianp); -int PIOc_set_chunk_cache(int iosysid, int iotype, PIO_Offset size, PIO_Offset nelems, float preemption); -int PIOc_get_chunk_cache(int iosysid, int iotype, PIO_Offset *sizep, PIO_Offset *nelemsp, float *preemptionp); -int PIOc_set_var_chunk_cache(int ncid, int varid, PIO_Offset size, PIO_Offset nelems, - float preemption); -int PIOc_get_var_chunk_cache(int ncid, int varid, PIO_Offset *sizep, PIO_Offset *nelemsp, - float *preemptionp); -int PIOc_inq_var (int ncid, int varid, char *name, nc_type *xtypep, int *ndimsp, int *dimidsp, int *nattsp); -int PIOc_inq_varname (int ncid, int varid, char *name); -int PIOc_put_att_double (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const double *op); -int PIOc_put_att_int (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const int *op); -int PIOc_rename_att (int ncid, int varid, const char *name, const char *newname); -int PIOc_del_att (int ncid, int varid, const char *name); -int PIOc_inq_natts (int ncid, int *ngattsp); -int PIOc_inq (int ncid, int *ndimsp, int *nvarsp, int *ngattsp, int *unlimdimidp); -int PIOc_get_att_text (int ncid, int varid, const char *name, char *ip); -int PIOc_get_att_short (int ncid, int varid, const char *name, short *ip); -int PIOc_put_att_long (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const long *op); -int PIOc_redef (int ncid); -int PIOc_set_fill (int ncid, int fillmode, int *old_modep); -int PIOc_enddef (int ncid); -int PIOc_rename_var (int ncid, int varid, const char *name); -int PIOc_put_att_short (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const short *op); -int PIOc_put_att_text (int ncid, int varid, const char *name, PIO_Offset len, const char *op); -int PIOc_inq_attname (int ncid, int varid, int attnum, char *name); -int PIOc_get_att_ulonglong (int ncid, int varid, const char *name, unsigned long long *ip); -int PIOc_get_att_ushort (int ncid, int varid, const char *name, unsigned short *ip); -int PIOc_put_att_ulonglong (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned long long *op); -int PIOc_inq_dimlen (int ncid, int dimid, PIO_Offset *lenp); -int PIOc_get_att_uint (int ncid, int varid, const char *name, unsigned int *ip); -int PIOc_get_att_longlong (int ncid, int varid, const char *name, long long *ip); -int PIOc_put_att_schar (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const signed char *op); -int PIOc_put_att_float (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const float *op); -int PIOc_inq_nvars (int ncid, int *nvarsp); -int PIOc_rename_dim (int ncid, int dimid, const char *name); -int PIOc_inq_varndims (int ncid, int varid, int *ndimsp); -int PIOc_get_att_long (int ncid, int varid, const char *name, long *ip); -int PIOc_inq_dim (int ncid, int dimid, char *name, PIO_Offset *lenp); -int PIOc_inq_dimid (int ncid, const char *name, int *idp); -int PIOc_inq_unlimdim (int ncid, int *unlimdimidp); -int PIOc_inq_vardimid (int ncid, int varid, int *dimidsp); -int PIOc_inq_attlen (int ncid, int varid, const char *name, PIO_Offset *lenp); -int PIOc_inq_dimname (int ncid, int dimid, char *name); -int PIOc_put_att_ushort (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned short *op); -int PIOc_get_att_float (int ncid, int varid, const char *name, float *ip); -int PIOc_sync (int ncid); -int PIOc_put_att_longlong (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const long long *op); -int PIOc_put_att_uint (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned int *op); -int PIOc_get_att_schar (int ncid, int varid, const char *name, signed char *ip); -int PIOc_inq_attid (int ncid, int varid, const char *name, int *idp); -int PIOc_def_dim (int ncid, const char *name, PIO_Offset len, int *idp); -int PIOc_inq_ndims (int ncid, int *ndimsp); -int PIOc_inq_vartype (int ncid, int varid, nc_type *xtypep); -int PIOc_get_att_int (int ncid, int varid, const char *name, int *ip); -int PIOc_get_att_double (int ncid, int varid, const char *name, double *ip); -int PIOc_inq_atttype (int ncid, int varid, const char *name, nc_type *xtypep); -int PIOc_put_att_uchar (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned char *op); -int PIOc_get_att_uchar (int ncid, int varid, const char *name, unsigned char *ip); -int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const int dims[], - const int maplen, const PIO_Offset *compmap, int *ioidp, const int *rearr, - const PIO_Offset *iostart,const PIO_Offset *iocount); -int PIOc_Init_Intracomm(const MPI_Comm comp_comm, - const int num_iotasks, const int stride, - const int base, const int rearr, int *iosysidp); -int PIOc_closefile(int ncid); -int PIOc_createfile(const int iosysid, int *ncidp, int *iotype, - const char *fname, const int mode); -int PIOc_openfile(const int iosysid, int *ncidp, int *iotype, - const char *fname, const int mode); -int PIOc_write_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, void *array, void *fillvalue); - int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, const int nvars, const PIO_Offset arraylen, void *array, const int frame[], void *fillvalue[], bool flushtodisk); - -int PIOc_get_att_ubyte (int ncid, int varid, const char *name, unsigned char *ip); -int PIOc_put_att_ubyte (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned char *op) ; -int PIOc_set_blocksize(const int newblocksize); - int PIOc_readmap(const char file[], int *ndims, int *gdims[], PIO_Offset *fmaplen, PIO_Offset *map[], const MPI_Comm comm); - int PIOc_readmap_from_f90(const char file[],int *ndims, int *gdims[], PIO_Offset *maplen, PIO_Offset *map[], const int f90_comm); - int PIOc_writemap(const char file[], const int ndims, const int gdims[], PIO_Offset maplen, PIO_Offset map[], const MPI_Comm comm); - int PIOc_writemap_from_f90(const char file[], const int ndims, const int gdims[], const PIO_Offset maplen, const PIO_Offset map[], const int f90_comm); - int PIOc_deletefile(const int iosysid, const char filename[]); - int PIOc_File_is_Open(int ncid); - int PIOc_Set_File_Error_Handling(int ncid, int method); - int PIOc_advanceframe(int ncid, int varid); - int PIOc_setframe(const int ncid, const int varid,const int frame); - int PIOc_get_numiotasks(int iosysid, int *numiotasks); - int PIOc_get_iorank(int iosysid, int *iorank); - int PIOc_get_local_array_size(int ioid); - int PIOc_Set_IOSystem_Error_Handling(int iosysid, int method); - int PIOc_set_hint(const int iosysid, char hint[], const char hintval[]); - int PIOc_Init_Intracomm(const MPI_Comm comp_comm, - const int num_iotasks, const int stride, - const int base,const int rearr, int *iosysidp); - int PIOc_finalize(const int iosysid); - int PIOc_iam_iotask(const int iosysid, bool *ioproc); - int PIOc_iotask_rank(const int iosysid, int *iorank); - int PIOc_iosystem_is_active(const int iosysid, bool *active); - int PIOc_put_vars_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned char *op) ; - int PIOc_get_var1_schar (int ncid, int varid, const PIO_Offset index[], signed char *buf) ; - int PIOc_put_vars_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned short *op) ; - int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void *IOBUF); - int PIOc_put_vars_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned long long *op) ; - int PIOc_get_vars_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned long long *buf) ; - int PIOc_put_varm (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype) ; - int PIOc_read_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, void *array); - int PIOc_put_vars_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned int *op) ; - int PIOc_get_varm_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], signed char *buf) ; - int PIOc_put_varm_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned char *op) ; - int PIOc_put_var_ushort (int ncid, int varid, const unsigned short *op) ; - int PIOc_get_vars_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], short *buf) ; - int PIOc_put_var1_longlong (int ncid, int varid, const PIO_Offset index[], const long long *op) ; - int PIOc_get_var_double (int ncid, int varid, double *buf) ; - int PIOc_put_vara_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned char *op) ; - int PIOc_put_varm_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const short *op) ; - int PIOc_get_vara_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], double *buf) ; - int PIOc_put_var1_long (int ncid, int varid, const PIO_Offset index[], const long *ip) ; - int PIOc_get_var_int (int ncid, int varid, int *buf) ; - int PIOc_put_vars_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const long *op) ; - int PIOc_put_var_short (int ncid, int varid, const short *op) ; - int PIOc_get_vara_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], char *buf) ; - int PIOc_put_vara_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const int *op) ; - int PIOc_put_vara_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const int *op) ; - - int PIOc_put_var1_ushort (int ncid, int varid, const PIO_Offset index[], const unsigned short *op); - int PIOc_put_vara_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const char *op); - int PIOc_put_varm_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const char *op); - int PIOc_put_varm_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned short *op); - int PIOc_put_var_ulonglong (int ncid, int varid, const unsigned long long *op); - int PIOc_put_var_int (int ncid, int varid, const int *op); - int PIOc_put_var_longlong (int ncid, int varid, const long long *op); - int PIOc_put_var_schar (int ncid, int varid, const signed char *op); - int PIOc_put_var_uint (int ncid, int varid, const unsigned int *op); - int PIOc_put_var (int ncid, int varid, const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_put_vara_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned short *op); - int PIOc_put_vars_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const short *op); - int PIOc_put_vara_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned int *op); - int PIOc_put_vara_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const signed char *op); - int PIOc_put_varm_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned long long *op); - int PIOc_put_var1_uchar (int ncid, int varid, const PIO_Offset index[], const unsigned char *op); - int PIOc_put_varm_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const int *op); - int PIOc_put_vars_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const signed char *op); - int PIOc_put_var1 (int ncid, int varid, const PIO_Offset index[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_put_vara_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const float *op); - int PIOc_put_var1_float (int ncid, int varid, const PIO_Offset index[], const float *op); - int PIOc_put_varm_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const float *op); - int PIOc_put_var1_text (int ncid, int varid, const PIO_Offset index[], const char *op); - int PIOc_put_vars_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const char *op); - int PIOc_put_varm_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const long *op); - int PIOc_put_vars_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const double *op); - int PIOc_put_vara_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const long long *op); - int PIOc_put_var_double (int ncid, int varid, const double *op); - int PIOc_put_var_float (int ncid, int varid, const float *op); - int PIOc_put_var1_ulonglong (int ncid, int varid, const PIO_Offset index[], const unsigned long long *op); - int PIOc_put_varm_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned int *op); - int PIOc_put_var1_uint (int ncid, int varid, const PIO_Offset index[], const unsigned int *op); - int PIOc_put_var1_int (int ncid, int varid, const PIO_Offset index[], const int *op); - int PIOc_put_vars_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const float *op); - int PIOc_put_vara_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const short *op); - int PIOc_put_var1_schar (int ncid, int varid, const PIO_Offset index[], const signed char *op); - int PIOc_put_vara_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned long long *op); - int PIOc_put_varm_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const double *op); - int PIOc_put_vara (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_put_vara_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const long *op); - int PIOc_put_var1_double (int ncid, int varid, const PIO_Offset index[], const double *op); - int PIOc_put_varm_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const signed char *op); - int PIOc_put_var_text (int ncid, int varid, const char *op); - int PIOc_put_vars_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const int *op); - int PIOc_put_var1_short (int ncid, int varid, const PIO_Offset index[], const short *op); - int PIOc_put_vars_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const long long *op); - int PIOc_put_vara_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const double *op); - int PIOc_put_vars (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_put_var_uchar (int ncid, int varid, const unsigned char *op); - int PIOc_put_var_long (int ncid, int varid, const long *op); - int PIOc_put_varm_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const long long *op); - int PIOc_get_vara_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], int *buf); - int PIOc_get_var1_float (int ncid, int varid, const PIO_Offset index[], float *buf); - int PIOc_get_var1_short (int ncid, int varid, const PIO_Offset index[], short *buf); - int PIOc_get_vars_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], int *buf); - int PIOc_get_var_text (int ncid, int varid, char *buf); - int PIOc_get_varm_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], double *buf); - int PIOc_get_vars_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], signed char *buf); - int PIOc_get_vara_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned short *buf); - int PIOc_get_var1_ushort (int ncid, int varid, const PIO_Offset index[], unsigned short *buf); - int PIOc_get_var_float (int ncid, int varid, float *buf); - int PIOc_get_vars_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned char *buf); - int PIOc_get_var (int ncid, int varid, void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_get_var1_longlong (int ncid, int varid, const PIO_Offset index[], long long *buf); - int PIOc_get_vars_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned short *buf); - int PIOc_get_var_long (int ncid, int varid, long *buf); - int PIOc_get_var1_double (int ncid, int varid, const PIO_Offset index[], double *buf); - int PIOc_get_vara_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned int *buf); - int PIOc_get_vars_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], long long *buf); - int PIOc_get_var_longlong (int ncid, int varid, long long *buf); - int PIOc_get_vara_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], short *buf); - int PIOc_get_vara_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], long *buf); - int PIOc_get_var1_int (int ncid, int varid, const PIO_Offset index[], int *buf); - int PIOc_get_var1_ulonglong (int ncid, int varid, const PIO_Offset index[], unsigned long long *buf); - int PIOc_get_var_uchar (int ncid, int varid, unsigned char *buf); - int PIOc_get_vara_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned char *buf); - int PIOc_get_vars_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], float *buf); - int PIOc_get_vars_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], long *buf); - int PIOc_get_var1 (int ncid, int varid, const PIO_Offset index[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_get_var_uint (int ncid, int varid, unsigned int *buf); - int PIOc_get_vara (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_get_vara_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], signed char *buf); - int PIOc_get_var1_uint (int ncid, int varid, const PIO_Offset index[], unsigned int *buf); - int PIOc_get_vars_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned int *buf); - int PIOc_get_vara_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], float *buf); - int PIOc_get_varm_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], char *buf); - int PIOc_get_var1_text (int ncid, int varid, const PIO_Offset index[], char *buf); - int PIOc_get_varm_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], int *buf); - int PIOc_get_varm_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned int *buf); - int PIOc_get_varm (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_get_vars_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], double *buf); - int PIOc_get_vara_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], long long *buf); - int PIOc_get_var_ulonglong (int ncid, int varid, unsigned long long *buf); - int PIOc_get_vara_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned long long *buf); - int PIOc_get_var_short (int ncid, int varid, short *buf); - int PIOc_get_varm_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], float *buf); - int PIOc_get_var1_long (int ncid, int varid, const PIO_Offset index[], long *buf); - int PIOc_get_varm_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], long *buf); - int PIOc_get_varm_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned short *buf); - int PIOc_get_varm_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], long long *buf); - int PIOc_get_vars_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], char *buf); - int PIOc_get_var1_uchar (int ncid, int varid, const PIO_Offset index[], unsigned char *buf); - int PIOc_get_vars (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); - int PIOc_get_varm_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], short *buf); - int PIOc_get_varm_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned long long *buf); - int PIOc_get_var_schar (int ncid, int varid, signed char *buf); - int PIOc_iotype_available(const int iotype); +#if defined(__cplusplus) +extern "C" { +#endif + int PIOc_strerror(int pioerr, char *errstr); + int PIOc_freedecomp(int iosysid, int ioid); + int PIOc_inq_att (int ncid, int varid, const char *name, nc_type *xtypep, PIO_Offset *lenp); + int PIOc_inq_format (int ncid, int *formatp); + int PIOc_inq_varid (int ncid, const char *name, int *varidp); + int PIOc_inq_varnatts (int ncid, int varid, int *nattsp); + int PIOc_def_var (int ncid, const char *name, nc_type xtype, int ndims, const int *dimidsp, int *varidp); + int PIOc_def_var_deflate(int ncid, int varid, int shuffle, int deflate, + int deflate_level); + int PIOc_inq_var_deflate(int ncid, int varid, int *shufflep, int *deflatep, + int *deflate_levelp); + int PIOc_inq_var_szip(int ncid, int varid, int *options_maskp, int *pixels_per_blockp); + int PIOc_def_var_chunking(int ncid, int varid, int storage, const PIO_Offset *chunksizesp); + int PIOc_inq_var_chunking(int ncid, int varid, int *storagep, PIO_Offset *chunksizesp); + int PIOc_def_var_fill(int ncid, int varid, int no_fill, const void *fill_value); + int PIOc_inq_var_fill(int ncid, int varid, int *no_fill, void *fill_valuep); + int PIOc_def_var_endian(int ncid, int varid, int endian); + int PIOc_inq_var_endian(int ncid, int varid, int *endianp); + int PIOc_set_chunk_cache(int iosysid, int iotype, PIO_Offset size, PIO_Offset nelems, float preemption); + int PIOc_get_chunk_cache(int iosysid, int iotype, PIO_Offset *sizep, PIO_Offset *nelemsp, float *preemptionp); + int PIOc_set_var_chunk_cache(int ncid, int varid, PIO_Offset size, PIO_Offset nelems, + float preemption); + int PIOc_get_var_chunk_cache(int ncid, int varid, PIO_Offset *sizep, PIO_Offset *nelemsp, + float *preemptionp); + int PIOc_inq_var (int ncid, int varid, char *name, nc_type *xtypep, int *ndimsp, int *dimidsp, int *nattsp); + int PIOc_inq_varname (int ncid, int varid, char *name); + int PIOc_put_att_double (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const double *op); + int PIOc_put_att_int (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const int *op); + int PIOc_rename_att (int ncid, int varid, const char *name, const char *newname); + int PIOc_del_att (int ncid, int varid, const char *name); + int PIOc_inq_natts (int ncid, int *ngattsp); + int PIOc_inq (int ncid, int *ndimsp, int *nvarsp, int *ngattsp, int *unlimdimidp); + int PIOc_get_att_text (int ncid, int varid, const char *name, char *ip); + int PIOc_get_att_short (int ncid, int varid, const char *name, short *ip); + int PIOc_put_att_long (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const long *op); + int PIOc_redef (int ncid); + int PIOc_set_fill (int ncid, int fillmode, int *old_modep); + int PIOc_enddef (int ncid); + int PIOc_rename_var (int ncid, int varid, const char *name); + int PIOc_put_att_short (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const short *op); + int PIOc_put_att_text (int ncid, int varid, const char *name, PIO_Offset len, const char *op); + int PIOc_inq_attname (int ncid, int varid, int attnum, char *name); + int PIOc_get_att_ulonglong (int ncid, int varid, const char *name, unsigned long long *ip); + int PIOc_get_att_ushort (int ncid, int varid, const char *name, unsigned short *ip); + int PIOc_put_att_ulonglong (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned long long *op); + int PIOc_inq_dimlen (int ncid, int dimid, PIO_Offset *lenp); + int PIOc_get_att_uint (int ncid, int varid, const char *name, unsigned int *ip); + int PIOc_get_att_longlong (int ncid, int varid, const char *name, long long *ip); + int PIOc_put_att_schar (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const signed char *op); + int PIOc_put_att_float (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const float *op); + int PIOc_inq_nvars (int ncid, int *nvarsp); + int PIOc_rename_dim (int ncid, int dimid, const char *name); + int PIOc_inq_varndims (int ncid, int varid, int *ndimsp); + int PIOc_get_att_long (int ncid, int varid, const char *name, long *ip); + int PIOc_inq_dim (int ncid, int dimid, char *name, PIO_Offset *lenp); + int PIOc_inq_dimid (int ncid, const char *name, int *idp); + int PIOc_inq_unlimdim (int ncid, int *unlimdimidp); + int PIOc_inq_vardimid (int ncid, int varid, int *dimidsp); + int PIOc_inq_attlen (int ncid, int varid, const char *name, PIO_Offset *lenp); + int PIOc_inq_dimname (int ncid, int dimid, char *name); + int PIOc_put_att_ushort (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned short *op); + int PIOc_get_att_float (int ncid, int varid, const char *name, float *ip); + int PIOc_sync (int ncid); + int PIOc_put_att_longlong (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const long long *op); + int PIOc_put_att_uint (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned int *op); + int PIOc_get_att_schar (int ncid, int varid, const char *name, signed char *ip); + int PIOc_inq_attid (int ncid, int varid, const char *name, int *idp); + int PIOc_def_dim (int ncid, const char *name, PIO_Offset len, int *idp); + int PIOc_inq_ndims (int ncid, int *ndimsp); + int PIOc_inq_vartype (int ncid, int varid, nc_type *xtypep); + int PIOc_get_att_int (int ncid, int varid, const char *name, int *ip); + int PIOc_get_att_double (int ncid, int varid, const char *name, double *ip); + int PIOc_inq_atttype (int ncid, int varid, const char *name, nc_type *xtypep); + int PIOc_put_att_uchar (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned char *op); + int PIOc_get_att_uchar (int ncid, int varid, const char *name, unsigned char *ip); + int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const int dims[], + const int maplen, const PIO_Offset *compmap, int *ioidp, const int *rearr, + const PIO_Offset *iostart,const PIO_Offset *iocount); + int PIOc_Init_Intracomm(const MPI_Comm comp_comm, + const int num_iotasks, const int stride, + const int base, const int rearr, int *iosysidp); + int PIOc_Init_Intercomm(int component_count, MPI_Comm peer_comm, MPI_Comm *comp_comms, + MPI_Comm io_comm, int *iosysidp); + int PIOc_closefile(int ncid); + int PIOc_createfile(const int iosysid, int *ncidp, int *iotype, + const char *fname, const int mode); + int PIOc_openfile(const int iosysid, int *ncidp, int *iotype, + const char *fname, const int mode); + int PIOc_write_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, + void *array, void *fillvalue); + int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, const int nvars, const PIO_Offset arraylen, + void *array, const int frame[], void *fillvalue[], bool flushtodisk); + + int PIOc_get_att_ubyte (int ncid, int varid, const char *name, unsigned char *ip); + int PIOc_put_att_ubyte (int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const unsigned char *op) ; + int PIOc_set_blocksize(const int newblocksize); + int PIOc_readmap(const char file[], int *ndims, int *gdims[], PIO_Offset *fmaplen, PIO_Offset *map[], const MPI_Comm comm); + int PIOc_readmap_from_f90(const char file[],int *ndims, int *gdims[], PIO_Offset *maplen, PIO_Offset *map[], const int f90_comm); + int PIOc_writemap(const char file[], const int ndims, const int gdims[], PIO_Offset maplen, PIO_Offset map[], const MPI_Comm comm); + int PIOc_writemap_from_f90(const char file[], const int ndims, const int gdims[], const PIO_Offset maplen, const PIO_Offset map[], const int f90_comm); + int PIOc_deletefile(const int iosysid, const char filename[]); + int PIOc_File_is_Open(int ncid); + int PIOc_Set_File_Error_Handling(int ncid, int method); + int PIOc_advanceframe(int ncid, int varid); + int PIOc_setframe(const int ncid, const int varid,const int frame); + int PIOc_get_numiotasks(int iosysid, int *numiotasks); + int PIOc_get_iorank(int iosysid, int *iorank); + int PIOc_get_local_array_size(int ioid); + int PIOc_Set_IOSystem_Error_Handling(int iosysid, int method); + int PIOc_set_hint(const int iosysid, char hint[], const char hintval[]); + int PIOc_Init_Intracomm(const MPI_Comm comp_comm, + const int num_iotasks, const int stride, + const int base,const int rearr, int *iosysidp); + int PIOc_finalize(const int iosysid); + int PIOc_iam_iotask(const int iosysid, bool *ioproc); + int PIOc_iotask_rank(const int iosysid, int *iorank); + int PIOc_iosystem_is_active(const int iosysid, bool *active); + int PIOc_put_vars_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned char *op) ; + int PIOc_get_var1_schar (int ncid, int varid, const PIO_Offset index[], signed char *buf) ; + int PIOc_put_vars_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned short *op) ; + int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void *IOBUF); + int PIOc_put_vars_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned long long *op) ; + int PIOc_get_vars_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned long long *buf) ; + int PIOc_put_varm (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype) ; + int PIOc_read_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, void *array); + int PIOc_put_vars_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const unsigned int *op) ; + int PIOc_get_varm_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], signed char *buf) ; + int PIOc_put_varm_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned char *op) ; + int PIOc_put_var_ushort (int ncid, int varid, const unsigned short *op) ; + int PIOc_get_vars_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], short *buf) ; + int PIOc_put_var1_longlong (int ncid, int varid, const PIO_Offset index[], const long long *op) ; + int PIOc_get_var_double (int ncid, int varid, double *buf) ; + int PIOc_put_vara_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned char *op) ; + int PIOc_put_varm_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const short *op) ; + int PIOc_get_vara_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], double *buf) ; + int PIOc_put_var1_long (int ncid, int varid, const PIO_Offset index[], const long *ip) ; + int PIOc_get_var_int (int ncid, int varid, int *buf) ; + int PIOc_put_vars_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const long *op) ; + int PIOc_put_var_short (int ncid, int varid, const short *op) ; + int PIOc_get_vara_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], char *buf) ; + int PIOc_put_vara_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const int *op) ; + + int PIOc_put_var1_ushort (int ncid, int varid, const PIO_Offset index[], const unsigned short *op); + int PIOc_put_vara_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const char *op); + int PIOc_put_varm_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const char *op); + int PIOc_put_varm_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned short *op); + int PIOc_put_var_ulonglong (int ncid, int varid, const unsigned long long *op); + int PIOc_put_var_int (int ncid, int varid, const int *op); + int PIOc_put_var_longlong (int ncid, int varid, const long long *op); + int PIOc_put_var_schar (int ncid, int varid, const signed char *op); + int PIOc_put_var_uint (int ncid, int varid, const unsigned int *op); + int PIOc_put_var (int ncid, int varid, const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_put_vara_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned short *op); + int PIOc_put_vars_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const short *op); + int PIOc_put_vara_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned int *op); + int PIOc_put_vara_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const signed char *op); + int PIOc_put_varm_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned long long *op); + int PIOc_put_var1_uchar (int ncid, int varid, const PIO_Offset index[], const unsigned char *op); + int PIOc_put_varm_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const int *op); + int PIOc_put_vars_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const signed char *op); + int PIOc_put_var1 (int ncid, int varid, const PIO_Offset index[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_put_vara_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const float *op); + int PIOc_put_var1_float (int ncid, int varid, const PIO_Offset index[], const float *op); + int PIOc_put_varm_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const float *op); + int PIOc_put_var1_text (int ncid, int varid, const PIO_Offset index[], const char *op); + int PIOc_put_vars_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const char *op); + int PIOc_put_varm_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const long *op); + int PIOc_put_vars_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const double *op); + int PIOc_put_vara_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const long long *op); + int PIOc_put_var_double (int ncid, int varid, const double *op); + int PIOc_put_var_float (int ncid, int varid, const float *op); + int PIOc_put_var1_ulonglong (int ncid, int varid, const PIO_Offset index[], const unsigned long long *op); + int PIOc_put_varm_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned int *op); + int PIOc_put_var1_uint (int ncid, int varid, const PIO_Offset index[], const unsigned int *op); + int PIOc_put_var1_int (int ncid, int varid, const PIO_Offset index[], const int *op); + int PIOc_put_vars_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const float *op); + int PIOc_put_vara_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const short *op); + int PIOc_put_var1_schar (int ncid, int varid, const PIO_Offset index[], const signed char *op); + int PIOc_put_vara_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const unsigned long long *op); + int PIOc_put_varm_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const double *op); + int PIOc_put_vara (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_put_vara_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const long *op); + int PIOc_put_var1_double (int ncid, int varid, const PIO_Offset index[], const double *op); + int PIOc_put_varm_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const signed char *op); + int PIOc_put_var_text (int ncid, int varid, const char *op); + int PIOc_put_vars_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const int *op); + int PIOc_put_var1_short (int ncid, int varid, const PIO_Offset index[], const short *op); + int PIOc_put_vars_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const long long *op); + int PIOc_put_vara_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const double *op); + int PIOc_put_vars (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_put_vars_tc(int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], nc_type xtype, const void *buf); + int PIOc_put_var_uchar (int ncid, int varid, const unsigned char *op); + int PIOc_put_var_long (int ncid, int varid, const long *op); + int PIOc_put_varm_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const long long *op); + int PIOc_get_vara_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], int *buf); + int PIOc_get_var1_float (int ncid, int varid, const PIO_Offset index[], float *buf); + int PIOc_get_var1_short (int ncid, int varid, const PIO_Offset index[], short *buf); + int PIOc_get_vars_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], int *buf); + int PIOc_get_var_text (int ncid, int varid, char *buf); + int PIOc_get_varm_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], double *buf); + int PIOc_get_vars_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], signed char *buf); + int PIOc_get_vara_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned short *buf); + int PIOc_get_var1_ushort (int ncid, int varid, const PIO_Offset index[], unsigned short *buf); + int PIOc_get_var_float (int ncid, int varid, float *buf); + int PIOc_get_vars_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned char *buf); + int PIOc_get_var (int ncid, int varid, void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_get_var1_longlong (int ncid, int varid, const PIO_Offset index[], long long *buf); + int PIOc_get_vars_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned short *buf); + int PIOc_get_var_long (int ncid, int varid, long *buf); + int PIOc_get_var1_double (int ncid, int varid, const PIO_Offset index[], double *buf); + int PIOc_get_vara_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned int *buf); + int PIOc_get_vars_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], long long *buf); + int PIOc_get_var_longlong (int ncid, int varid, long long *buf); + int PIOc_get_vara_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], short *buf); + int PIOc_get_vara_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], long *buf); + int PIOc_get_var1_int (int ncid, int varid, const PIO_Offset index[], int *buf); + int PIOc_get_var1_ulonglong (int ncid, int varid, const PIO_Offset index[], unsigned long long *buf); + int PIOc_get_var_uchar (int ncid, int varid, unsigned char *buf); + int PIOc_get_vara_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned char *buf); + int PIOc_get_vars_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], float *buf); + int PIOc_get_vars_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], long *buf); + int PIOc_get_var1 (int ncid, int varid, const PIO_Offset index[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_get_var_uint (int ncid, int varid, unsigned int *buf); + int PIOc_get_vara (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_get_vara_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], signed char *buf); + int PIOc_get_var1_uint (int ncid, int varid, const PIO_Offset index[], unsigned int *buf); + int PIOc_get_vars_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], unsigned int *buf); + int PIOc_get_vara_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], float *buf); + int PIOc_get_varm_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], char *buf); + int PIOc_get_var1_text (int ncid, int varid, const PIO_Offset index[], char *buf); + int PIOc_get_varm_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], int *buf); + int PIOc_get_varm_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned int *buf); + int PIOc_get_varm (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_get_vars_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], double *buf); + int PIOc_get_vara_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], long long *buf); + int PIOc_get_var_ulonglong (int ncid, int varid, unsigned long long *buf); + int PIOc_get_vara_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], unsigned long long *buf); + int PIOc_get_var_short (int ncid, int varid, short *buf); + int PIOc_get_varm_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], float *buf); + int PIOc_get_var1_long (int ncid, int varid, const PIO_Offset index[], long *buf); + int PIOc_get_varm_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], long *buf); + int PIOc_get_varm_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned short *buf); + int PIOc_get_varm_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], long long *buf); + int PIOc_get_vars_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], char *buf); + int PIOc_get_var1_uchar (int ncid, int varid, const PIO_Offset index[], unsigned char *buf); + int PIOc_get_vars (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype); + int PIOc_get_vars_tc(int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], nc_type xtype, void *buf); + int PIOc_get_varm_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], short *buf); + int PIOc_get_varm_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned long long *buf); + int PIOc_get_var_schar (int ncid, int varid, signed char *buf); + int PIOc_iotype_available(const int iotype); + int PIOc_set_log_level(int level); + int PIOc_put_att(int ncid, int varid, const char *name, nc_type xtype, PIO_Offset len, const void *op); + int PIOc_get_att(int ncid, int varid, const char *name, void *ip); + int PIOc_inq_type(int ncid, nc_type xtype, char *name, PIO_Offset *sizep); #if defined(__cplusplus) } #endif diff --git a/externals/pio2/src/clib/pio_darray.c b/externals/pio2/src/clib/pio_darray.c index 1a22ec6e11a4..bf734291a953 100644 --- a/externals/pio2/src/clib/pio_darray.c +++ b/externals/pio2/src/clib/pio_darray.c @@ -13,16 +13,20 @@ #include #include + #define PIO_WRITE_BUFFERING 1 PIO_Offset PIO_BUFFER_SIZE_LIMIT=10485760; // 10MB default limit bufsize PIO_CNBUFFER_LIMIT=33554432; static void *CN_bpool=NULL; static PIO_Offset maxusage=0; -/** @brief Set the pio buffer size limit, this is the size of the data buffer on the IO nodes. + +/** Set the pio buffer size limit. This is the size of the data buffer + * on the IO nodes. * + * The pio_buffer_size_limit will only apply to files opened after + * the setting is changed. * - * The pio_buffer_size_limit will only apply to files opened after the setting is changed. * @param limit the size of the buffer on the IO nodes * @return The previous limit setting. */ @@ -35,87 +39,108 @@ static PIO_Offset maxusage=0; return(oldsize); } -/** @brief Initialize the compute buffer to size PIO_CNBUFFER_LIMIT +/** Initialize the compute buffer to size PIO_CNBUFFER_LIMIT. + * + * This routine initializes the compute buffer pool if the bget memory + * management is used. * - * This routine initializes the compute buffer pool if the bget memory management is used. * @param ios the iosystem descriptor which will use the new buffer */ - void compute_buffer_init(iosystem_desc_t ios) { #ifndef PIO_USE_MALLOC - if(CN_bpool == NULL){ - CN_bpool = malloc( PIO_CNBUFFER_LIMIT ); - if(CN_bpool==NULL){ + if (!CN_bpool) + { + if (!(CN_bpool = malloc(PIO_CNBUFFER_LIMIT))) + { char errmsg[180]; - sprintf(errmsg,"Unable to allocate a buffer pool of size %d on task %d: try reducing PIO_CNBUFFER_LIMIT\n",PIO_CNBUFFER_LIMIT,ios.comp_rank); + sprintf(errmsg,"Unable to allocate a buffer pool of size %d on task %d:" + " try reducing PIO_CNBUFFER_LIMIT\n", PIO_CNBUFFER_LIMIT, ios.comp_rank); piodie(errmsg,__FILE__,__LINE__); } + bpool( CN_bpool, PIO_CNBUFFER_LIMIT); - if(CN_bpool==NULL){ + if (!CN_bpool) + { char errmsg[180]; - sprintf(errmsg,"Unable to allocate a buffer pool of size %d on task %d: try reducing PIO_CNBUFFER_LIMIT\n",PIO_CNBUFFER_LIMIT,ios.comp_rank); + sprintf(errmsg,"Unable to allocate a buffer pool of size %d on task %d:" + " try reducing PIO_CNBUFFER_LIMIT\n", PIO_CNBUFFER_LIMIT, ios.comp_rank); piodie(errmsg,__FILE__,__LINE__); } + bectl(NULL, malloc, free, PIO_CNBUFFER_LIMIT); } #endif } -/** @ingroup PIO_write_darray - * @brief Write a single distributed field to output. This routine is only used if aggregation is off. - * @param[in] file: a pointer to the open file descriptor for the file that will be written to +/** Write a single distributed field to output. This routine is only + * used if aggregation is off. + * + * @param[in] file: a pointer to the open file descriptor for the file + * that will be written to + * * @param[in] iodesc: a pointer to the defined iodescriptor for the buffer + * * @param[in] vid: the variable id to be written + * * @param[in] IOBUF: the buffer to be written from this mpi task - * @param[in] fillvalue: the optional fillvalue to be used for missing data in this buffer + * + * @param[in] fillvalue: the optional fillvalue to be used for missing + * data in this buffer + * + * @return 0 for success, error code otherwise. + * + * @ingroup PIO_write_darray */ - int pio_write_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void *IOBUF, void *fillvalue) +int pio_write_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, + void *IOBUF, void *fillvalue) { - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ var_desc_t *vdesc; int ndims; - int ierr; + int ierr = PIO_NOERR; /** Return code from function calls. */ int i; - int msg; - int mpierr; + int mpierr = MPI_SUCCESS; /** Return code from MPI function codes. */ int dsize; MPI_Status status; PIO_Offset usage; int fndims; - PIO_Offset tdsize; + PIO_Offset tdsize = 0; + #ifdef TIMING GPTLstart("PIO:write_darray_nc"); #endif - tdsize=0; - ierr = PIO_NOERR; - - ios = file->iosystem; - if(ios == NULL){ - fprintf(stderr,"Failed to find iosystem handle \n"); + /* Get the IO system info. */ + if (!(ios = file->iosystem)) return PIO_EBADID; - } - vdesc = (file->varlist)+vid; - if(vdesc == NULL){ - fprintf(stderr,"Failed to find variable handle %d\n",vid); + /* Get pointer to variable information. */ + if (!(vdesc = file->varlist + vid)) return PIO_EBADID; - } + ndims = iodesc->ndims; - msg = 0; - if(ios->async_interface && ! ios->ioproc){ - if(ios->comp_rank==0) + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = 0; + + if (ios->compmaster) mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + } } ierr = PIOc_inq_varndims(file->fh, vid, &fndims); - - if(ios->ioproc){ + if (ios->ioproc) + { io_region *region; int ncid = file->fh; int regioncnt; @@ -135,126 +160,157 @@ void compute_buffer_init(iosystem_desc_t ios) if(vdesc->record >= 0 && ndimsiotype == PIO_IOTYPE_PNETCDF){ - // make sure we have room in the buffer ; + /* make sure we have room in the buffer. */ + if (file->iotype == PIO_IOTYPE_PNETCDF) flush_output_buffer(file, false, tsize*(iodesc->maxiobuflen)); - } #endif rrcnt=0; - for(regioncnt=0;regioncntmaxregions;regioncnt++){ - for(i=0;imaxregions; regioncnt++) + { + for (i = 0; i < ndims; i++) + { start[i] = 0; count[i] = 0; } - if(region != NULL){ + if (region) + { bufptr = (void *)((char *) IOBUF+tsize*region->loffset); // this is a record based multidimensional array - if(vdesc->record >= 0){ + if (vdesc->record >= 0) + { start[0] = vdesc->record; - for(i=1;istart[i-1]; count[i] = region->count[i-1]; } if(count[1]>0) count[0] = 1; // Non-time dependent array - }else{ - for( i=0;istart[i]; count[i] = region->count[i]; } } } - switch(file->iotype){ + switch(file->iotype) + { #ifdef _NETCDF #ifdef _NETCDF4 case PIO_IOTYPE_NETCDF4P: + + /* Use collective writes with this variable. */ ierr = nc_var_par_access(ncid, vid, NC_COLLECTIVE); - if(iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8){ - ierr = nc_put_vara_double (ncid, vid,(size_t *) start,(size_t *) count, (const double *) bufptr); - } else if(iodesc->basetype == MPI_INTEGER){ - ierr = nc_put_vara_int (ncid, vid, (size_t *) start, (size_t *) count, (const int *) bufptr); - }else if(iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4){ - ierr = nc_put_vara_float (ncid, vid, (size_t *) start, (size_t *) count, (const float *) bufptr); - }else{ - fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",(int) iodesc->basetype); - } + if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + ierr = nc_put_vara_double(ncid, vid, (size_t *)start, (size_t *)count, + (const double *)bufptr); + else if (iodesc->basetype == MPI_INTEGER) + ierr = nc_put_vara_int(ncid, vid, (size_t *)start, (size_t *)count, + (const int *)bufptr); + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + ierr = nc_put_vara_float(ncid, vid, (size_t *)start, (size_t *)count, + (const float *)bufptr); + else + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n", + (int)iodesc->basetype); break; case PIO_IOTYPE_NETCDF4C: -#endif +#endif /* _NETCDF4 */ case PIO_IOTYPE_NETCDF: { mpierr = MPI_Type_size(iodesc->basetype, &dsize); size_t tstart[ndims], tcount[ndims]; - if(ios->io_rank==0){ - - for(i=0;inum_aiotasks;i++){ - if(i==0){ + if (ios->io_rank == 0) + { + for (i = 0; i < iodesc->num_aiotasks; i++) + { + if (i == 0) + { buflen=1; - for(j=0;jio_comm); // handshake - tell the sending task I'm ready mpierr = MPI_Recv( &buflen, 1, MPI_INT, i, 1, ios->io_comm, &status); - if(buflen>0){ - mpierr = MPI_Recv( tstart, ndims, MPI_OFFSET, i, ios->num_iotasks+i, ios->io_comm, &status); - mpierr = MPI_Recv( tcount, ndims, MPI_OFFSET, i,2*ios->num_iotasks+i, ios->io_comm, &status); + if (buflen > 0) + { + mpierr = MPI_Recv(tstart, ndims, MPI_OFFSET, i, ios->num_iotasks+i, + ios->io_comm, &status); + mpierr = MPI_Recv(tcount, ndims, MPI_OFFSET, i, 2 * ios->num_iotasks + i, + ios->io_comm, &status); tmp_buf = malloc(buflen * dsize); mpierr = MPI_Recv( tmp_buf, buflen, iodesc->basetype, i, i, ios->io_comm, &status); } } - if(buflen>0){ - if(iodesc->basetype == MPI_INTEGER){ + if (buflen>0) + { + if (iodesc->basetype == MPI_INTEGER) ierr = nc_put_vara_int (ncid, vid, tstart, tcount, (const int *) tmp_buf); - }else if(iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8){ + else if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) ierr = nc_put_vara_double (ncid, vid, tstart, tcount, (const double *) tmp_buf); - }else if(iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4){ + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) ierr = nc_put_vara_float (ncid,vid, tstart, tcount, (const float *) tmp_buf); - }else{ - fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",(int) iodesc->basetype); - } - if(ierr == PIO_EEDGE){ + else + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n", + (int)iodesc->basetype); + + if (ierr == PIO_EEDGE) for(i=0;iio_rank < iodesc->num_aiotasks ){ + } + else if (ios->io_rank < iodesc->num_aiotasks) + { buflen=1; - for(i=0;iio_rank,tstart[0],tstart[1],tcount[0],tcount[1],buflen,ndims,fndims); + /* printf("%s %d %d %d %d %d %d %d %d %d\n",__FILE__,__LINE__,ios->io_rank,tstart[0], + tstart[1],tcount[0],tcount[1],buflen,ndims,fndims);*/ mpierr = MPI_Recv( &ierr, 1, MPI_INT, 0, 0, ios->io_comm, &status); // task0 is ready to recieve mpierr = MPI_Rsend( &buflen, 1, MPI_INT, 0, 1, ios->io_comm); - if(buflen>0) { - mpierr = MPI_Rsend( tstart, ndims, MPI_OFFSET, 0, ios->num_iotasks+ios->io_rank, ios->io_comm); - mpierr = MPI_Rsend( tcount, ndims, MPI_OFFSET, 0,2*ios->num_iotasks+ios->io_rank, ios->io_comm); + if (buflen > 0) + { + mpierr = MPI_Rsend(tstart, ndims, MPI_OFFSET, 0, ios->num_iotasks+ios->io_rank, + ios->io_comm); + mpierr = MPI_Rsend(tcount, ndims, MPI_OFFSET, 0,2*ios->num_iotasks+ios->io_rank, + ios->io_comm); mpierr = MPI_Rsend( bufptr, buflen, iodesc->basetype, 0, ios->io_rank, ios->io_comm); } } break; } break; - #endif +#endif /* _NETCDF */ #ifdef _PNETCDF case PIO_IOTYPE_PNETCDF: - for( i=0,dsize=1;ibasetype); @@ -266,56 +322,57 @@ void compute_buffer_init(iosystem_desc_t ios) } } */ - if(dsize>0){ + if (dsize > 0) + { // printf("%s %d %d %d\n",__FILE__,__LINE__,ios->io_rank,dsize); startlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); countlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); - for( i=0; imaxregions-1){ + if (regioncnt == iodesc->maxregions - 1) + { // printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,ios->io_rank,iodesc->llen, tdsize); // ierr = ncmpi_put_varn_all(ncid, vid, iodesc->maxregions, startlist, countlist, // IOBUF, iodesc->llen, iodesc->basetype); int reqn=0; - - if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + if (vdesc->nreqs % PIO_REQUEST_ALLOC_CHUNK == 0 ) + { vdesc->request = realloc(vdesc->request, sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); - for(int i=vdesc->nreqs;inreqs+PIO_REQUEST_ALLOC_CHUNK;i++){ + for (int i = vdesc->nreqs; i < vdesc->nreqs + PIO_REQUEST_ALLOC_CHUNK; i++) vdesc->request[i]=NC_REQ_NULL; - } reqn = vdesc->nreqs; - }else{ - while(vdesc->request[reqn] != NC_REQ_NULL ){ - reqn++; - } } + else + while(vdesc->request[reqn] != NC_REQ_NULL) + reqn++; ierr = ncmpi_bput_varn(ncid, vid, rrcnt, startlist, countlist, IOBUF, iodesc->llen, iodesc->basetype, vdesc->request+reqn); - if(vdesc->request[reqn] == NC_REQ_NULL){ + if (vdesc->request[reqn] == NC_REQ_NULL) vdesc->request[reqn] = PIO_REQ_NULL; //keeps wait calls in sync - } vdesc->nreqs = reqn; // printf("%s %d %X %d\n",__FILE__,__LINE__,IOBUF,request); - for(i=0;iiotype,__FILE__,__LINE__); } - if(region != NULL) + if (region) region = region->next; } // for(regioncnt=0;regioncntmaxregions;regioncnt++){ } // if(ios->ioproc) @@ -328,11 +385,12 @@ void compute_buffer_init(iosystem_desc_t ios) return ierr; } -/** @brief Write a set of one or more aggregated arrays to output file +/** Write a set of one or more aggregated arrays to output file * @ingroup PIO_write_darray * * This routine is used if aggregation is enabled, data is already on the * io-tasks + * * @param[in] file: a pointer to the open file descriptor for the file that will be written to * @param[in] nvars: the number of variables to be written with this decomposition * @param[in] vid: an array of the variable ids to be written @@ -353,12 +411,11 @@ int pio_write_darray_multi_nc(file_desc_t *file, const int nvars, const int vid[ const int maxiobuflen, const int num_aiotasks, void *IOBUF, const int frame[]) { - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ var_desc_t *vdesc; int ierr; int i; - int msg; - int mpierr; + int mpierr = MPI_SUCCESS; /** Return code from MPI function codes. */ int dsize; MPI_Status status; PIO_Offset usage; @@ -373,29 +430,39 @@ int pio_write_darray_multi_nc(file_desc_t *file, const int nvars, const int vid[ #endif ios = file->iosystem; - if(ios == NULL){ + if (ios == NULL) + { fprintf(stderr,"Failed to find iosystem handle \n"); return PIO_EBADID; } vdesc = (file->varlist)+vid[0]; ncid = file->fh; - if(vdesc == NULL){ + if (vdesc == NULL) + { fprintf(stderr,"Failed to find variable handle %d\n",vid[0]); return PIO_EBADID; } - msg = 0; - if(ios->async_interface && ! ios->ioproc){ - if(ios->comp_rank==0) + /* If async is in use, send message to IO master task. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = 0; + if (ios->compmaster) mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); } + } ierr = PIOc_inq_varndims(file->fh, vid[0], &fndims); MPI_Type_size(basetype, &tsize); - if(ios->ioproc){ + if (ios->ioproc) + { io_region *region; int regioncnt; int rrcnt; @@ -411,104 +478,141 @@ int pio_write_darray_multi_nc(file_desc_t *file, const int nvars, const int vid[ ncid = file->fh; region = firstregion; - rrcnt=0; - for(regioncnt=0;regioncntstart[0],region->count[0],ndims,fndims,vdesc->record); - for(i=0;irecord >= 0){ - for(i=fndims-ndims;irecord >= 0) + { + for (i = fndims - ndims; i < fndims; i++) + { start[i] = region->start[i-(fndims-ndims)]; count[i] = region->count[i-(fndims-ndims)]; } - if(fndims>1 && ndims0){ + if (fndims>1 && ndims0) + { count[0] = 1; start[0] = frame[0]; - }else if(fndims==ndims){ + } + else if (fndims==ndims) + { start[0]+=vdesc->record; } // Non-time dependent array - }else{ - for( i=0;istart[i]; count[i] = region->count[i]; } } } - switch(file->iotype){ + switch(file->iotype) + { #ifdef _NETCDF4 case PIO_IOTYPE_NETCDF4P: - for(int nv=0; nvrecord >= 0 && ndimsrecord >= 0 && ndims < fndims) + { start[0] = frame[nv]; } - if(region != NULL){ + if (region) + { bufptr = (void *)((char *) IOBUF + tsize*(nv*llen + region->loffset)); } ierr = nc_var_par_access(ncid, vid[nv], NC_COLLECTIVE); - if(basetype == MPI_DOUBLE ||basetype == MPI_REAL8){ - ierr = nc_put_vara_double (ncid, vid[nv],(size_t *) start,(size_t *) count, (const double *) bufptr); - } else if(basetype == MPI_INTEGER){ - ierr = nc_put_vara_int (ncid, vid[nv], (size_t *) start, (size_t *) count, (const int *) bufptr); - }else if(basetype == MPI_FLOAT || basetype == MPI_REAL4){ - ierr = nc_put_vara_float (ncid, vid[nv], (size_t *) start, (size_t *) count, (const float *) bufptr); - }else{ - fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",(int) basetype); + if (basetype == MPI_DOUBLE ||basetype == MPI_REAL8) + { + ierr = nc_put_vara_double (ncid, vid[nv],(size_t *) start,(size_t *) count, + (const double *)bufptr); + } + else if (basetype == MPI_INTEGER) + { + ierr = nc_put_vara_int (ncid, vid[nv], (size_t *) start, (size_t *) count, + (const int *)bufptr); + } + else if (basetype == MPI_FLOAT || basetype == MPI_REAL4) + { + ierr = nc_put_vara_float (ncid, vid[nv], (size_t *) start, (size_t *) count, + (const float *)bufptr); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n", + (int)basetype); } } break; #endif #ifdef _PNETCDF case PIO_IOTYPE_PNETCDF: - for( i=0,dsize=1;i0){ + if (dsize>0) + { // printf("%s %d %d %d\n",__FILE__,__LINE__,ios->io_rank,dsize); startlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); countlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); - for( i=0; iio_rank,iodesc->llen, tdsize); // ierr = ncmpi_put_varn_all(ncid, vid, iodesc->maxregions, startlist, countlist, // IOBUF, iodesc->llen, iodesc->basetype); //printf("%s %d %ld \n",__FILE__,__LINE__,IOBUF); - for(int nv=0; nvvarlist)+vid[nv]; - if(vdesc->record >= 0 && ndimsrecord >= 0 && ndimsnreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + if (vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ) + { vdesc->request = realloc(vdesc->request, sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); - for(int i=vdesc->nreqs;inreqs+PIO_REQUEST_ALLOC_CHUNK;i++){ + for (int i=vdesc->nreqs;inreqs+PIO_REQUEST_ALLOC_CHUNK;i++) + { vdesc->request[i]=NC_REQ_NULL; } reqn = vdesc->nreqs; - }else{ - while(vdesc->request[reqn] != NC_REQ_NULL){ + } + else + { + while(vdesc->request[reqn] != NC_REQ_NULL) + { reqn++; } } @@ -518,16 +622,20 @@ int pio_write_darray_multi_nc(file_desc_t *file, const int nvars, const int vid[ ierr = ncmpi_bput_varn(ncid, vid[nv], rrcnt, startlist, countlist, bufptr, llen, basetype, &(vdesc->request)); */ - if(vdesc->request[reqn] == NC_REQ_NULL){ + if (vdesc->request[reqn] == NC_REQ_NULL) + { vdesc->request[reqn] = PIO_REQ_NULL; //keeps wait calls in sync } vdesc->nreqs += reqn+1; // printf("%s %d %d %d\n",__FILE__,__LINE__,vdesc->nreqs,vdesc->request[reqn]); } - for(i=0;iiotype,__FILE__,__LINE__); } - if(region != NULL) + if (region) region = region->next; } // for(regioncnt=0;regioncntmaxregions;regioncnt++){ } // if(ios->ioproc) @@ -578,12 +686,11 @@ int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const i const int maxiobuflen, const int num_aiotasks, void *IOBUF, const int frame[]) { - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ var_desc_t *vdesc; int ierr; int i; - int msg; - int mpierr; + int mpierr = MPI_SUCCESS; /** Return code from MPI function codes. */ int dsize; MPI_Status status; PIO_Offset usage; @@ -597,30 +704,40 @@ int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const i GPTLstart("PIO:write_darray_multi_nc_serial"); #endif - ios = file->iosystem; - if(ios == NULL){ + if (!(ios = file->iosystem)) + { fprintf(stderr,"Failed to find iosystem handle \n"); return PIO_EBADID; } - vdesc = (file->varlist)+vid[0]; + ncid = file->fh; - if(vdesc == NULL){ + if (!(vdesc = (file->varlist) + vid[0])) + { fprintf(stderr,"Failed to find variable handle %d\n",vid[0]); return PIO_EBADID; } - msg = 0; - if(ios->async_interface && ! ios->ioproc){ + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (! ios->ioproc) + { + int msg = 0; + if(ios->comp_rank==0) mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); } + } ierr = PIOc_inq_varndims(file->fh, vid[0], &fndims); MPI_Type_size(basetype, &tsize); - if(ios->ioproc){ + if (ios->ioproc) + { io_region *region; int regioncnt; int rrcnt; @@ -636,21 +753,29 @@ int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const i rrcnt=0; - for(regioncnt=0;regioncntrecord >= 0){ - for(i=fndims-ndims;irecord >= 0) + { + for (i = fndims - ndims; i < fndims; i++) + { tmp_start[i+regioncnt*fndims] = region->start[i-(fndims-ndims)]; tmp_count[i+regioncnt*fndims] = region->count[i-(fndims-ndims)]; } // Non-time dependent array - }else{ - for( i=0;istart[i]; tmp_count[i+regioncnt*fndims] = region->count[i]; } @@ -658,25 +783,31 @@ int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const i region = region->next; } } - if(ios->io_rank>0){ + if (ios->io_rank > 0) + { mpierr = MPI_Recv( &ierr, 1, MPI_INT, 0, 0, ios->io_comm, &status); // task0 is ready to recieve MPI_Send( &llen, 1, MPI_OFFSET, 0, ios->io_rank, ios->io_comm); - if(llen>0){ + if (llen>0) + { MPI_Send( &maxregions, 1, MPI_INT, 0, ios->io_rank+ios->num_iotasks, ios->io_comm); MPI_Send( tmp_start, maxregions*fndims, MPI_OFFSET, 0, ios->io_rank+2*ios->num_iotasks, ios->io_comm); MPI_Send( tmp_count, maxregions*fndims, MPI_OFFSET, 0, ios->io_rank+3*ios->num_iotasks, ios->io_comm); // printf("%s %d %ld\n",__FILE__,__LINE__,nvars*llen); MPI_Send( IOBUF, nvars*llen, basetype, 0, ios->io_rank+4*ios->num_iotasks, ios->io_comm); } - }else{ + } + else + { size_t rlen; int rregions; size_t start[fndims], count[fndims]; size_t loffset; mpierr = MPI_Type_size(basetype, &dsize); - for(int rtask=0; rtasknum_iotasks; rtask++){ - if(rtask>0){ + for (int rtask=0; rtasknum_iotasks; rtask++) + { + if (rtask>0) + { mpierr = MPI_Send( &ierr, 1, MPI_INT, rtask, 0, ios->io_comm); // handshake - tell the sending task I'm ready MPI_Recv( &rlen, 1, MPI_OFFSET, rtask, rtask, ios->io_comm, &status); if(rlen>0){ @@ -686,40 +817,54 @@ int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const i // printf("%s %d %d %ld\n",__FILE__,__LINE__,rtask,nvars*rlen); MPI_Recv( IOBUF, nvars*rlen, basetype, rtask, rtask+4*ios->num_iotasks, ios->io_comm, &status); } - }else{ + } + else + { rlen = llen; rregions = maxregions; } - if(rlen>0){ + if (rlen>0) + { loffset = 0; - for(regioncnt=0;regioncntrecord>=0){ - if(fndims>1 && ndims0){ + if (vdesc->record>=0) + { + if (fndims>1 && ndims0) + { count[0] = 1; start[0] = frame[nv]; - }else if(fndims==ndims){ + } + else if (fndims==ndims) + { start[0]+=vdesc->record; } } - - - - if(basetype == MPI_INTEGER){ + if (basetype == MPI_INTEGER) + { ierr = nc_put_vara_int (ncid, vid[nv], start, count, (const int *) bufptr); - }else if(basetype == MPI_DOUBLE || basetype == MPI_REAL8){ + } + else if (basetype == MPI_DOUBLE || basetype == MPI_REAL8) + { ierr = nc_put_vara_double (ncid, vid[nv], start, count, (const double *) bufptr); - }else if(basetype == MPI_FLOAT || basetype == MPI_REAL4){ + } + else if (basetype == MPI_FLOAT || basetype == MPI_REAL4) + { ierr = nc_put_vara_float (ncid,vid[nv], start, count, (const float *) bufptr); - }else{ + } + else + { fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",(int) basetype); } @@ -730,7 +875,8 @@ int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const i } size_t tsize; tsize = 1; - for(int i=0;imode & PIO_WRITE)){ + if (! (file->mode & PIO_WRITE)) + { fprintf(stderr,"ERROR: Attempt to write to read-only file\n"); return PIO_EPERM; } iodesc = pio_get_iodesc_from_id(ioid); - if(iodesc == NULL){ + if (iodesc == NULL) + { // print_trace(NULL); //fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); return PIO_EBADID; @@ -791,42 +950,57 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con ios = file->iosystem; // rlen = iodesc->llen*nvars; rlen=0; - if(iodesc->llen>0){ + if (iodesc->llen>0) + { rlen = iodesc->maxiobuflen*nvars; } - if(vdesc0->iobuf != NULL){ + if (vdesc0->iobuf) + { piodie("Attempt to overwrite existing io buffer",__FILE__,__LINE__); } - if(iodesc->rearranger>0){ - if(rlen>0){ + if (iodesc->rearranger>0) + { + if (rlen>0) + { MPI_Type_size(iodesc->basetype, &vsize); vdesc0->iobuf = bget((size_t) vsize* (size_t) rlen); - if(vdesc0->iobuf==NULL){ + if (vdesc0->iobuf==NULL) + { printf("%s %d %d %ld\n",__FILE__,__LINE__,nvars,vsize*rlen); piomemerror(*ios,(size_t) rlen*(size_t) vsize, __FILE__,__LINE__); } - if(iodesc->needsfill && iodesc->rearranger==PIO_REARR_BOX){ - if(vsize==4){ - for(int nv=0;nv < nvars; nv++){ - for(int i=0;imaxiobuflen;i++){ + if (iodesc->needsfill && iodesc->rearranger==PIO_REARR_BOX) + { + if (vsize==4) + { + for (int nv=0;nv < nvars; nv++) + { + for (int i=0;imaxiobuflen;i++) + { ((float *) vdesc0->iobuf)[i+nv*(iodesc->maxiobuflen)] = ((float *)fillvalue)[nv]; } } - }else if(vsize==8){ - for(int nv=0;nv < nvars; nv++){ - for(int i=0;imaxiobuflen;i++){ + } + else if (vsize==8) + { + for (int nv=0;nv < nvars; nv++) + { + for (int i=0;imaxiobuflen;i++) + { ((double *)vdesc0->iobuf)[i+nv*(iodesc->maxiobuflen)] = ((double *)fillvalue)[nv]; } } } } } + ierr = rearrange_comp2io(*ios, iodesc, array, vdesc0->iobuf, nvars); }/* this is wrong, need to think about it else{ vdesc0->iobuf = array; } */ - switch(file->iotype){ + switch(file->iotype) + { case PIO_IOTYPE_NETCDF4P: case PIO_IOTYPE_PNETCDF: ierr = pio_write_darray_multi_nc(file, nvars, vid, @@ -842,7 +1016,8 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con iodesc->maxregions, iodesc->firstregion, iodesc->llen, iodesc->maxiobuflen, iodesc->num_aiotasks, vdesc0->iobuf, frame); - if(vdesc0->iobuf != NULL){ + if (vdesc0->iobuf) + { brel(vdesc0->iobuf); vdesc0->iobuf = NULL; } @@ -850,30 +1025,38 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con } - - if(iodesc->rearranger == PIO_REARR_SUBSET && iodesc->needsfill && - iodesc->holegridsize>0){ - if(vdesc0->fillbuf != NULL){ + iodesc->holegridsize>0) + { + if (vdesc0->fillbuf) + { piodie("Attempt to overwrite existing buffer",__FILE__,__LINE__); } vdesc0->fillbuf = bget(iodesc->holegridsize*vsize*nvars); //printf("%s %d %x\n",__FILE__,__LINE__,vdesc0->fillbuf); - if(vsize==4){ - for(int nv=0;nvholegridsize;i++){ + if (vsize==4) + { + for (int nv=0;nvholegridsize;i++) + { ((float *) vdesc0->fillbuf)[i+nv*iodesc->holegridsize] = ((float *) fillvalue)[nv]; } } - }else if(vsize==8){ - for(int nv=0;nvholegridsize;i++){ + } + else if (vsize==8) + { + for (int nv=0;nvholegridsize;i++) + { ((double *) vdesc0->fillbuf)[i+nv*iodesc->holegridsize] = ((double *) fillvalue)[nv]; } } } - switch(file->iotype){ + switch(file->iotype) + { case PIO_IOTYPE_PNETCDF: ierr = pio_write_darray_multi_nc(file, nvars, vid, iodesc->ndims, iodesc->basetype, iodesc->gsize, @@ -902,13 +1085,10 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con flush_output_buffer(file, flushtodisk, 0); - return ierr; - } -/** @brief Write a distributed array to the output file. - * @ingroup PIO_write_darray +/** Write a distributed array to the output file. * * This routine aggregates output on the compute nodes and only sends * it to the IO nodes when the compute buffer is full or when a flush @@ -918,24 +1098,23 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con * @param[in] vid: the variable ID returned by PIOc_def_var(). * @param[in] ioid: the I/O description ID as passed back by * PIOc_InitDecomp(). - * @param[in] arraylen: the length of the array to be written. This * is the length of the distrubited array. That is, the length of * the portion of the data that is on the processor. - * @param[in] array: pointer to the data to be written. This is a * pointer to the distributed portion of the array that is on this * processor. - * @param[in] fillvalue: pointer to the fill value to be used for * missing data. * * @returns 0 for success, non-zero error code for failure. + * @ingroup PIO_write_darray */ #ifdef PIO_WRITE_BUFFERING - int PIOc_write_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, void *array, void *fillvalue) +int PIOc_write_darray(const int ncid, const int vid, const int ioid, + const PIO_Offset arraylen, void *array, void *fillvalue) { - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ file_desc_t *file; io_desc_t *iodesc; var_desc_t *vdesc; @@ -955,50 +1134,53 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con ierr = PIO_NOERR; needsflush = 0; // false file = pio_get_file_from_id(ncid); - if(file == NULL){ + if (file == NULL) + { fprintf(stderr,"File handle not found %d %d\n",ncid,__LINE__); return PIO_EBADID; } - if(! (file->mode & PIO_WRITE)){ + if (! (file->mode & PIO_WRITE)) + { fprintf(stderr,"ERROR: Attempt to write to read-only file\n"); return PIO_EPERM; } iodesc = pio_get_iodesc_from_id(ioid); - if(iodesc == NULL){ + if (iodesc == NULL) + { fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); return PIO_EBADID; } ios = file->iosystem; - vdesc = (file->varlist)+vid; if(vdesc == NULL) return PIO_EBADID; - if(vdesc->record<0){ - recordvar=false; - }else{ - recordvar=true; - } - if(iodesc->ndof != arraylen){ + /* Is this a record variable? */ + recordvar = vdesc->record < 0 ? true : false; + + if (iodesc->ndof != arraylen) + { fprintf(stderr,"ndof=%ld, arraylen=%ld\n",iodesc->ndof,arraylen); piodie("ndof != arraylen",__FILE__,__LINE__); } wmb = &(file->buffer); - if(wmb->ioid == -1){ - if(recordvar){ + if (wmb->ioid == -1) + { + if (recordvar) wmb->ioid = ioid; - }else{ + else wmb->ioid = -(ioid); } - }else{ + else + { // separate record and non-record variables - if(recordvar){ - while(wmb->next != NULL && wmb->ioid!=ioid){ + if (recordvar) + { + while(wmb->next && wmb->ioid!=ioid) if(wmb->next!=NULL) wmb = wmb->next; - } #ifdef _PNETCDF /* flush the previous record before starting a new one. this is collective */ // if(vdesc->request != NULL && (vdesc->request[0] != NC_REQ_NULL) || @@ -1006,25 +1188,27 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con // needsflush = 2; // flush to disk // } #endif - }else{ - while(wmb->next != NULL && wmb->ioid!= -(ioid)){ + } + else + { + while(wmb->next && wmb->ioid!= -(ioid)) + { if(wmb->next!=NULL) wmb = wmb->next; } } } - if((recordvar && wmb->ioid != ioid) || (!recordvar && wmb->ioid != -(ioid))){ + if ((recordvar && wmb->ioid != ioid) || (!recordvar && wmb->ioid != -(ioid))) + { wmb->next = (wmulti_buffer *) bget((bufsize) sizeof(wmulti_buffer)); - if(wmb->next == NULL){ + if (wmb->next == NULL) piomemerror(*ios,sizeof(wmulti_buffer), __FILE__,__LINE__); - } wmb=wmb->next; wmb->next=NULL; - if(recordvar){ + if (recordvar) wmb->ioid = ioid; - }else{ + else wmb->ioid = -(ioid); - } wmb->validvars=0; wmb->arraylen=arraylen; wmb->vid=NULL; @@ -1033,68 +1217,71 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con wmb->fillvalue=NULL; } - MPI_Type_size(iodesc->basetype, &tsize); // At this point wmb should be pointing to a new or existing buffer // so we can add the data // printf("%s %d %X %d %d %d\n",__FILE__,__LINE__,wmb->data,wmb->validvars,arraylen,tsize); // cn_buffer_report(*ios, true); bfreespace(&totfree, &maxfree); - if(needsflush==0){ + if (needsflush == 0) needsflush = (maxfree <= 1.1*(1+wmb->validvars)*arraylen*tsize ); - } MPI_Allreduce(MPI_IN_PLACE, &needsflush, 1, MPI_INT, MPI_MAX, ios->comp_comm); - - if(needsflush > 0 ){ + if (needsflush > 0 ) + { // need to flush first // printf("%s %d %ld %d %ld %ld\n",__FILE__,__LINE__,maxfree, wmb->validvars, (1+wmb->validvars)*arraylen*tsize,totfree); cn_buffer_report(*ios, true); flush_buffer(ncid,wmb, needsflush==2); // if needsflush == 2 flush to disk otherwise just flush to io node } - if(arraylen > 0){ - wmb->data = bgetr( wmb->data, (1+wmb->validvars)*arraylen*tsize); - if(wmb->data == NULL){ + + if (arraylen > 0) + if (!(wmb->data = bgetr(wmb->data, (1+wmb->validvars)*arraylen*tsize))) piomemerror(*ios, (1+wmb->validvars)*arraylen*tsize , __FILE__,__LINE__); - } - } - wmb->vid = (int *) bgetr( wmb->vid,sizeof(int)*( 1+wmb->validvars)); - if(wmb->vid == NULL){ + + if (!(wmb->vid = (int *) bgetr(wmb->vid,sizeof(int)*(1+wmb->validvars)))) piomemerror(*ios, (1+wmb->validvars)*sizeof(int) , __FILE__,__LINE__); - } - if(vdesc->record>=0){ - wmb->frame = (int *) bgetr( wmb->frame,sizeof(int)*( 1+wmb->validvars)); - if(wmb->frame == NULL){ + + if (vdesc->record >= 0) + if (!(wmb->frame = (int *)bgetr(wmb->frame, sizeof(int) * (1 + wmb->validvars)))) piomemerror(*ios, (1+wmb->validvars)*sizeof(int) , __FILE__,__LINE__); - } - } - if(iodesc->needsfill){ - wmb->fillvalue = bgetr( wmb->fillvalue,tsize*( 1+wmb->validvars)); - if(wmb->fillvalue == NULL){ - piomemerror(*ios, (1+wmb->validvars)*tsize , __FILE__,__LINE__); - } - } + if (iodesc->needsfill) + if (!(wmb->fillvalue = bgetr(wmb->fillvalue,tsize*(1+wmb->validvars)))) + piomemerror(*ios, (1+wmb->validvars)*tsize , __FILE__,__LINE__); - if(iodesc->needsfill){ - if(fillvalue != NULL){ + if (iodesc->needsfill) + { + if (fillvalue) + { memcpy((char *) wmb->fillvalue+tsize*wmb->validvars,fillvalue, tsize); - }else{ + } + else + { vtype = (MPI_Datatype) iodesc->basetype; - if(vtype == MPI_INTEGER){ + if (vtype == MPI_INTEGER) + { int fill = PIO_FILL_INT; memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); - }else if(vtype == MPI_FLOAT || vtype == MPI_REAL4){ + } + else if (vtype == MPI_FLOAT || vtype == MPI_REAL4) + { float fill = PIO_FILL_FLOAT; memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); - }else if(vtype == MPI_DOUBLE || vtype == MPI_REAL8){ + } + else if (vtype == MPI_DOUBLE || vtype == MPI_REAL8) + { double fill = PIO_FILL_DOUBLE; memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); - }else if(vtype == MPI_CHARACTER){ + } + else if (vtype == MPI_CHARACTER) + { char fill = PIO_FILL_CHAR; memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); - }else{ + } + else + { fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",vtype); } } @@ -1104,9 +1291,8 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con wmb->arraylen = arraylen; wmb->vid[wmb->validvars]=vid; bufptr = (void *)((char *) wmb->data + arraylen*tsize*wmb->validvars); - if(arraylen>0){ + if (arraylen>0) memcpy(bufptr, array, arraylen*tsize); - } /* if(tsize==8){ double asum=0.0; @@ -1120,30 +1306,37 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con // printf("%s %d %d %d %d %X\n",__FILE__,__LINE__,wmb->validvars,wmb->ioid,vid,bufptr); - if(wmb->frame!=NULL){ + if (wmb->frame!=NULL) wmb->frame[wmb->validvars]=vdesc->record; - } wmb->validvars++; // printf("%s %d %d %d %d %d\n",__FILE__,__LINE__,wmb->validvars,iodesc->maxbytes/tsize, iodesc->ndof, iodesc->llen); - if(wmb->validvars >= iodesc->maxbytes/tsize){ + if (wmb->validvars >= iodesc->maxbytes/tsize) PIOc_sync(ncid); - } return ierr; - } #else -/** @brief Write a distributed array to the output file +/** Write a distributed array to the output file. * @ingroup PIO_write_darray * - * This version of the routine does not buffer, all data is communicated to the io tasks - * before the routine returns + * This version of the routine does not buffer, all data is + * communicated to the io tasks before the routine returns. + * + * @param ncid identifies the netCDF file + * @param vid + * @param ioid + * @param arraylen + * @param array + * @param fillvalue + * + * @return */ - int PIOc_write_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, void *array, void *fillvalue) +int PIOc_write_darray(const int ncid, const int vid, const int ioid, + const PIO_Offset arraylen, void *array, void *fillvalue) { - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ file_desc_t *file; io_desc_t *iodesc; void *iobuf; @@ -1156,12 +1349,14 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con file = pio_get_file_from_id(ncid); - if(file == NULL){ + if (file == NULL) + { fprintf(stderr,"File handle not found %d %d\n",ncid,__LINE__); return PIO_EBADID; } iodesc = pio_get_iodesc_from_id(ioid); - if(iodesc == NULL){ + if (iodesc == NULL) + { fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); return PIO_EBADID; } @@ -1170,20 +1365,20 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con ios = file->iosystem; rlen = iodesc->llen; - if(iodesc->rearranger>0){ - if(rlen>0){ + if (iodesc->rearranger>0) + { + if (rlen>0) + { MPI_Type_size(iodesc->basetype, &tsize); // iobuf = bget(tsize*rlen); iobuf = malloc((size_t) tsize*rlen); - if(iobuf==NULL){ + if (!iobuf) piomemerror(*ios,rlen*(size_t) tsize, __FILE__,__LINE__); } - } // printf(" rlen = %d %ld\n",rlen,iobuf); // } - ierr = rearrange_comp2io(*ios, iodesc, array, iobuf, 1); printf("%s %d ",__FILE__,__LINE__); @@ -1191,10 +1386,13 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con printf(" %d ",((int *) iobuf)[n]); printf("\n"); - }else{ + } + else + { iobuf = array; } - switch(file->iotype){ + switch(file->iotype) + { case PIO_IOTYPE_PNETCDF: case PIO_IOTYPE_NETCDF: case PIO_IOTYPE_NETCDF4P: @@ -1206,17 +1404,22 @@ int PIOc_write_darray_multi(const int ncid, const int vid[], const int ioid, con free(iobuf); return ierr; - } #endif -/** @brief Read an array of data from a file to the (parallel) IO library. +/** Read an array of data from a file to the (parallel) IO library. * @ingroup PIO_read_darray + * + * @param file + * @param iodesc + * @param vid + * @param IOBUF */ -int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void *IOBUF) +int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, + void *IOBUF) { int ierr=PIO_NOERR; - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ var_desc_t *vdesc; int ndims, fndims; MPI_Status status; @@ -1240,7 +1443,8 @@ int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void if(fndims==ndims) vdesc->record=-1; - if(ios->ioproc){ + if (ios->ioproc) + { io_region *region; size_t start[fndims]; size_t count[fndims]; @@ -1261,21 +1465,27 @@ int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void // calling program to change the basetype. region = iodesc->firstregion; MPI_Type_size(iodesc->basetype, &tsize); - if(fndims>ndims){ + if (fndims>ndims) + { ndims++; if(vdesc->record<0) vdesc->record=0; } - for(regioncnt=0;regioncntmaxregions;regioncnt++){ + for (regioncnt=0;regioncntmaxregions;regioncnt++) + { // printf("%s %d %d %ld %d %d\n",__FILE__,__LINE__,regioncnt,region,fndims,ndims); tmp_bufsize=1; - if(region==NULL || iodesc->llen==0){ - for(i=0;illen==0) + { + for (i=0;illen - region->loffset, iodesc->llen, region->loffset); - if(vdesc->record >= 0 && fndims>1){ + if (vdesc->record >= 0 && fndims>1) + { start[0] = vdesc->record; - for(i=1;istart[i-1]; count[i] = region->count[i-1]; // printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,i,start[i],count[i]); } if(count[1]>0) count[0] = 1; - }else{ + } + else + { // Non-time dependent array - for(i=0;istart[i]; count[i] = region->count[i]; // printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,i,start[i],count[i]); @@ -1302,16 +1517,24 @@ int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void } } - switch(file->iotype){ + switch(file->iotype) + { #ifdef _NETCDF4 case PIO_IOTYPE_NETCDF4P: - if(iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8){ + if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + { ierr = nc_get_vara_double (file->fh, vid,start,count, bufptr); - } else if(iodesc->basetype == MPI_INTEGER){ + } + else if (iodesc->basetype == MPI_INTEGER) + { ierr = nc_get_vara_int (file->fh, vid, start, count, bufptr); - }else if(iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4){ + } + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + { ierr = nc_get_vara_float (file->fh, vid, start, count, bufptr); - }else{ + } + else + { fprintf(stderr,"Type not recognized %d in pioc_read_darray\n",(int) iodesc->basetype); } break; @@ -1320,25 +1543,29 @@ int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void case PIO_IOTYPE_PNETCDF: { tmp_bufsize=1; - for(int j=0;j0){ + if (tmp_bufsize > 0) + { startlist[rrlen] = (PIO_Offset *) bget(fndims * sizeof(PIO_Offset)); countlist[rrlen] = (PIO_Offset *) bget(fndims * sizeof(PIO_Offset)); - for(int j=0;jmaxregions, j,start[j],count[j],tmp_bufsize); + /* printf("%s %d %d %d %d %ld %ld %ld\n",__FILE__,__LINE__,realregioncnt, + iodesc->maxregions, j,start[j],count[j],tmp_bufsize);*/ } rrlen++; } - if(regioncnt==iodesc->maxregions-1){ + if (regioncnt==iodesc->maxregions-1) + { ierr = ncmpi_get_varn_all(file->fh, vid, rrlen, startlist, countlist, IOBUF, iodesc->llen, iodesc->basetype); - for(i=0;iiotype,__FILE__,__LINE__); } - if(region != NULL) + if (region) region = region->next; } // for(regioncnt=0;...) } @@ -1363,14 +1590,21 @@ int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, void return ierr; } - -/** @brief Read an array of data from a file to the (serial) IO library. +/** Read an array of data from a file to the (serial) IO library. * @ingroup PIO_read_darray + * + * @param file + * @param iodesc + * @param vid + * @param IOBUF + * + * @returns */ -int pio_read_darray_nc_serial(file_desc_t *file, io_desc_t *iodesc, const int vid, void *IOBUF) +int pio_read_darray_nc_serial(file_desc_t *file, io_desc_t *iodesc, + const int vid, void *IOBUF) { int ierr=PIO_NOERR; - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ var_desc_t *vdesc; int ndims, fndims; MPI_Status status; @@ -1394,7 +1628,8 @@ int pio_read_darray_nc_serial(file_desc_t *file, io_desc_t *iodesc, const int vi if(fndims==ndims) vdesc->record=-1; - if(ios->ioproc){ + if (ios->ioproc) + { io_region *region; size_t start[fndims]; size_t count[fndims]; @@ -1413,80 +1648,114 @@ int pio_read_darray_nc_serial(file_desc_t *file, io_desc_t *iodesc, const int vi // calling program to change the basetype. region = iodesc->firstregion; MPI_Type_size(iodesc->basetype, &tsize); - if(fndims>ndims){ + if (fndims>ndims) + { if(vdesc->record<0) vdesc->record=0; } - for(regioncnt=0;regioncntmaxregions;regioncnt++){ - if(region==NULL || iodesc->llen==0){ - for(i=0;imaxregions;regioncnt++) + { + if (region==NULL || iodesc->llen==0) + { + for (i = 0; i < fndims; i++) + { tmp_start[i+regioncnt*fndims] = 0; tmp_count[i+regioncnt*fndims] = 0; } bufptr=NULL; - }else{ - if(vdesc->record >= 0 && fndims>1){ + } + else + { + if (vdesc->record >= 0 && fndims>1) + { tmp_start[regioncnt*fndims] = vdesc->record; - for(i=1;istart[i-1]; tmp_count[i+regioncnt*fndims] = region->count[i-1]; } if(tmp_count[1+regioncnt*fndims]>0) tmp_count[regioncnt*fndims] = 1; - }else{ + } + else + { // Non-time dependent array - for(i=0;istart[i]; tmp_count[i+regioncnt*fndims] = region->count[i]; } } /* for(i=0;inext; } // for(regioncnt=0;...) - if(ios->io_rank>0){ + if (ios->io_rank>0) + { MPI_Send( &(iodesc->llen), 1, MPI_OFFSET, 0, ios->io_rank, ios->io_comm); - if(iodesc->llen > 0){ - MPI_Send( &(iodesc->maxregions), 1, MPI_INT, 0, ios->num_iotasks+ios->io_rank, ios->io_comm); - MPI_Send( tmp_count, iodesc->maxregions*fndims, MPI_OFFSET, 0, 2*ios->num_iotasks+ios->io_rank, ios->io_comm); - MPI_Send( tmp_start, iodesc->maxregions*fndims, MPI_OFFSET, 0, 3*ios->num_iotasks+ios->io_rank, ios->io_comm); - MPI_Recv(IOBUF, iodesc->llen, iodesc->basetype, 0, 4*ios->num_iotasks+ios->io_rank, ios->io_comm, &status); + if (iodesc->llen > 0) + { + MPI_Send(&(iodesc->maxregions), 1, MPI_INT, 0, + ios->num_iotasks + ios->io_rank, ios->io_comm); + MPI_Send(tmp_count, iodesc->maxregions*fndims, MPI_OFFSET, 0, + 2 * ios->num_iotasks + ios->io_rank, ios->io_comm); + MPI_Send(tmp_start, iodesc->maxregions*fndims, MPI_OFFSET, 0, + 3 * ios->num_iotasks + ios->io_rank, ios->io_comm); + MPI_Recv(IOBUF, iodesc->llen, iodesc->basetype, 0, + 4 * ios->num_iotasks+ios->io_rank, ios->io_comm, &status); } - }else if(ios->io_rank==0){ + } + else if (ios->io_rank == 0) + { int maxregions=0; size_t loffset, regionsize; size_t this_start[fndims*iodesc->maxregions]; size_t this_count[fndims*iodesc->maxregions]; // for( i=ios->num_iotasks-1; i>=0; i--){ - for(int rtask=1;rtask<=ios->num_iotasks;rtask++){ - if(rtasknum_iotasks){ + for (int rtask = 1; rtask <= ios->num_iotasks; rtask++) + { + if (rtasknum_iotasks) + { MPI_Recv(&tmp_bufsize, 1, MPI_OFFSET, rtask, rtask, ios->io_comm, &status); - if(tmp_bufsize>0){ - MPI_Recv(&maxregions, 1, MPI_INT, rtask, ios->num_iotasks+rtask, ios->io_comm, &status); - MPI_Recv(this_count, maxregions*fndims, MPI_OFFSET, rtask, 2*ios->num_iotasks+rtask, ios->io_comm, &status); - MPI_Recv(this_start, maxregions*fndims, MPI_OFFSET, rtask, 3*ios->num_iotasks+rtask, ios->io_comm, &status); + if (tmp_bufsize>0) + { + MPI_Recv(&maxregions, 1, MPI_INT, rtask, ios->num_iotasks+rtask, + ios->io_comm, &status); + MPI_Recv(this_count, maxregions*fndims, MPI_OFFSET, rtask, + 2 * ios->num_iotasks + rtask, ios->io_comm, &status); + MPI_Recv(this_start, maxregions*fndims, MPI_OFFSET, rtask, + 3 * ios->num_iotasks + rtask, ios->io_comm, &status); + } } - }else{ + else + { maxregions=iodesc->maxregions; tmp_bufsize=iodesc->llen; } loffset = 0; - for(regioncnt=0;regioncntnum_iotasks){ - for(int m=0; mnum_iotasks) + { + for (int m=0; mbasetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8){ + if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + { ierr = nc_get_vara_double (file->fh, vid,start, count, bufptr); - }else if(iodesc->basetype == MPI_INTEGER){ + } + else if (iodesc->basetype == MPI_INTEGER) + { ierr = nc_get_vara_int (file->fh, vid, start, count, bufptr); - }else if(iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4){ + } + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + { ierr = nc_get_vara_float (file->fh, vid, start, count, bufptr); - }else{ - fprintf(stderr,"Type not recognized %d in pioc_write_darray_nc_serial\n",(int) iodesc->basetype); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_write_darray_nc_serial\n", + (int)iodesc->basetype); } - if(ierr != PIO_NOERR){ + if (ierr != PIO_NOERR) + { for(int i=0;inum_iotasks){ - MPI_Send(IOBUF, tmp_bufsize, iodesc->basetype, rtask,4*ios->num_iotasks+rtask, ios->io_comm); - } + if (rtask < ios->num_iotasks) + MPI_Send(IOBUF, tmp_bufsize, iodesc->basetype, rtask, + 4 * ios->num_iotasks + rtask, ios->io_comm); } } } @@ -1528,14 +1808,21 @@ int pio_read_darray_nc_serial(file_desc_t *file, io_desc_t *iodesc, const int vi return ierr; } - -/** @brief Read a field from a file to the IO library. +/** Read a field from a file to the IO library. * @ingroup PIO_read_darray * + * @param ncid identifies the netCDF file + * @param vid + * @param ioid + * @param arraylen + * @param array + * + * @return */ -int PIOc_read_darray(const int ncid, const int vid, const int ioid, const PIO_Offset arraylen, void *array) +int PIOc_read_darray(const int ncid, const int vid, const int ioid, + const PIO_Offset arraylen, void *array) { - iosystem_desc_t *ios; + iosystem_desc_t *ios; /** Pointer to io system information. */ file_desc_t *file; io_desc_t *iodesc; void *iobuf=NULL; @@ -1545,35 +1832,46 @@ int PIOc_read_darray(const int ncid, const int vid, const int ioid, const PIO_Of file = pio_get_file_from_id(ncid); - if(file == NULL){ + if (file == NULL) + { fprintf(stderr,"File handle not found %d %d\n",ncid,__LINE__); return PIO_EBADID; } iodesc = pio_get_iodesc_from_id(ioid); - if(iodesc == NULL){ + if (iodesc == NULL) + { fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); return PIO_EBADID; } ios = file->iosystem; - if(ios->iomaster){ + if (ios->iomaster) + { rlen = iodesc->maxiobuflen; - }else{ + } + else + { rlen = iodesc->llen; } - if(iodesc->rearranger > 0){ - if(ios->ioproc && rlen>0){ + if (iodesc->rearranger > 0) + { + if (ios->ioproc && rlen>0) + { MPI_Type_size(iodesc->basetype, &tsize); iobuf = bget(((size_t) tsize)*rlen); - if(iobuf==NULL){ + if (iobuf==NULL) + { piomemerror(*ios,rlen*((size_t) tsize), __FILE__,__LINE__); } } - }else{ + } + else + { iobuf = array; } - switch(file->iotype){ + switch(file->iotype) + { case PIO_IOTYPE_NETCDF: case PIO_IOTYPE_NETCDF4C: ierr = pio_read_darray_nc_serial(file, iodesc, vid, iobuf); @@ -1585,7 +1883,8 @@ int PIOc_read_darray(const int ncid, const int vid, const int ioid, const PIO_Of default: ierr = iotype_error(file->iotype,__FILE__,__LINE__); } - if(iodesc->rearranger > 0){ + if (iodesc->rearranger > 0) + { ierr = rearrange_io2comp(*ios, iodesc, iobuf, array); if(rlen>0) @@ -1596,6 +1895,14 @@ int PIOc_read_darray(const int ncid, const int vid, const int ioid, const PIO_Of } +/** Flush the output buffer. + * + * @param file + * @param force + * @param addsize + * + * @return + */ int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) { var_desc_t *vdesc; @@ -1611,17 +1918,20 @@ int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) ierr = ncmpi_inq_buffer_usage(file->fh, &usage); - if(!force && file->iosystem->io_comm != MPI_COMM_NULL){ + if (!force && file->iosystem->io_comm != MPI_COMM_NULL) + { usage += addsize; MPI_Allreduce(MPI_IN_PLACE, &usage, 1, MPI_OFFSET, MPI_MAX, file->iosystem->io_comm); } - if(usage > maxusage){ + if (usage > maxusage) + { maxusage = usage; } - if(force || usage>=PIO_BUFFER_SIZE_LIMIT){ + if (force || usage>=PIO_BUFFER_SIZE_LIMIT) + { int rcnt; bool prev_dist=false; int prev_record=-1; @@ -1631,28 +1941,32 @@ int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) maxreq = 0; reqcnt=0; rcnt=0; - for(int i=0; ivarlist+i; reqcnt+=vdesc->nreqs; - if(vdesc->nreqs>0) maxreq = i; + if (vdesc->nreqs > 0) + maxreq = i; } int request[reqcnt]; int status[reqcnt]; - for(int i=0; i<=maxreq; i++){ + for (int i = 0; i <= maxreq; i++) + { vdesc = file->varlist+i; #ifdef MPIO_ONESIDED /*onesided optimization requires that all of the requests in a wait_all call represent a contiguous block of data in the file */ - if(rcnt>0 && (prev_record != vdesc->record || - vdesc->nreqs==0)){ + if (rcnt>0 && (prev_record != vdesc->record || vdesc->nreqs==0)) + { ierr = ncmpi_wait_all(file->fh, rcnt, request,status); rcnt=0; } prev_record = vdesc->record; #endif // printf("%s %d %d %d %d \n",__FILE__,__LINE__,i,vdesc->nreqs,vdesc->request); - for(reqcnt=0;reqcntnreqs;reqcnt++){ + for (reqcnt=0;reqcntnreqs;reqcnt++) + { request[rcnt++] = max(vdesc->request[reqcnt],NC_REQ_NULL); } free(vdesc->request); @@ -1667,7 +1981,8 @@ int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) // if(file->iosystem->io_rank==0){ // printf("%s %d %d\n",__FILE__,__LINE__,rcnt); // } - if(rcnt>0){ + if (rcnt > 0) + { /* if(file->iosystem->io_rank==0){ printf("%s %d %d ",__FILE__,__LINE__,rcnt); @@ -1678,13 +1993,16 @@ int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) }*/ ierr = ncmpi_wait_all(file->fh, rcnt, request,status); } - for(int i=0; ivarlist+i; - if(vdesc->iobuf != NULL){ + if (vdesc->iobuf) + { brel(vdesc->iobuf); vdesc->iobuf=NULL; } - if(vdesc->fillbuf != NULL){ + if (vdesc->fillbuf) + { brel(vdesc->fillbuf); vdesc->fillbuf=NULL; } @@ -1699,40 +2017,65 @@ int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) return ierr; } +/** Print out info about the buffer for debug purposes. + * + * @param ios the IO system structure + * @param collective true if collective report is desired + */ void cn_buffer_report(iosystem_desc_t ios, bool collective) { - if(CN_bpool != NULL){ + if (CN_bpool) + { long bget_stats[5]; long bget_mins[5]; long bget_maxs[5]; bstats(bget_stats, bget_stats+1,bget_stats+2,bget_stats+3,bget_stats+4); - if(collective){ + if (collective) + { MPI_Reduce(bget_stats, bget_maxs, 5, MPI_LONG, MPI_MAX, 0, ios.comp_comm); MPI_Reduce(bget_stats, bget_mins, 5, MPI_LONG, MPI_MIN, 0, ios.comp_comm); - if(ios.compmaster){ - printf("PIO: Currently allocated buffer space %ld %ld\n",bget_mins[0],bget_maxs[0]); - printf("PIO: Currently available buffer space %ld %ld\n",bget_mins[1],bget_maxs[1]); - printf("PIO: Current largest free block %ld %ld\n",bget_mins[2],bget_maxs[2]); - printf("PIO: Number of successful bget calls %ld %ld\n",bget_mins[3],bget_maxs[3]); - printf("PIO: Number of successful brel calls %ld %ld\n",bget_mins[4],bget_maxs[4]); + if (ios.compmaster) + { + printf("PIO: Currently allocated buffer space %ld %ld\n", + bget_mins[0], bget_maxs[0]); + printf("PIO: Currently available buffer space %ld %ld\n", + bget_mins[1], bget_maxs[1]); + printf("PIO: Current largest free block %ld %ld\n", + bget_mins[2], bget_maxs[2]); + printf("PIO: Number of successful bget calls %ld %ld\n", + bget_mins[3], bget_maxs[3]); + printf("PIO: Number of successful brel calls %ld %ld\n", + bget_mins[4], bget_maxs[4]); // print_trace(stdout); } - }else{ - printf("%d: PIO: Currently allocated buffer space %ld \n",ios.union_rank,bget_stats[0]) ; - printf("%d: PIO: Currently available buffer space %ld \n",ios.union_rank,bget_stats[1]); - printf("%d: PIO: Current largest free block %ld \n",ios.union_rank,bget_stats[2]); - printf("%d: PIO: Number of successful bget calls %ld \n",ios.union_rank,bget_stats[3]); - printf("%d: PIO: Number of successful brel calls %ld \n",ios.union_rank,bget_stats[4]); + } + else + { + printf("%d: PIO: Currently allocated buffer space %ld \n", + ios.union_rank, bget_stats[0]) ; + printf("%d: PIO: Currently available buffer space %ld \n", + ios.union_rank, bget_stats[1]); + printf("%d: PIO: Current largest free block %ld \n", + ios.union_rank, bget_stats[2]); + printf("%d: PIO: Number of successful bget calls %ld \n", + ios.union_rank, bget_stats[3]); + printf("%d: PIO: Number of successful brel calls %ld \n", + ios.union_rank, bget_stats[4]); } } } +/** Free the buffer pool. + * + * @param ios + */ void free_cn_buffer_pool(iosystem_desc_t ios) { #ifndef PIO_USE_MALLOC - if(CN_bpool != NULL){ + if (CN_bpool) + { cn_buffer_report(ios, true); bpoolrelease(CN_bpool); // free(CN_bpool); @@ -1741,24 +2084,38 @@ void free_cn_buffer_pool(iosystem_desc_t ios) #endif } +/** Flush the buffer. + * + * @param ncid + * @param wmb + * @param flushtodisk + */ void flush_buffer(int ncid, wmulti_buffer *wmb, bool flushtodisk) { - if(wmb->validvars>0){ - PIOc_write_darray_multi(ncid, wmb->vid, wmb->ioid, wmb->validvars, wmb->arraylen, wmb->data, wmb->frame, wmb->fillvalue, flushtodisk); + if (wmb->validvars > 0) + { + PIOc_write_darray_multi(ncid, wmb->vid, wmb->ioid, wmb->validvars, + wmb->arraylen, wmb->data, wmb->frame, + wmb->fillvalue, flushtodisk); wmb->validvars=0; brel(wmb->vid); wmb->vid=NULL; brel(wmb->data); wmb->data=NULL; - if(wmb->fillvalue != NULL) + if (wmb->fillvalue) brel(wmb->fillvalue); - if(wmb->frame != NULL) + if (wmb->frame) brel(wmb->frame); wmb->fillvalue=NULL; wmb->frame=NULL; } } +/** Comput the maximum aggregate number of bytes. + * + * @param ios + * @param iodesc + */ void compute_maxaggregate_bytes(const iosystem_desc_t ios, io_desc_t *iodesc) { int maxbytesoniotask=INT_MAX; @@ -1767,12 +2124,12 @@ void compute_maxaggregate_bytes(const iosystem_desc_t ios, io_desc_t *iodesc) // printf("%s %d %d %d\n",__FILE__,__LINE__,iodesc->maxiobuflen, iodesc->ndof); - if(ios.ioproc && iodesc->maxiobuflen>0){ + if (ios.ioproc && iodesc->maxiobuflen > 0) maxbytesoniotask = PIO_BUFFER_SIZE_LIMIT/ iodesc->maxiobuflen; - } - if(ios.comp_rank>=0 && iodesc->ndof>0){ + + if (ios.comp_rank >= 0 && iodesc->ndof > 0) maxbytesoncomputetask = PIO_CNBUFFER_LIMIT/iodesc->ndof; - } + maxbytes = min(maxbytesoniotask,maxbytesoncomputetask); // printf("%s %d %d %d\n",__FILE__,__LINE__,maxbytesoniotask, maxbytesoncomputetask); diff --git a/externals/pio2/src/clib/pio_darray_async.c b/externals/pio2/src/clib/pio_darray_async.c new file mode 100644 index 000000000000..d9e41a8340ea --- /dev/null +++ b/externals/pio2/src/clib/pio_darray_async.c @@ -0,0 +1,2164 @@ +/** @file + * + * This file contains the routines that read and write + * distributed arrays in PIO. + * + * When arrays are distributed, each processor holds some of the + * array. Only by combining the distributed arrays from all processor + * can the full array be obtained. + * + * @author Jim Edwards, Ed Hartnett + */ + +#include +#include +#include + +/* 10MB default limit. */ +PIO_Offset PIO_BUFFER_SIZE_LIMIT = 10485760; + +/* Initial size of compute buffer. */ +bufsize PIO_CNBUFFER_LIMIT = 33554432; + +/* Global buffer pool pointer. */ +static void *CN_bpool = NULL; + +/* Maximum buffer usage. */ +static PIO_Offset maxusage = 0; + +/** Set the pio buffer size limit. This is the size of the data buffer + * on the IO nodes. + * + * The pio_buffer_size_limit will only apply to files opened after + * the setting is changed. + * + * @param limit the size of the buffer on the IO nodes + * + * @return The previous limit setting. + */ +PIO_Offset PIOc_set_buffer_size_limit(const PIO_Offset limit) +{ + PIO_Offset oldsize; + oldsize = PIO_BUFFER_SIZE_LIMIT; + if (limit > 0) + PIO_BUFFER_SIZE_LIMIT = limit; + return oldsize; +} + +/** Initialize the compute buffer to size PIO_CNBUFFER_LIMIT. + * + * This routine initializes the compute buffer pool if the bget memory + * management is used. If malloc is used (that is, PIO_USE_MALLOC is + * non zero), this function does nothing. + * + * @param ios the iosystem descriptor which will use the new buffer + */ +void compute_buffer_init(iosystem_desc_t ios) +{ +#if !PIO_USE_MALLOC + + if (!CN_bpool) + { + if (!(CN_bpool = malloc(PIO_CNBUFFER_LIMIT))) + { + char errmsg[180]; + sprintf(errmsg,"Unable to allocate a buffer pool of size %d on task %d:" + " try reducing PIO_CNBUFFER_LIMIT\n", PIO_CNBUFFER_LIMIT, ios.comp_rank); + piodie(errmsg, __FILE__, __LINE__); + } + + bpool(CN_bpool, PIO_CNBUFFER_LIMIT); + if (!CN_bpool) + { + char errmsg[180]; + sprintf(errmsg,"Unable to allocate a buffer pool of size %d on task %d:" + " try reducing PIO_CNBUFFER_LIMIT\n", PIO_CNBUFFER_LIMIT, ios.comp_rank); + piodie(errmsg, __FILE__, __LINE__); + } + + bectl(NULL, malloc, free, PIO_CNBUFFER_LIMIT); + } +#endif +} + +/** Write a single distributed field to output. This routine is only + * used if aggregation is off. + * + * @param file a pointer to the open file descriptor for the file + * that will be written to + * @param iodesc a pointer to the defined iodescriptor for the buffer + * @param vid the variable id to be written + * @param IOBUF the buffer to be written from this mpi task + * @param fillvalue the optional fillvalue to be used for missing + * data in this buffer + * + * @return 0 for success, error code otherwise. + * @ingroup PIO_write_darray + */ +int pio_write_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, + void *IOBUF, void *fillvalue) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + var_desc_t *vdesc; + int ndims; /* Number of dimensions according to iodesc. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int i; /* Loop counter. */ + int mpierr = MPI_SUCCESS; /* Return code from MPI function codes. */ + int dsize; /* Size of the type. */ + MPI_Status status; /* Status from MPI_Recv calls. */ + PIO_Offset usage; /* Size of current buffer. */ + int fndims; /* Number of dims for variable according to netCDF. */ + PIO_Offset tdsize = 0; /* Total size. */ + + LOG((1, "pio_write_array_nc vid = %d", vid)); + +#ifdef TIMING + /* Start timing this function. */ + GPTLstart("PIO:write_darray_nc"); +#endif + + /* Get the IO system info. */ + if (!(ios = file->iosystem)) + return PIO_EBADID; + + /* Get pointer to variable information. */ + if (!(vdesc = file->varlist + vid)) + return PIO_EBADID; + + ndims = iodesc->ndims; + + /* Get the number of dims for this var from netcdf. */ + ierr = PIOc_inq_varndims(file->fh, vid, &fndims); + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = 0; + + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + } + } + + /* If this is an IO task, write the data. */ + if (ios->ioproc) + { + io_region *region; + int regioncnt; + int rrcnt; + void *bufptr; + void *tmp_buf = NULL; + int tsize; /* Type size. */ + size_t start[fndims]; /* Local start array for this task. */ + size_t count[fndims]; /* Local count array for this task. */ + int buflen; + int j; /* Loop counter. */ + + PIO_Offset *startlist[iodesc->maxregions]; + PIO_Offset *countlist[iodesc->maxregions]; + + /* Get the type size (again?) */ + MPI_Type_size(iodesc->basetype, &tsize); + + region = iodesc->firstregion; + + /* If this is a var with an unlimited dimension, and the + * iodesc ndims doesn't contain it, then add it to ndims. */ + if (vdesc->record >= 0 && ndims < fndims) + ndims++; + +#ifdef _PNETCDF + /* Make sure we have room in the buffer. */ + if (file->iotype == PIO_IOTYPE_PNETCDF) + flush_output_buffer(file, false, tsize * (iodesc->maxiobuflen)); +#endif + + rrcnt = 0; + /* For each region, figure out start/count arrays. */ + for (regioncnt = 0; regioncnt < iodesc->maxregions; regioncnt++) + { + /* Init arrays to zeros. */ + for (i = 0; i < ndims; i++) + { + start[i] = 0; + count[i] = 0; + } + + if (region) + { + bufptr = (void *)((char *)IOBUF + tsize * region->loffset); + if (vdesc->record >= 0) + { + /* This is a record based multidimensional array. */ + + /* This does not look correct, but will work if + * unlimited dim is dim 0. */ + start[0] = vdesc->record; + + /* Set the local start and count arrays. */ + for (i = 1; i < ndims; i++) + { + start[i] = region->start[i - 1]; + count[i] = region->count[i - 1]; + } + + /* If there is data to be written, write one timestep. */ + if (count[1] > 0) + count[0] = 1; + } + else + { + /* Array without unlimited dimension. */ + for (i = 0; i < ndims; i++) + { + start[i] = region->start[i]; + count[i] = region->count[i]; + } + } + } + + switch(file->iotype) + { +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + + /* Use collective writes with this variable. */ + ierr = nc_var_par_access(file->fh, vid, NC_COLLECTIVE); + + /* Write the data. */ + if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + ierr = nc_put_vara_double(file->fh, vid, (size_t *)start, (size_t *)count, + (const double *)bufptr); + else if (iodesc->basetype == MPI_INTEGER) + ierr = nc_put_vara_int(file->fh, vid, (size_t *)start, (size_t *)count, + (const int *)bufptr); + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + ierr = nc_put_vara_float(file->fh, vid, (size_t *)start, (size_t *)count, + (const float *)bufptr); + else + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n", + (int)iodesc->basetype); + break; + case PIO_IOTYPE_NETCDF4C: +#endif /* _NETCDF4 */ + case PIO_IOTYPE_NETCDF: + { + /* Find the type size (again?) */ + mpierr = MPI_Type_size(iodesc->basetype, &dsize); + + size_t tstart[ndims], tcount[ndims]; + + /* The IO master task does all the data writes, but + * sends the data to the other IO tasks (why?). */ + if (ios->io_rank == 0) + { + for (i = 0; i < iodesc->num_aiotasks; i++) + { + if (i == 0) + { + buflen = 1; + for (j = 0; j < ndims; j++) + { + tstart[j] = start[j]; + tcount[j] = count[j]; + buflen *= tcount[j]; + tmp_buf = bufptr; + } + } + else + { + /* Handshake - tell the sending task I'm ready. */ + mpierr = MPI_Send(&ierr, 1, MPI_INT, i, 0, ios->io_comm); + mpierr = MPI_Recv(&buflen, 1, MPI_INT, i, 1, ios->io_comm, &status); + if (buflen > 0) + { + mpierr = MPI_Recv(tstart, ndims, MPI_OFFSET, i, ios->num_iotasks+i, + ios->io_comm, &status); + mpierr = MPI_Recv(tcount, ndims, MPI_OFFSET, i, 2 * ios->num_iotasks + i, + ios->io_comm, &status); + tmp_buf = malloc(buflen * dsize); + mpierr = MPI_Recv(tmp_buf, buflen, iodesc->basetype, i, i, ios->io_comm, &status); + } + } + + if (buflen > 0) + { + /* Write the data. */ + if (iodesc->basetype == MPI_INTEGER) + ierr = nc_put_vara_int(file->fh, vid, tstart, tcount, (const int *)tmp_buf); + else if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + ierr = nc_put_vara_double(file->fh, vid, tstart, tcount, (const double *)tmp_buf); + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + ierr = nc_put_vara_float(file->fh, vid, tstart, tcount, (const float *)tmp_buf); + else + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n", + (int)iodesc->basetype); + + /* Was there an error from netCDF? */ + if (ierr == PIO_EEDGE) + for (i = 0; i < ndims; i++) + fprintf(stderr,"dim %d start %ld count %ld\n", i, tstart[i], tcount[i]); + + /* Free the temporary buffer, if we don't need it any more. */ + if (tmp_buf != bufptr) + free(tmp_buf); + } + } + } + else if (ios->io_rank < iodesc->num_aiotasks) + { + buflen = 1; + for (i = 0; i < ndims; i++) + { + tstart[i] = (size_t) start[i]; + tcount[i] = (size_t) count[i]; + buflen *= tcount[i]; + // printf("%s %d %d %d %d\n",__FILE__,__LINE__,i,tstart[i],tcount[i]); + } + /* printf("%s %d %d %d %d %d %d %d %d %d\n",__FILE__,__LINE__,ios->io_rank,tstart[0], + tstart[1],tcount[0],tcount[1],buflen,ndims,fndims);*/ + mpierr = MPI_Recv(&ierr, 1, MPI_INT, 0, 0, ios->io_comm, &status); // task0 is ready to recieve + mpierr = MPI_Rsend(&buflen, 1, MPI_INT, 0, 1, ios->io_comm); + if (buflen > 0) + { + mpierr = MPI_Rsend(tstart, ndims, MPI_OFFSET, 0, ios->num_iotasks+ios->io_rank, + ios->io_comm); + mpierr = MPI_Rsend(tcount, ndims, MPI_OFFSET, 0,2*ios->num_iotasks+ios->io_rank, + ios->io_comm); + mpierr = MPI_Rsend(bufptr, buflen, iodesc->basetype, 0, ios->io_rank, ios->io_comm); + } + } + break; + } + break; +#endif /* _NETCDF */ +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + for (i = 0, dsize = 1; i < ndims; i++) + dsize *= count[i]; + + tdsize += dsize; + // if (dsize==1 && ndims==2) + // printf("%s %d %d\n",__FILE__,__LINE__,iodesc->basetype); + + if (dsize > 0) + { + // printf("%s %d %d %d\n",__FILE__,__LINE__,ios->io_rank,dsize); + startlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); + countlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); + for (i = 0; i < fndims; i++) + { + startlist[rrcnt][i] = start[i]; + countlist[rrcnt][i] = count[i]; + } + rrcnt++; + } + if (regioncnt == iodesc->maxregions - 1) + { + // printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,ios->io_rank,iodesc->llen, tdsize); + // ierr = ncmpi_put_varn_all(file->fh, vid, iodesc->maxregions, startlist, countlist, + // IOBUF, iodesc->llen, iodesc->basetype); + int reqn = 0; + + if (vdesc->nreqs % PIO_REQUEST_ALLOC_CHUNK == 0 ) + { + vdesc->request = realloc(vdesc->request, + sizeof(int) * (vdesc->nreqs + PIO_REQUEST_ALLOC_CHUNK)); + + for (int i = vdesc->nreqs; i < vdesc->nreqs + PIO_REQUEST_ALLOC_CHUNK; i++) + vdesc->request[i] = NC_REQ_NULL; + reqn = vdesc->nreqs; + } + else + while(vdesc->request[reqn] != NC_REQ_NULL) + reqn++; + + ierr = ncmpi_bput_varn(file->fh, vid, rrcnt, startlist, countlist, + IOBUF, iodesc->llen, iodesc->basetype, vdesc->request+reqn); + if (vdesc->request[reqn] == NC_REQ_NULL) + vdesc->request[reqn] = PIO_REQ_NULL; //keeps wait calls in sync + vdesc->nreqs = reqn; + + // printf("%s %d %X %d\n",__FILE__,__LINE__,IOBUF,request); + for (i=0;iiotype,__FILE__,__LINE__); + } + + /* Move to the next region. */ + if (region) + region = region->next; + } // for (regioncnt=0;regioncntmaxregions;regioncnt++){ + } // if (ios->ioproc) + + /* Check the error code returned by netCDF. */ + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + +#ifdef TIMING + /* Stop timing this function. */ + GPTLstop("PIO:write_darray_nc"); +#endif + + return ierr; +} + +/** Write a set of one or more aggregated arrays to output file. + * + * This routine is used if aggregation is enabled, data is already on + * the io-tasks + * + * @param file a pointer to the open file descriptor for the file + * that will be written to + * @param nvars the number of variables to be written with this + * decomposition + * @param vid: an array of the variable ids to be written + * @param iodesc_ndims: the number of dimensions explicitly in the + * iodesc + * @param basetype the basic type of the minimal data unit + * @param gsize array of the global dimensions of the field to + * be written + * @param maxregions max number of blocks to be written from + * this iotask + * @param firstregion pointer to the first element of a linked + * list of region descriptions. + * @param llen length of the iobuffer on this task for a single + * field + * @param maxiobuflen maximum llen participating + * @param num_aiotasks actual number of iotasks participating + * @param IOBUF the buffer to be written from this mpi task + * @param frame the frame or record dimension for each of the nvars + * variables in IOBUF + * + * @return 0 for success, error code otherwise. + * @ingroup PIO_write_darray + */ +int pio_write_darray_multi_nc(file_desc_t *file, const int nvars, const int *vid, + const int iodesc_ndims, MPI_Datatype basetype, const PIO_Offset *gsize, + const int maxregions, io_region *firstregion, const PIO_Offset llen, + const int maxiobuflen, const int num_aiotasks, + void *IOBUF, const int *frame) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + var_desc_t *vdesc; + int ierr; + int i; + int mpierr = MPI_SUCCESS; /* Return code from MPI function codes. */ + int dsize; + MPI_Status status; + PIO_Offset usage; + int fndims; + PIO_Offset tdsize; + int tsize; + int ncid; + tdsize=0; + ierr = PIO_NOERR; + +#ifdef TIMING + /* Start timing this function. */ + GPTLstart("PIO:write_darray_multi_nc"); +#endif + + ios = file->iosystem; + if (ios == NULL) + { + fprintf(stderr,"Failed to find iosystem handle \n"); + return PIO_EBADID; + } + vdesc = (file->varlist)+vid[0]; + ncid = file->fh; + + if (vdesc == NULL) + { + fprintf(stderr,"Failed to find variable handle %d\n",vid[0]); + return PIO_EBADID; + } + + /* If async is in use, send message to IO master task. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = 0; + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + } + + ierr = PIOc_inq_varndims(file->fh, vid[0], &fndims); + MPI_Type_size(basetype, &tsize); + + if (ios->ioproc) + { + io_region *region; + int regioncnt; + int rrcnt; + void *bufptr; + int buflen, j; + size_t start[fndims]; + size_t count[fndims]; + int ndims = iodesc_ndims; + + PIO_Offset *startlist[maxregions]; + PIO_Offset *countlist[maxregions]; + + ncid = file->fh; + region = firstregion; + + rrcnt = 0; + for (regioncnt = 0; regioncnt < maxregions; regioncnt++) + { + // printf("%s %d %d %d %d %d %d\n",__FILE__,__LINE__,region->start[0],region->count[0],ndims,fndims,vdesc->record); + for (i = 0; i < fndims; i++) + { + start[i] = 0; + count[i] = 0; + } + if (region) + { + // this is a record based multidimensional array + if (vdesc->record >= 0) + { + for (i = fndims - ndims; i < fndims; i++) + { + start[i] = region->start[i-(fndims-ndims)]; + count[i] = region->count[i-(fndims-ndims)]; + } + + if (fndims>1 && ndims0) + { + count[0] = 1; + start[0] = frame[0]; + } + else if (fndims==ndims) + { + start[0] += vdesc->record; + } + // Non-time dependent array + } + else + { + for (i = 0; i < ndims; i++) + { + start[i] = region->start[i]; + count[i] = region->count[i]; + } + } + } + + switch(file->iotype) + { +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + for (int nv = 0; nv < nvars; nv++) + { + if (vdesc->record >= 0 && ndims < fndims) + { + start[0] = frame[nv]; + } + if (region) + { + bufptr = (void *)((char *) IOBUF + tsize*(nv*llen + region->loffset)); + } + ierr = nc_var_par_access(ncid, vid[nv], NC_COLLECTIVE); + + if (basetype == MPI_DOUBLE ||basetype == MPI_REAL8) + { + ierr = nc_put_vara_double (ncid, vid[nv],(size_t *) start,(size_t *) count, + (const double *)bufptr); + } + else if (basetype == MPI_INTEGER) + { + ierr = nc_put_vara_int (ncid, vid[nv], (size_t *) start, (size_t *) count, + (const int *)bufptr); + } + else if (basetype == MPI_FLOAT || basetype == MPI_REAL4) + { + ierr = nc_put_vara_float (ncid, vid[nv], (size_t *) start, (size_t *) count, + (const float *)bufptr); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n", + (int)basetype); + } + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + for (i = 0, dsize = 1; i < fndims; i++) + { + dsize *= count[i]; + } + tdsize += dsize; + + if (dsize>0) + { + // printf("%s %d %d %d\n",__FILE__,__LINE__,ios->io_rank,dsize); + startlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); + countlist[rrcnt] = (PIO_Offset *) calloc(fndims, sizeof(PIO_Offset)); + for (i = 0; i < fndims; i++) + { + startlist[rrcnt][i]=start[i]; + countlist[rrcnt][i]=count[i]; + } + rrcnt++; + } + if (regioncnt==maxregions-1) + { + //printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,ios->io_rank,iodesc->llen, tdsize); + // ierr = ncmpi_put_varn_all(ncid, vid, iodesc->maxregions, startlist, countlist, + // IOBUF, iodesc->llen, iodesc->basetype); + + //printf("%s %d %ld \n",__FILE__,__LINE__,IOBUF); + for (int nv=0; nvvarlist)+vid[nv]; + if (vdesc->record >= 0 && ndimsnreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ) + { + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + + for (int i=vdesc->nreqs;inreqs+PIO_REQUEST_ALLOC_CHUNK;i++) + { + vdesc->request[i]=NC_REQ_NULL; + } + reqn = vdesc->nreqs; + } + else + { + while(vdesc->request[reqn] != NC_REQ_NULL) + { + reqn++; + } + } + ierr = ncmpi_iput_varn(ncid, vid[nv], rrcnt, startlist, countlist, + bufptr, llen, basetype, vdesc->request+reqn); + /* + ierr = ncmpi_bput_varn(ncid, vid[nv], rrcnt, startlist, countlist, + bufptr, llen, basetype, &(vdesc->request)); + */ + if (vdesc->request[reqn] == NC_REQ_NULL) + { + vdesc->request[reqn] = PIO_REQ_NULL; //keeps wait calls in sync + } + vdesc->nreqs += reqn+1; + + // printf("%s %d %d %d\n",__FILE__,__LINE__,vdesc->nreqs,vdesc->request[reqn]); + } + for (i=0;iiotype,__FILE__,__LINE__); + } + if (region) + region = region->next; + } // for (regioncnt=0;regioncntmaxregions;regioncnt++){ + } // if (ios->ioproc) + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + +#ifdef TIMING + /* Stop timing this function. */ + GPTLstop("PIO:write_darray_multi_nc"); +#endif + + return ierr; +} + +/** Write a set of one or more aggregated arrays to output file in + * serial mode. + * + * This routine is used if aggregation is enabled, data is already on the + * io-tasks + * + * @param file: a pointer to the open file descriptor for the file + * that will be written to + * @param nvars: the number of variables to be written with this + * decomposition + * @param vid: an array of the variable ids to be written + * @param iodesc_ndims: the number of dimensions explicitly in the + * iodesc + * @param basetype : the basic type of the minimal data unit + * @param gsize : array of the global dimensions of the field to be + * written + * @param maxregions : max number of blocks to be written from this + * iotask + * @param firstregion : pointer to the first element of a linked + * list of region descriptions. + * @param llen : length of the iobuffer on this task for a single + * field + * @param maxiobuflen : maximum llen participating + * @param num_aiotasks : actual number of iotasks participating + * @param IOBUF: the buffer to be written from this mpi task + * @param frame : the frame or record dimension for each of the + * nvars variables in IOBUF + * + * @return 0 for success, error code otherwise. + * @ingroup PIO_write_darray + */ +int pio_write_darray_multi_nc_serial(file_desc_t *file, const int nvars, const int *vid, + const int iodesc_ndims, MPI_Datatype basetype, const PIO_Offset *gsize, + const int maxregions, io_region *firstregion, const PIO_Offset llen, + const int maxiobuflen, const int num_aiotasks, + void *IOBUF, const int *frame) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + var_desc_t *vdesc; + int ierr; + int i; + int mpierr = MPI_SUCCESS; /* Return code from MPI function codes. */ + int dsize; + MPI_Status status; + PIO_Offset usage; + int fndims; + PIO_Offset tdsize; + int tsize; + int ncid; + tdsize=0; + ierr = PIO_NOERR; +#ifdef TIMING + /* Start timing this function. */ + GPTLstart("PIO:write_darray_multi_nc_serial"); +#endif + + if (!(ios = file->iosystem)) + { + fprintf(stderr,"Failed to find iosystem handle \n"); + return PIO_EBADID; + } + + ncid = file->fh; + + if (!(vdesc = (file->varlist) + vid[0])) + { + fprintf(stderr,"Failed to find variable handle %d\n",vid[0]); + return PIO_EBADID; + } + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (! ios->ioproc) + { + int msg = 0; + + if (ios->comp_rank==0) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + } + + ierr = PIOc_inq_varndims(file->fh, vid[0], &fndims); + MPI_Type_size(basetype, &tsize); + + if (ios->ioproc) + { + io_region *region; + int regioncnt; + int rrcnt; + void *bufptr; + int buflen, j; + size_t tmp_start[fndims*maxregions]; + size_t tmp_count[fndims*maxregions]; + + int ndims = iodesc_ndims; + + ncid = file->fh; + region = firstregion; + + + rrcnt = 0; + for (regioncnt = 0; regioncnt < maxregions; regioncnt++) + { + for (i = 0; i < fndims; i++) + { + tmp_start[i + regioncnt * fndims] = 0; + tmp_count[i + regioncnt * fndims] = 0; + } + if (region) + { + // this is a record based multidimensional array + if (vdesc->record >= 0) + { + for (i = fndims - ndims; i < fndims; i++) + { + tmp_start[i + regioncnt * fndims] = region->start[i - (fndims - ndims)]; + tmp_count[i + regioncnt * fndims] = region->count[i - (fndims - ndims)]; + } + // Non-time dependent array + } + else + { + for (i = 0; i < ndims; i++) + { + tmp_start[i + regioncnt * fndims] = region->start[i]; + tmp_count[i + regioncnt * fndims] = region->count[i]; + } + } + region = region->next; + } + } + if (ios->io_rank > 0) + { + mpierr = MPI_Recv(&ierr, 1, MPI_INT, 0, 0, ios->io_comm, &status); // task0 is ready to recieve + MPI_Send(&llen, 1, MPI_OFFSET, 0, ios->io_rank, ios->io_comm); + if (llen>0) + { + MPI_Send(&maxregions, 1, MPI_INT, 0, ios->io_rank+ios->num_iotasks, ios->io_comm); + MPI_Send(tmp_start, maxregions*fndims, MPI_OFFSET, 0, ios->io_rank+2*ios->num_iotasks, ios->io_comm); + MPI_Send(tmp_count, maxregions*fndims, MPI_OFFSET, 0, ios->io_rank+3*ios->num_iotasks, ios->io_comm); + // printf("%s %d %ld\n",__FILE__,__LINE__,nvars*llen); + MPI_Send(IOBUF, nvars*llen, basetype, 0, ios->io_rank+4*ios->num_iotasks, ios->io_comm); + } + } + else + { + size_t rlen; + int rregions; + size_t start[fndims], count[fndims]; + size_t loffset; + mpierr = MPI_Type_size(basetype, &dsize); + + for (int rtask=0; rtasknum_iotasks; rtask++) + { + if (rtask>0) + { + mpierr = MPI_Send(&ierr, 1, MPI_INT, rtask, 0, ios->io_comm); // handshake - tell the sending task I'm ready + MPI_Recv(&rlen, 1, MPI_OFFSET, rtask, rtask, ios->io_comm, &status); + if (rlen>0){ + MPI_Recv(&rregions, 1, MPI_INT, rtask, rtask+ios->num_iotasks, ios->io_comm, &status); + MPI_Recv(tmp_start, rregions*fndims, MPI_OFFSET, rtask, rtask+2*ios->num_iotasks, ios->io_comm, &status); + MPI_Recv(tmp_count, rregions*fndims, MPI_OFFSET, rtask, rtask+3*ios->num_iotasks, ios->io_comm, &status); + // printf("%s %d %d %ld\n",__FILE__,__LINE__,rtask,nvars*rlen); + MPI_Recv(IOBUF, nvars*rlen, basetype, rtask, rtask+4*ios->num_iotasks, ios->io_comm, &status); + } + } + else + { + rlen = llen; + rregions = maxregions; + } + if (rlen>0) + { + loffset = 0; + for (regioncnt=0;regioncntrecord>=0) + { + if (fndims>1 && ndims0) + { + count[0] = 1; + start[0] = frame[nv]; + } + else if (fndims==ndims) + { + start[0]+=vdesc->record; + } + } + + if (basetype == MPI_INTEGER) + { + ierr = nc_put_vara_int (ncid, vid[nv], start, count, (const int *) bufptr); + } + else if (basetype == MPI_DOUBLE || basetype == MPI_REAL8) + { + ierr = nc_put_vara_double (ncid, vid[nv], start, count, (const double *) bufptr); + } + else if (basetype == MPI_FLOAT || basetype == MPI_REAL4) + { + ierr = nc_put_vara_float (ncid,vid[nv], start, count, (const float *) bufptr); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",(int) basetype); + } + + if (ierr != PIO_NOERR){ + for (i=0;imaxregions;regioncnt++){ + } // if (rlen>0) + } // for (int rtask=0; rtasknum_iotasks; rtask++){ + + } + } // if (ios->ioproc) + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + +#ifdef TIMING + /* Stop timing this function. */ + GPTLstop("PIO:write_darray_multi_nc_serial"); +#endif + + return ierr; +} + +/** Write one or more arrays with the same IO decomposition to the file. + * + * @param ncid identifies the netCDF file + * @param vid: an array of the variable ids to be written + * @param ioid: the I/O description ID as passed back by + * PIOc_InitDecomp(). + * @param nvars the number of variables to be written with this + * decomposition + * @param arraylen: the length of the array to be written. This + * is the length of the distrubited array. That is, the length of + * the portion of the data that is on the processor. + * @param array: pointer to the data to be written. This is a + * pointer to the distributed portion of the array that is on this + * processor. + * @param frame the frame or record dimension for each of the nvars + * variables in IOBUF + * @param fillvalue: pointer to the fill value to be used for + * missing data. + * @param flushtodisk + * + * @return 0 for success, error code otherwise. + * @ingroup PIO_write_darray + */ +int PIOc_write_darray_multi(const int ncid, const int *vid, const int ioid, + const int nvars, const PIO_Offset arraylen, + void *array, const int *frame, void **fillvalue, + bool flushtodisk) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; + io_desc_t *iodesc; + + int vsize, rlen; + int ierr; + var_desc_t *vdesc0; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if (file == NULL) + { + fprintf(stderr,"File handle not found %d %d\n",ncid,__LINE__); + return PIO_EBADID; + } + if (! (file->mode & PIO_WRITE)) + { + fprintf(stderr,"ERROR: Attempt to write to read-only file\n"); + return PIO_EPERM; + } + + iodesc = pio_get_iodesc_from_id(ioid); + if (iodesc == NULL) + { + // print_trace(NULL); + //fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); + return PIO_EBADID; + } + + vdesc0 = file->varlist+vid[0]; + + pioassert(nvars>0,"nvars <= 0",__FILE__,__LINE__); + + ios = file->iosystem; + // rlen = iodesc->llen*nvars; + rlen=0; + if (iodesc->llen>0) + { + rlen = iodesc->maxiobuflen*nvars; + } + if (vdesc0->iobuf) + { + piodie("Attempt to overwrite existing io buffer",__FILE__,__LINE__); + } + if (iodesc->rearranger>0) + { + if (rlen>0) + { + MPI_Type_size(iodesc->basetype, &vsize); + //printf("rlen*vsize = %ld\n",rlen*vsize); + + vdesc0->iobuf = bget((size_t) vsize* (size_t) rlen); + if (vdesc0->iobuf==NULL) + { + printf("%s %d %d %ld\n",__FILE__,__LINE__,nvars,vsize*rlen); + piomemerror(*ios,(size_t) rlen*(size_t) vsize, __FILE__,__LINE__); + } + if (iodesc->needsfill && iodesc->rearranger==PIO_REARR_BOX) + { + if (vsize==4) + { + for (int nv=0;nv < nvars; nv++) + { + for (int i=0;imaxiobuflen;i++) + { + ((float *) vdesc0->iobuf)[i+nv*(iodesc->maxiobuflen)] = ((float *)fillvalue)[nv]; + } + } + } + else if (vsize==8) + { + for (int nv=0;nv < nvars; nv++) + { + for (int i=0;imaxiobuflen;i++) + { + ((double *)vdesc0->iobuf)[i+nv*(iodesc->maxiobuflen)] = ((double *)fillvalue)[nv]; + } + } + } + } + } + + ierr = rearrange_comp2io(*ios, iodesc, array, vdesc0->iobuf, nvars); + }/* this is wrong, need to think about it + else{ + vdesc0->iobuf = array; + } */ + switch(file->iotype) + { + case PIO_IOTYPE_NETCDF4P: + case PIO_IOTYPE_PNETCDF: + ierr = pio_write_darray_multi_nc(file, nvars, vid, + iodesc->ndims, iodesc->basetype, iodesc->gsize, + iodesc->maxregions, iodesc->firstregion, iodesc->llen, + iodesc->maxiobuflen, iodesc->num_aiotasks, + vdesc0->iobuf, frame); + break; + case PIO_IOTYPE_NETCDF4C: + case PIO_IOTYPE_NETCDF: + ierr = pio_write_darray_multi_nc_serial(file, nvars, vid, + iodesc->ndims, iodesc->basetype, iodesc->gsize, + iodesc->maxregions, iodesc->firstregion, iodesc->llen, + iodesc->maxiobuflen, iodesc->num_aiotasks, + vdesc0->iobuf, frame); + if (vdesc0->iobuf) + { + brel(vdesc0->iobuf); + vdesc0->iobuf = NULL; + } + break; + + } + + if (iodesc->rearranger == PIO_REARR_SUBSET && iodesc->needsfill && + iodesc->holegridsize>0) + { + if (vdesc0->fillbuf) + { + piodie("Attempt to overwrite existing buffer",__FILE__,__LINE__); + } + + vdesc0->fillbuf = bget(iodesc->holegridsize*vsize*nvars); + //printf("%s %d %x\n",__FILE__,__LINE__,vdesc0->fillbuf); + if (vsize==4) + { + for (int nv=0;nvholegridsize;i++) + { + ((float *) vdesc0->fillbuf)[i+nv*iodesc->holegridsize] = ((float *) fillvalue)[nv]; + } + } + } + else if (vsize==8) + { + for (int nv=0;nvholegridsize;i++) + { + ((double *) vdesc0->fillbuf)[i+nv*iodesc->holegridsize] = ((double *) fillvalue)[nv]; + } + } + } + switch(file->iotype) + { + case PIO_IOTYPE_PNETCDF: + ierr = pio_write_darray_multi_nc(file, nvars, vid, + iodesc->ndims, iodesc->basetype, iodesc->gsize, + iodesc->maxfillregions, iodesc->fillregion, iodesc->holegridsize, + iodesc->holegridsize, iodesc->num_aiotasks, + vdesc0->fillbuf, frame); + break; + case PIO_IOTYPE_NETCDF4P: + case PIO_IOTYPE_NETCDF4C: + case PIO_IOTYPE_NETCDF: + /* ierr = pio_write_darray_multi_nc_serial(file, nvars, vid, + iodesc->ndims, iodesc->basetype, iodesc->gsize, + iodesc->maxfillregions, iodesc->fillregion, iodesc->holegridsize, + iodesc->holegridsize, iodesc->num_aiotasks, + vdesc0->fillbuf, frame); + */ + /* if (vdesc0->fillbuf != NULL){ + printf("%s %d %x\n",__FILE__,__LINE__,vdesc0->fillbuf); + brel(vdesc0->fillbuf); + vdesc0->fillbuf = NULL; + } + */ + break; + } + } + + flush_output_buffer(file, flushtodisk, 0); + + return ierr; +} + +/** Write a distributed array to the output file. + * + * This routine aggregates output on the compute nodes and only sends + * it to the IO nodes when the compute buffer is full or when a flush + * is triggered. + * + * @param ncid: the ncid of the open netCDF file. + * @param vid: the variable ID returned by PIOc_def_var(). + * @param ioid: the I/O description ID as passed back by + * PIOc_InitDecomp(). + * @param arraylen: the length of the array to be written. This + * is the length of the distrubited array. That is, the length of + * the portion of the data that is on the processor. + * @param array: pointer to the data to be written. This is a + * pointer to the distributed portion of the array that is on this + * processor. + * @param fillvalue: pointer to the fill value to be used for + * missing data. + * + * @returns 0 for success, non-zero error code for failure. + * @ingroup PIO_write_darray + */ +int PIOc_write_darray(const int ncid, const int vid, const int ioid, + const PIO_Offset arraylen, void *array, void *fillvalue) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; + io_desc_t *iodesc; + var_desc_t *vdesc; + void *bufptr; + size_t rlen; + int ierr; + MPI_Datatype vtype; + wmulti_buffer *wmb; + int tsize; + int *tptr; + void *bptr; + void *fptr; + bool recordvar; + int needsflush; + bufsize totfree, maxfree; + + ierr = PIO_NOERR; + needsflush = 0; // false + file = pio_get_file_from_id(ncid); + if (file == NULL) + { + fprintf(stderr,"File handle not found %d %d\n",ncid,__LINE__); + return PIO_EBADID; + } + if (! (file->mode & PIO_WRITE)) + { + fprintf(stderr,"ERROR: Attempt to write to read-only file\n"); + return PIO_EPERM; + } + + iodesc = pio_get_iodesc_from_id(ioid); + if (iodesc == NULL) + { + fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); + return PIO_EBADID; + } + ios = file->iosystem; + + vdesc = (file->varlist)+vid; + if (vdesc == NULL) + return PIO_EBADID; + + /* Is this a record variable? */ + recordvar = vdesc->record < 0 ? true : false; + + if (iodesc->ndof != arraylen) + { + fprintf(stderr,"ndof=%ld, arraylen=%ld\n",iodesc->ndof,arraylen); + piodie("ndof != arraylen",__FILE__,__LINE__); + } + wmb = &(file->buffer); + if (wmb->ioid == -1) + { + if (recordvar) + wmb->ioid = ioid; + else + wmb->ioid = -(ioid); + } + else + { + // separate record and non-record variables + if (recordvar) + { + while(wmb->next && wmb->ioid!=ioid) + if (wmb->next!=NULL) + wmb = wmb->next; +#ifdef _PNETCDF + /* flush the previous record before starting a new one. this is collective */ + // if (vdesc->request != NULL && (vdesc->request[0] != NC_REQ_NULL) || + // (wmb->frame != NULL && vdesc->record != wmb->frame[0])){ + // needsflush = 2; // flush to disk + // } +#endif + } + else + { + while(wmb->next && wmb->ioid!= -(ioid)) + { + if (wmb->next!=NULL) + wmb = wmb->next; + } + } + } + if ((recordvar && wmb->ioid != ioid) || (!recordvar && wmb->ioid != -(ioid))) + { + wmb->next = (wmulti_buffer *) bget((bufsize) sizeof(wmulti_buffer)); + if (wmb->next == NULL) + piomemerror(*ios,sizeof(wmulti_buffer), __FILE__,__LINE__); + wmb=wmb->next; + wmb->next=NULL; + if (recordvar) + wmb->ioid = ioid; + else + wmb->ioid = -(ioid); + wmb->validvars=0; + wmb->arraylen=arraylen; + wmb->vid=NULL; + wmb->data=NULL; + wmb->frame=NULL; + wmb->fillvalue=NULL; + } + + MPI_Type_size(iodesc->basetype, &tsize); + // At this point wmb should be pointing to a new or existing buffer + // so we can add the data + // printf("%s %d %X %d %d %d\n",__FILE__,__LINE__,wmb->data,wmb->validvars,arraylen,tsize); + // cn_buffer_report(*ios, true); + bfreespace(&totfree, &maxfree); + if (needsflush == 0) + needsflush = (maxfree <= 1.1*(1+wmb->validvars)*arraylen*tsize ); + MPI_Allreduce(MPI_IN_PLACE, &needsflush, 1, MPI_INT, MPI_MAX, ios->comp_comm); + + if (needsflush > 0 ) + { + // need to flush first + // printf("%s %d %ld %d %ld %ld\n",__FILE__,__LINE__,maxfree, wmb->validvars, (1+wmb->validvars)*arraylen*tsize,totfree); + cn_buffer_report(*ios, true); + + flush_buffer(ncid, wmb, needsflush == 2); // if needsflush == 2 flush to disk otherwise just flush to io node + } + + if (arraylen > 0) + if (!(wmb->data = bgetr(wmb->data, (1+wmb->validvars)*arraylen*tsize))) + piomemerror(*ios, (1+wmb->validvars)*arraylen*tsize, __FILE__, __LINE__); + + if (!(wmb->vid = (int *) bgetr(wmb->vid,sizeof(int)*(1+wmb->validvars)))) + piomemerror(*ios, (1+wmb->validvars)*sizeof(int), __FILE__, __LINE__); + + if (vdesc->record >= 0) + if (!(wmb->frame = (int *)bgetr(wmb->frame, sizeof(int) * (1 + wmb->validvars)))) + piomemerror(*ios, (1+wmb->validvars)*sizeof(int), __FILE__, __LINE__); + + if (iodesc->needsfill) + if (!(wmb->fillvalue = bgetr(wmb->fillvalue,tsize*(1+wmb->validvars)))) + piomemerror(*ios, (1+wmb->validvars)*tsize , __FILE__,__LINE__); + + if (iodesc->needsfill) + { + if (fillvalue) + { + memcpy((char *) wmb->fillvalue+tsize*wmb->validvars,fillvalue, tsize); + } + else + { + vtype = (MPI_Datatype) iodesc->basetype; + if (vtype == MPI_INTEGER) + { + int fill = PIO_FILL_INT; + memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); + } + else if (vtype == MPI_FLOAT || vtype == MPI_REAL4) + { + float fill = PIO_FILL_FLOAT; + memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); + } + else if (vtype == MPI_DOUBLE || vtype == MPI_REAL8) + { + double fill = PIO_FILL_DOUBLE; + memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); + } + else if (vtype == MPI_CHARACTER) + { + char fill = PIO_FILL_CHAR; + memcpy((char *) wmb->fillvalue+tsize*wmb->validvars, &fill, tsize); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_write_darray\n",vtype); + } + } + + } + + wmb->arraylen = arraylen; + wmb->vid[wmb->validvars]=vid; + bufptr = (void *)((char *) wmb->data + arraylen*tsize*wmb->validvars); + if (arraylen>0) + memcpy(bufptr, array, arraylen*tsize); + /* + if (tsize==8){ + double asum=0.0; + printf("%s %d %d %d %d\n",__FILE__,__LINE__,vid,arraylen,iodesc->ndof); + for (int k=0;kvalidvars,wmb->ioid,vid,bufptr); + + if (wmb->frame!=NULL) + wmb->frame[wmb->validvars]=vdesc->record; + wmb->validvars++; + + // printf("%s %d %d %d %d %d\n",__FILE__,__LINE__,wmb->validvars,iodesc->maxbytes/tsize, iodesc->ndof, iodesc->llen); + if (wmb->validvars >= iodesc->maxbytes/tsize) + PIOc_sync(ncid); + + return ierr; +} + +/** Read an array of data from a file to the (parallel) IO library. + * + * @param file a pointer to the open file descriptor for the file + * that will be written to + * @param iodesc a pointer to the defined iodescriptor for the buffer + * @param vid the variable id to be read + * @param IOBUF the buffer to be read into from this mpi task + * + * @return 0 on success, error code otherwise. + * @ingroup PIO_read_darray + */ +int pio_read_darray_nc(file_desc_t *file, io_desc_t *iodesc, const int vid, + void *IOBUF) +{ + int ierr=PIO_NOERR; + iosystem_desc_t *ios; /* Pointer to io system information. */ + var_desc_t *vdesc; + int ndims, fndims; + MPI_Status status; + int i; + +#ifdef TIMING + /* Start timing this function. */ + GPTLstart("PIO:read_darray_nc"); +#endif + ios = file->iosystem; + if (ios == NULL) + return PIO_EBADID; + + vdesc = (file->varlist)+vid; + + if (vdesc == NULL) + return PIO_EBADID; + + ndims = iodesc->ndims; + ierr = PIOc_inq_varndims(file->fh, vid, &fndims); + + if (fndims==ndims) + vdesc->record=-1; + + if (ios->ioproc) + { + io_region *region; + size_t start[fndims]; + size_t count[fndims]; + size_t tmp_start[fndims]; + size_t tmp_count[fndims]; + size_t tmp_bufsize=1; + int regioncnt; + void *bufptr; + int tsize; + + int rrlen=0; + PIO_Offset *startlist[iodesc->maxregions]; + PIO_Offset *countlist[iodesc->maxregions]; + + // buffer is incremented by byte and loffset is in terms of the iodessc->basetype + // so we need to multiply by the size of the basetype + // We can potentially allow for one iodesc to have multiple datatypes by allowing the + // calling program to change the basetype. + region = iodesc->firstregion; + MPI_Type_size(iodesc->basetype, &tsize); + if (fndims>ndims) + { + ndims++; + if (vdesc->record<0) + vdesc->record=0; + } + for (regioncnt=0;regioncntmaxregions;regioncnt++) + { + // printf("%s %d %d %ld %d %d\n",__FILE__,__LINE__,regioncnt,region,fndims,ndims); + tmp_bufsize=1; + if (region==NULL || iodesc->llen==0) + { + for (i=0;iloffset); + + // printf("%s %d %d %d %d\n",__FILE__,__LINE__,iodesc->llen - region->loffset, iodesc->llen, region->loffset); + + if (vdesc->record >= 0 && fndims>1) + { + start[0] = vdesc->record; + for (i=1;istart[i-1]; + count[i] = region->count[i-1]; + // printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,i,start[i],count[i]); + } + if (count[1] > 0) + count[0] = 1; + } + else + { + // Non-time dependent array + for (i=0;istart[i]; + count[i] = region->count[i]; + // printf("%s %d %d %ld %ld\n",__FILE__,__LINE__,i,start[i],count[i]); + } + } + } + + switch(file->iotype) + { +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + if (iodesc->basetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + { + ierr = nc_get_vara_double (file->fh, vid,start,count, bufptr); + } + else if (iodesc->basetype == MPI_INTEGER) + { + ierr = nc_get_vara_int (file->fh, vid, start, count, bufptr); + } + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + { + ierr = nc_get_vara_float (file->fh, vid, start, count, bufptr); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_read_darray\n",(int) iodesc->basetype); + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + { + tmp_bufsize=1; + for (int j = 0; j < fndims; j++) + tmp_bufsize *= count[j]; + + if (tmp_bufsize > 0) + { + startlist[rrlen] = (PIO_Offset *) bget(fndims * sizeof(PIO_Offset)); + countlist[rrlen] = (PIO_Offset *) bget(fndims * sizeof(PIO_Offset)); + + for (int j = 0; j < fndims; j++) + { + startlist[rrlen][j] = start[j]; + countlist[rrlen][j] = count[j]; + /* printf("%s %d %d %d %d %ld %ld %ld\n",__FILE__,__LINE__,realregioncnt, + iodesc->maxregions, j,start[j],count[j],tmp_bufsize);*/ + } + rrlen++; + } + if (regioncnt==iodesc->maxregions-1) + { + ierr = ncmpi_get_varn_all(file->fh, vid, rrlen, startlist, + countlist, IOBUF, iodesc->llen, iodesc->basetype); + for (i=0;iiotype,__FILE__,__LINE__); + + } + if (region) + region = region->next; + } // for (regioncnt=0;...) + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + +#ifdef TIMING + /* Stop timing this function. */ + GPTLstop("PIO:read_darray_nc"); +#endif + + return ierr; +} + +/** Read an array of data from a file to the (serial) IO library. + * + * @param file a pointer to the open file descriptor for the file + * that will be written to + * @param iodesc a pointer to the defined iodescriptor for the buffer + * @param vid the variable id to be read. + * @param IOBUF the buffer to be read into from this mpi task + * + * @returns + * @ingroup PIO_read_darray + */ +int pio_read_darray_nc_serial(file_desc_t *file, io_desc_t *iodesc, + const int vid, void *IOBUF) +{ + int ierr=PIO_NOERR; + iosystem_desc_t *ios; /* Pointer to io system information. */ + var_desc_t *vdesc; + int ndims, fndims; + MPI_Status status; + int i; + +#ifdef TIMING + /* Start timing this function. */ + GPTLstart("PIO:read_darray_nc_serial"); +#endif + ios = file->iosystem; + if (ios == NULL) + return PIO_EBADID; + + vdesc = (file->varlist)+vid; + + if (vdesc == NULL) + return PIO_EBADID; + + ndims = iodesc->ndims; + ierr = PIOc_inq_varndims(file->fh, vid, &fndims); + + if (fndims==ndims) + vdesc->record=-1; + + if (ios->ioproc) + { + io_region *region; + size_t start[fndims]; + size_t count[fndims]; + size_t tmp_start[fndims * iodesc->maxregions]; + size_t tmp_count[fndims * iodesc->maxregions]; + size_t tmp_bufsize; + int regioncnt; + void *bufptr; + int tsize; + + int rrlen = 0; + + // buffer is incremented by byte and loffset is in terms of the iodessc->basetype + // so we need to multiply by the size of the basetype + // We can potentially allow for one iodesc to have multiple datatypes by allowing the + // calling program to change the basetype. + region = iodesc->firstregion; + MPI_Type_size(iodesc->basetype, &tsize); + if (fndims>ndims) + { + if (vdesc->record < 0) + vdesc->record = 0; + } + for (regioncnt=0;regioncntmaxregions;regioncnt++) + { + if (region==NULL || iodesc->llen==0) + { + for (i = 0; i < fndims; i++) + { + tmp_start[i + regioncnt * fndims] = 0; + tmp_count[i + regioncnt * fndims] = 0; + } + bufptr=NULL; + } + else + { + if (vdesc->record >= 0 && fndims>1) + { + tmp_start[regioncnt*fndims] = vdesc->record; + for (i=1;istart[i-1]; + tmp_count[i+regioncnt*fndims] = region->count[i-1]; + } + if (tmp_count[1 + regioncnt * fndims] > 0) + tmp_count[regioncnt * fndims] = 1; + } + else + { + // Non-time dependent array + for (i = 0; i < fndims; i++) + { + tmp_start[i + regioncnt * fndims] = region->start[i]; + tmp_count[i + regioncnt * fndims] = region->count[i]; + } + } + /* for (i=0;inext; + } // for (regioncnt=0;...) + + if (ios->io_rank>0) + { + MPI_Send(&(iodesc->llen), 1, MPI_OFFSET, 0, ios->io_rank, ios->io_comm); + if (iodesc->llen > 0) + { + MPI_Send(&(iodesc->maxregions), 1, MPI_INT, 0, + ios->num_iotasks + ios->io_rank, ios->io_comm); + MPI_Send(tmp_count, iodesc->maxregions*fndims, MPI_OFFSET, 0, + 2 * ios->num_iotasks + ios->io_rank, ios->io_comm); + MPI_Send(tmp_start, iodesc->maxregions*fndims, MPI_OFFSET, 0, + 3 * ios->num_iotasks + ios->io_rank, ios->io_comm); + MPI_Recv(IOBUF, iodesc->llen, iodesc->basetype, 0, + 4 * ios->num_iotasks+ios->io_rank, ios->io_comm, &status); + } + } + else if (ios->io_rank == 0) + { + int maxregions=0; + size_t loffset, regionsize; + size_t this_start[fndims*iodesc->maxregions]; + size_t this_count[fndims*iodesc->maxregions]; + // for (i=ios->num_iotasks-1; i>=0; i--){ + for (int rtask = 1; rtask <= ios->num_iotasks; rtask++) + { + if (rtasknum_iotasks) + { + MPI_Recv(&tmp_bufsize, 1, MPI_OFFSET, rtask, rtask, ios->io_comm, &status); + if (tmp_bufsize>0) + { + MPI_Recv(&maxregions, 1, MPI_INT, rtask, ios->num_iotasks+rtask, + ios->io_comm, &status); + MPI_Recv(this_count, maxregions*fndims, MPI_OFFSET, rtask, + 2 * ios->num_iotasks + rtask, ios->io_comm, &status); + MPI_Recv(this_start, maxregions*fndims, MPI_OFFSET, rtask, + 3 * ios->num_iotasks + rtask, ios->io_comm, &status); + } + } + else + { + maxregions=iodesc->maxregions; + tmp_bufsize=iodesc->llen; + } + loffset = 0; + for (regioncnt=0;regioncntnum_iotasks) + { + for (int m=0; mbasetype == MPI_DOUBLE || iodesc->basetype == MPI_REAL8) + { + ierr = nc_get_vara_double (file->fh, vid,start, count, bufptr); + } + else if (iodesc->basetype == MPI_INTEGER) + { + ierr = nc_get_vara_int (file->fh, vid, start, count, bufptr); + } + else if (iodesc->basetype == MPI_FLOAT || iodesc->basetype == MPI_REAL4) + { + ierr = nc_get_vara_float (file->fh, vid, start, count, bufptr); + } + else + { + fprintf(stderr,"Type not recognized %d in pioc_write_darray_nc_serial\n", + (int)iodesc->basetype); + } + + if (ierr != PIO_NOERR) + { + for (int i = 0; i < fndims; i++) + fprintf(stderr,"vid %d dim %d start %ld count %ld err %d\n", + vid, i, start[i], count[i], ierr); + + } + +#endif + } + if (rtask < ios->num_iotasks) + MPI_Send(IOBUF, tmp_bufsize, iodesc->basetype, rtask, + 4 * ios->num_iotasks + rtask, ios->io_comm); + } + } + } + + ierr = check_netcdf(file, ierr, __FILE__, __LINE__); + +#ifdef TIMING + /* Stop timing this function. */ + GPTLstop("PIO:read_darray_nc_serial"); +#endif + + return ierr; +} + +/** Read a field from a file to the IO library. + * @ingroup PIO_read_darray + * + * @param ncid identifies the netCDF file + * @param vid the variable ID to be read + * @param ioid: the I/O description ID as passed back by + * PIOc_InitDecomp(). + * @param arraylen: the length of the array to be read. This + * is the length of the distrubited array. That is, the length of + * the portion of the data that is on the processor. + * @param array: pointer to the data to be read. This is a + * pointer to the distributed portion of the array that is on this + * processor. + * + * @return 0 for success, error code otherwise. + * @ingroup PIO_read_darray + */ +int PIOc_read_darray(const int ncid, const int vid, const int ioid, + const PIO_Offset arraylen, void *array) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; + io_desc_t *iodesc; + void *iobuf=NULL; + size_t rlen=0; + int ierr, tsize; + MPI_Datatype vtype; + + file = pio_get_file_from_id(ncid); + + if (file == NULL) + { + fprintf(stderr,"File handle not found %d %d\n",ncid,__LINE__); + return PIO_EBADID; + } + iodesc = pio_get_iodesc_from_id(ioid); + if (iodesc == NULL) + { + fprintf(stderr,"iodesc handle not found %d %d\n",ioid,__LINE__); + return PIO_EBADID; + } + ios = file->iosystem; + if (ios->iomaster) + { + rlen = iodesc->maxiobuflen; + } + else + { + rlen = iodesc->llen; + } + + if (iodesc->rearranger > 0) + { + if (ios->ioproc && rlen>0) + { + MPI_Type_size(iodesc->basetype, &tsize); + iobuf = bget(((size_t) tsize)*rlen); + if (iobuf==NULL) + { + piomemerror(*ios,rlen*((size_t) tsize), __FILE__,__LINE__); + } + } + } + else + { + iobuf = array; + } + + switch(file->iotype) + { + case PIO_IOTYPE_NETCDF: + case PIO_IOTYPE_NETCDF4C: + ierr = pio_read_darray_nc_serial(file, iodesc, vid, iobuf); + break; + case PIO_IOTYPE_PNETCDF: + case PIO_IOTYPE_NETCDF4P: + ierr = pio_read_darray_nc(file, iodesc, vid, iobuf); + break; + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + if (iodesc->rearranger > 0) + { + ierr = rearrange_io2comp(*ios, iodesc, iobuf, array); + + if (rlen>0) + brel(iobuf); + } + + return ierr; + +} + +/** Flush the output buffer. This is only relevant for files opened + * with pnetcdf. + * + * @param file a pointer to the open file descriptor for the file + * that will be written to + * @param force true to force the flushing of the buffer + * @param addsize additional size to add to buffer (in bytes) + * + * @return 0 for success, error code otherwise. + * @private + * @ingroup PIO_write_darray + */ +int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize) +{ + int ierr = PIO_NOERR; + +#ifdef _PNETCDF + var_desc_t *vdesc; + int *status; + PIO_Offset usage = 0; + +#ifdef TIMING + /* Start timing this function. */ + GPTLstart("PIO:flush_output_buffer"); +#endif + + pioassert(file != NULL, "file pointer not defined", __FILE__, + __LINE__); + + /* Find out the buffer usage. */ + ierr = ncmpi_inq_buffer_usage(file->fh, &usage); + + /* If we are not forcing a flush, spread the usage to all IO + * tasks. */ + if (!force && file->iosystem->io_comm != MPI_COMM_NULL) + { + usage += addsize; + MPI_Allreduce(MPI_IN_PLACE, &usage, 1, MPI_OFFSET, MPI_MAX, + file->iosystem->io_comm); + } + + /* Keep track of the maximum usage. */ + if (usage > maxusage) + maxusage = usage; + + /* If the user forces it, or the buffer has exceeded the size + * limit, then flush to disk. */ + if (force || usage >= PIO_BUFFER_SIZE_LIMIT) + { + int rcnt; + bool prev_dist=false; + int prev_record=-1; + int prev_type=0; + int maxreq; + int reqcnt; + maxreq = 0; + reqcnt=0; + rcnt=0; + for (int i = 0; i < PIO_MAX_VARS; i++) + { + vdesc = file->varlist + i; + reqcnt += vdesc->nreqs; + if (vdesc->nreqs > 0) + maxreq = i; + } + int request[reqcnt]; + int status[reqcnt]; + + for (int i = 0; i <= maxreq; i++) + { + vdesc = file->varlist + i; +#ifdef MPIO_ONESIDED + /*onesided optimization requires that all of the requests in a wait_all call represent + a contiguous block of data in the file */ + if (rcnt>0 && (prev_record != vdesc->record || vdesc->nreqs==0)) + { + ierr = ncmpi_wait_all(file->fh, rcnt, request,status); + rcnt=0; + } + prev_record = vdesc->record; +#endif + // printf("%s %d %d %d %d \n",__FILE__,__LINE__,i,vdesc->nreqs,vdesc->request); + for (reqcnt=0;reqcntnreqs;reqcnt++) + { + request[rcnt++] = max(vdesc->request[reqcnt],NC_REQ_NULL); + } + free(vdesc->request); + vdesc->request = NULL; + vdesc->nreqs = 0; + // if (file->iosystem->io_rank < 2) printf("%s %d varid=%d\n",__FILE__,__LINE__,i); +#ifdef FLUSH_EVERY_VAR + ierr = ncmpi_wait_all(file->fh, rcnt, request, status); + rcnt = 0; +#endif + } + // if (file->iosystem->io_rank==0){ + // printf("%s %d %d\n",__FILE__,__LINE__,rcnt); + // } + if (rcnt > 0) + { + /* + if (file->iosystem->io_rank==0){ + printf("%s %d %d ",__FILE__,__LINE__,rcnt); + for (int i=0; ifh, rcnt, request, status); + } + for (int i = 0; i < PIO_MAX_VARS; i++) + { + vdesc = file->varlist + i; + if (vdesc->iobuf) + { + brel(vdesc->iobuf); + vdesc->iobuf=NULL; + } + if (vdesc->fillbuf) + { + brel(vdesc->fillbuf); + vdesc->fillbuf=NULL; + } + } + + } + +#ifdef TIMING + /* Stop timing this function. */ + GPTLstop("PIO:flush_output_buffer"); +#endif + +#endif /* _PNETCDF */ + return ierr; +} + +/** Print out info about the buffer for debug purposes. + * + * @param ios the IO system structure + * @param collective true if collective report is desired + * + * @private + * @ingroup PIO_write_darray + */ +void cn_buffer_report(iosystem_desc_t ios, bool collective) +{ + + if (CN_bpool) + { + long bget_stats[5]; + long bget_mins[5]; + long bget_maxs[5]; + + bstats(bget_stats, bget_stats+1,bget_stats+2,bget_stats+3,bget_stats+4); + if (collective) + { + MPI_Reduce(bget_stats, bget_maxs, 5, MPI_LONG, MPI_MAX, 0, ios.comp_comm); + MPI_Reduce(bget_stats, bget_mins, 5, MPI_LONG, MPI_MIN, 0, ios.comp_comm); + if (ios.compmaster) + { + printf("PIO: Currently allocated buffer space %ld %ld\n", + bget_mins[0], bget_maxs[0]); + printf("PIO: Currently available buffer space %ld %ld\n", + bget_mins[1], bget_maxs[1]); + printf("PIO: Current largest free block %ld %ld\n", + bget_mins[2], bget_maxs[2]); + printf("PIO: Number of successful bget calls %ld %ld\n", + bget_mins[3], bget_maxs[3]); + printf("PIO: Number of successful brel calls %ld %ld\n", + bget_mins[4], bget_maxs[4]); + // print_trace(stdout); + } + } + else + { + printf("%d: PIO: Currently allocated buffer space %ld \n", + ios.union_rank, bget_stats[0]) ; + printf("%d: PIO: Currently available buffer space %ld \n", + ios.union_rank, bget_stats[1]); + printf("%d: PIO: Current largest free block %ld \n", + ios.union_rank, bget_stats[2]); + printf("%d: PIO: Number of successful bget calls %ld \n", + ios.union_rank, bget_stats[3]); + printf("%d: PIO: Number of successful brel calls %ld \n", + ios.union_rank, bget_stats[4]); + } + } +} + +/** Free the buffer pool. If malloc is used (that is, PIO_USE_MALLOC is + * non zero), this function does nothing. + * + * @param ios the IO system structure + * + * @private + * @ingroup PIO_write_darray + */ +void free_cn_buffer_pool(iosystem_desc_t ios) +{ +#if !PIO_USE_MALLOC + if (CN_bpool) + { + cn_buffer_report(ios, true); + bpoolrelease(CN_bpool); + // free(CN_bpool); + CN_bpool = NULL; + } +#endif /* !PIO_USE_MALLOC */ +} + +/** Flush the buffer. + * + * @param ncid identifies the netCDF file + * @param wmb + * @param flushtodisk + * + * @private + * @ingroup PIO_write_darray + */ +void flush_buffer(int ncid, wmulti_buffer *wmb, bool flushtodisk) +{ + if (wmb->validvars > 0) + { + PIOc_write_darray_multi(ncid, wmb->vid, wmb->ioid, wmb->validvars, + wmb->arraylen, wmb->data, wmb->frame, + wmb->fillvalue, flushtodisk); + wmb->validvars = 0; + brel(wmb->vid); + wmb->vid = NULL; + brel(wmb->data); + wmb->data = NULL; + if (wmb->fillvalue) + brel(wmb->fillvalue); + if (wmb->frame) + brel(wmb->frame); + wmb->fillvalue = NULL; + wmb->frame = NULL; + } +} + +/** Compute the maximum aggregate number of bytes. + * + * @param ios the IO system structure + * @param iodesc a pointer to the defined iodescriptor for the buffer + * + * @private + * @ingroup PIO_write_darray + */ +void compute_maxaggregate_bytes(const iosystem_desc_t ios, io_desc_t *iodesc) +{ + int maxbytesoniotask = INT_MAX; + int maxbytesoncomputetask = INT_MAX; + int maxbytes; + + // printf("%s %d %d %d\n",__FILE__,__LINE__,iodesc->maxiobuflen, iodesc->ndof); + + if (ios.ioproc && iodesc->maxiobuflen > 0) + maxbytesoniotask = PIO_BUFFER_SIZE_LIMIT / iodesc->maxiobuflen; + + if (ios.comp_rank >= 0 && iodesc->ndof > 0) + maxbytesoncomputetask = PIO_CNBUFFER_LIMIT / iodesc->ndof; + + maxbytes = min(maxbytesoniotask, maxbytesoncomputetask); + + // printf("%s %d %d %d\n",__FILE__,__LINE__,maxbytesoniotask, maxbytesoncomputetask); + + MPI_Allreduce(MPI_IN_PLACE, &maxbytes, 1, MPI_INT, MPI_MIN, ios.union_comm); + iodesc->maxbytes = maxbytes; + // printf("%s %d %d %d\n",__FILE__,__LINE__,iodesc->maxbytes,iodesc->maxiobuflen); + +} diff --git a/externals/pio2/src/clib/pio_file.c b/externals/pio2/src/clib/pio_file.c index 69d03336c4a4..5003288caa0f 100644 --- a/externals/pio2/src/clib/pio_file.c +++ b/externals/pio2/src/clib/pio_file.c @@ -1,461 +1,592 @@ +#include #include #include -/** - ** @public - ** @ingroup PIO_openfile - ** @brief open an existing file using pio - ** @details Input parameters are read on comp task 0 and ignored elsewhere. - ** @param iosysid : A defined pio system descriptor (input) - ** @param ncidp : A pio file descriptor (output) - ** @param iotype : A pio output format (input) - ** @param filename : The filename to open - ** @param mode : The netcdf mode for the open operation - */ +/** Open an existing file using PIO library. + * + * Input parameters are read on comp task 0 and ignored elsewhere. + * + * @param iosysid : A defined pio system descriptor (input) + * @param ncidp : A pio file descriptor (output) + * @param iotype : A pio output format (input) + * @param filename : The filename to open + * @param mode : The netcdf mode for the open operation + * + * @return 0 for success, error code otherwise. + * @ingroup PIO_openfile + */ int PIOc_openfile(const int iosysid, int *ncidp, int *iotype, - const char filename[], const int mode) + const char *filename, const int mode) { - int ierr; - int msg; - int mpierr; - size_t len; - iosystem_desc_t *ios; - file_desc_t *file; - - ierr = PIO_NOERR; - - msg = PIO_MSG_OPEN_FILE; - ios = pio_get_iosystem_from_id(iosysid); - if(ios==NULL){ - printf("bad iosysid %d\n",iosysid); - return PIO_EBADID; - } - - file = (file_desc_t *) malloc(sizeof(*file)); - if(file==NULL){ - return PIO_ENOMEM; - } - file->iotype = *iotype; - file->next = NULL; - file->iosystem = ios; - file->mode = mode; - for(int i=0; ivarlist[i].record = -1; - file->varlist[i].ndims = -1; + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_openfile iosysid = %d", iosysid)); + + /* User must provide valid input for these parameters. */ + if (!ncidp || !iotype || !filename) + return PIO_EINVAL; + if (*iotype < PIO_IOTYPE_PNETCDF || *iotype > PIO_IOTYPE_NETCDF4P) + return PIO_ENOMEM; + + /* Get the IO system info from the iosysid. */ + if (!(ios = pio_get_iosystem_from_id(iosysid))) + { + LOG((0, "PIOc_openfile got bad iosysid %d",iosysid)); + return PIO_EBADID; + } + + /* Allocate space for the file info. */ + if (!(file = (file_desc_t *) malloc(sizeof(*file)))) + return PIO_ENOMEM; + + /* Fill in some file values. */ + file->iotype = *iotype; + file->next = NULL; + file->iosystem = ios; + file->mode = mode; + for (int i = 0; i < PIO_MAX_VARS; i++) + { + file->varlist[i].record = -1; + file->varlist[i].ndims = -1; #ifdef _PNETCDF - file->varlist[i].request = NULL; - file->varlist[i].nreqs=0; + file->varlist[i].request = NULL; + file->varlist[i].nreqs=0; #endif - file->varlist[i].fillbuf = NULL; - file->varlist[i].iobuf = NULL; - } - - file->buffer.validvars=0; - file->buffer.vid=NULL; - file->buffer.data=NULL; - file->buffer.next=NULL; - file->buffer.frame=NULL; - file->buffer.fillvalue=NULL; - - if(ios->async_interface && ! ios->ioproc){ - if(ios->comp_rank==0) - mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - len = strlen(filename); - mpierr = MPI_Bcast((void *) filename,len, MPI_CHAR, ios->compmaster, ios->intercomm); - mpierr = MPI_Bcast(&(file->iotype), 1, MPI_INT, ios->compmaster, ios->intercomm); - mpierr = MPI_Bcast(&(file->mode), 1, MPI_INT, ios->compmaster, ios->intercomm); - } - - if(ios->ioproc){ - - switch(file->iotype){ + file->varlist[i].fillbuf = NULL; + file->varlist[i].iobuf = NULL; + } + + file->buffer.validvars = 0; + file->buffer.vid = NULL; + file->buffer.data = NULL; + file->buffer.next = NULL; + file->buffer.frame = NULL; + file->buffer.fillvalue = NULL; + + /* Set to true if this task should participate in IO (only true for + * one task with netcdf serial files. */ + if (file->iotype == PIO_IOTYPE_NETCDF4P || file->iotype == PIO_IOTYPE_PNETCDF || + ios->io_rank == 0) + file->do_io = 1; + else + file->do_io = 0; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + int msg = PIO_MSG_OPEN_FILE; + size_t len = strlen(filename); + + if (!ios->ioproc) + { + /* Send the message to the message handler. */ + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + /* Send the parameters of the function call. */ + if (!mpierr) + mpierr = MPI_Bcast(&len, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)filename, len + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&file->iotype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&file->mode, 1, MPI_INT, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { + switch (file->iotype) + { #ifdef _NETCDF #ifdef _NETCDF4 - case PIO_IOTYPE_NETCDF4P: -#ifdef _MPISERIAL - ierr = nc_open(filename, file->mode, &(file->fh)); + case PIO_IOTYPE_NETCDF4P: +#ifdef _MPISERIAL + ierr = nc_open(filename, file->mode, &(file->fh)); #else - file->mode = file->mode | NC_MPIIO; - ierr = nc_open_par(filename, file->mode, ios->io_comm,ios->info, &(file->fh)); + file->mode = file->mode | NC_MPIIO; + ierr = nc_open_par(filename, file->mode, ios->io_comm, ios->info, &file->fh); #endif - break; + break; - case PIO_IOTYPE_NETCDF4C: - file->mode = file->mode | NC_NETCDF4; - // *** Note the INTENTIONAL FALLTHROUGH *** + case PIO_IOTYPE_NETCDF4C: + file->mode = file->mode | NC_NETCDF4; + // *** Note the INTENTIONAL FALLTHROUGH *** #endif - case PIO_IOTYPE_NETCDF: - if(ios->io_rank==0){ - ierr = nc_open(filename, file->mode, &(file->fh)); - } - break; + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_open(filename, file->mode, &file->fh); + } + break; #endif #ifdef _PNETCDF - case PIO_IOTYPE_PNETCDF: - ierr = ncmpi_open(ios->io_comm, filename, file->mode, ios->info, &(file->fh)); - - // This should only be done with a file opened to append - if(ierr == PIO_NOERR && (file->mode & PIO_WRITE)){ - if(ios->iomaster) printf("%d Setting IO buffer %ld\n",__LINE__,PIO_BUFFER_SIZE_LIMIT); - ierr = ncmpi_buffer_attach(file->fh, PIO_BUFFER_SIZE_LIMIT ); - } - break; + case PIO_IOTYPE_PNETCDF: + ierr = ncmpi_open(ios->io_comm, filename, file->mode, ios->info, &file->fh); + + // This should only be done with a file opened to append + if (ierr == PIO_NOERR && (file->mode & PIO_WRITE)) + { + if(ios->iomaster) + LOG((1, "%d Setting IO buffer %ld", __LINE__, PIO_BUFFER_SIZE_LIMIT)); + ierr = ncmpi_buffer_attach(file->fh, PIO_BUFFER_SIZE_LIMIT); + } + break; #endif - default: - ierr = iotype_error(file->iotype,__FILE__,__LINE__); - break; - } + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + break; + } - // If we failed to open a file due to an incompatible type of NetCDF, try it - // once with just plain old basic NetCDF + // If we failed to open a file due to an incompatible type of + // NetCDF, try it once with just plain old basic NetCDF. #ifdef _NETCDF - if(ierr == NC_ENOTNC && (file->iotype != PIO_IOTYPE_NETCDF)) { - if(ios->iomaster) printf("PIO2 pio_file.c retry NETCDF\n"); - // reset ierr on all tasks - ierr = PIO_NOERR; - // reset file markers for NETCDF on all tasks - file->iotype = PIO_IOTYPE_NETCDF; + if((ierr == NC_ENOTNC || ierr == NC_EINVAL) && (file->iotype != PIO_IOTYPE_NETCDF)) { + if(ios->iomaster) printf("PIO2 pio_file.c retry NETCDF\n"); + // reset ierr on all tasks + ierr = PIO_NOERR; + // reset file markers for NETCDF on all tasks + file->iotype = PIO_IOTYPE_NETCDF; - // open netcdf file serially on main task - if(ios->io_rank==0){ - ierr = nc_open(filename, file->mode, &(file->fh)); } + // open netcdf file serially on main task + if(ios->io_rank==0){ + ierr = nc_open(filename, file->mode, &(file->fh)); } - } + } #endif - } - - ierr = check_netcdf(file, ierr, __FILE__,__LINE__); - - if(ierr==PIO_NOERR){ - mpierr = MPI_Bcast(&(file->mode), 1, MPI_INT, ios->ioroot, ios->union_comm); - pio_add_to_file_list(file); - *ncidp = file->fh; - } - if(ios->io_rank==0){ - printf("Open file %s %d\n",filename,file->fh); //,file->fh,file->id,ios->io_rank,ierr); -// if(file->fh==5) print_trace(stdout); - } - return ierr; + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + { + if ((mpierr = MPI_Bcast(&file->mode, 1, MPI_INT, ios->ioroot, ios->union_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + if ((mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->ioroot, ios->union_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + *ncidp = file->fh; + pio_add_to_file_list(file); + } + + if (ios->io_rank == 0) + LOG((1, "Open file %s %d", filename, file->fh)); + + return ierr; } -/** - ** @public - ** @ingroup PIO_createfile - ** @brief open a new file using pio - ** @details Input parameters are read on comp task 0 and ignored elsewhere. - ** @param iosysid : A defined pio system descriptor (input) - ** @param ncidp : A pio file descriptor (output) - ** @param iotype : A pio output format (input) - ** @param filename : The filename to open - ** @param mode : The netcdf mode for the open operation +/** Open a new file using pio. Input parameters are read on comp task + * 0 and ignored elsewhere. + * + * @public + * @ingroup PIO_createfile + * + * @param iosysid : A defined pio system descriptor (input) + * @param ncidp : A pio file descriptor (output) + * @param iotype : A pio output format (input) + * @param filename : The filename to open + * @param mode : The netcdf mode for the open operation */ -int PIOc_createfile(const int iosysid, int *ncidp, int *iotype, - const char filename[], const int mode) +int PIOc_createfile(const int iosysid, int *ncidp, int *iotype, + const char filename[], const int mode) { - int ierr; - int msg; - int mpierr; - - size_t len; - iosystem_desc_t *ios; - file_desc_t *file; - - - ierr = PIO_NOERR; - - ios = pio_get_iosystem_from_id(iosysid); - file = (file_desc_t *) malloc(sizeof(file_desc_t)); - file->next = NULL; - file->iosystem = ios; - file->iotype = *iotype; - - file->buffer.validvars=0; - file->buffer.data=NULL; - file->buffer.next=NULL; - file->buffer.vid=NULL; - file->buffer.ioid=-1; - file->buffer.frame=NULL; - file->buffer.fillvalue=NULL; - - for(int i=0; ivarlist[i].record = -1; - file->varlist[i].ndims = -1; + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* User must provide valid input for these parameters. */ + if (!ncidp || !iotype || !filename || strlen(filename) > NC_MAX_NAME) + return PIO_EINVAL; + + /* Get the IO system info from the iosysid. */ + if (!(ios = pio_get_iosystem_from_id(iosysid))) + return PIO_EBADID; + + /* Allocate space for the file info. */ + if (!(file = (file_desc_t *)malloc(sizeof(file_desc_t)))) + return PIO_ENOMEM; + + /* Fill in some file values. */ + file->next = NULL; + file->iosystem = ios; + file->iotype = *iotype; + + file->buffer.validvars = 0; + file->buffer.data = NULL; + file->buffer.next = NULL; + file->buffer.vid = NULL; + file->buffer.ioid = -1; + file->buffer.frame = NULL; + file->buffer.fillvalue = NULL; + + for(int i = 0; i < PIO_MAX_VARS; i++) + { + file->varlist[i].record = -1; + file->varlist[i].ndims = -1; #ifdef _PNETCDF - file->varlist[i].request = NULL; - file->varlist[i].nreqs=0; + file->varlist[i].request = NULL; + file->varlist[i].nreqs=0; #endif - file->varlist[i].fillbuf = NULL; - file->varlist[i].iobuf = NULL; - } - - msg = PIO_MSG_CREATE_FILE; - file->mode = mode; - - - if(ios->async_interface && ! ios->ioproc){ - if(ios->comp_rank==0) - mpierr = MPI_Send( &msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - len = strlen(filename); - mpierr = MPI_Bcast((void *) filename,len, MPI_CHAR, ios->compmaster, ios->intercomm); - mpierr = MPI_Bcast(&(file->iotype), 1, MPI_INT, ios->compmaster, ios->intercomm); - mpierr = MPI_Bcast(&file->mode, 1, MPI_INT, ios->compmaster, ios->intercomm); - } + file->varlist[i].fillbuf = NULL; + file->varlist[i].iobuf = NULL; + } + file->mode = mode; + + /* Set to true if this task should participate in IO (only true for + * one task with netcdf serial files. */ + if (file->iotype == PIO_IOTYPE_NETCDF4P || file->iotype == PIO_IOTYPE_PNETCDF || + ios->io_rank == 0) + file->do_io = 1; + else + file->do_io = 0; + + /* If async is in use, and this is not an IO task, bcast the + * parameters. */ + if (ios->async_interface) + { + int msg = PIO_MSG_CREATE_FILE; + size_t len = strlen(filename); + + if (!ios->ioproc) + { + /* Send the message to the message handler. */ + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + /* Send the parameters of the function call. */ + if (!mpierr) + mpierr = MPI_Bcast(&len, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)filename, len + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&file->iotype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&file->mode, 1, MPI_INT, ios->compmaster, ios->intercomm); + } - if(ios->ioproc){ - switch(file->iotype){ + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + if (ios->ioproc) + { + switch (file->iotype) + { #ifdef _NETCDF #ifdef _NETCDF4 - case PIO_IOTYPE_NETCDF4P: - // The 64 bit options are not compatable with hdf5 format files - // printf("%d %d %d %d %d \n",__LINE__,file->mode,PIO_64BIT_DATA, PIO_64BIT_OFFSET, NC_MPIIO); - file->mode = file->mode | NC_MPIIO | NC_NETCDF4; - //printf("%s %d %d %d\n",__FILE__,__LINE__,file->mode, NC_MPIIO| NC_NETCDF4); - ierr = nc_create_par(filename, file->mode, ios->io_comm,ios->info , &(file->fh)); - break; - case PIO_IOTYPE_NETCDF4C: - file->mode = file->mode | NC_NETCDF4; + case PIO_IOTYPE_NETCDF4P: + // The 64 bit options are not compatable with hdf5 format files + // printf("%d %d %d %d %d \n",__LINE__,file->mode,PIO_64BIT_DATA, PIO_64BIT_OFFSET, NC_MPIIO); + file->mode = file->mode | NC_MPIIO | NC_NETCDF4; + //printf("%s %d %d %d\n",__FILE__,__LINE__,file->mode, NC_MPIIO| NC_NETCDF4); + ierr = nc_create_par(filename, file->mode, ios->io_comm,ios->info , &(file->fh)); + break; + case PIO_IOTYPE_NETCDF4C: + file->mode = file->mode | NC_NETCDF4; #endif - case PIO_IOTYPE_NETCDF: - if(ios->io_rank==0){ - ierr = nc_create(filename, file->mode, &(file->fh)); - } - break; + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_create(filename, file->mode, &(file->fh)); + } + break; #endif #ifdef _PNETCDF - case PIO_IOTYPE_PNETCDF: - ierr = ncmpi_create(ios->io_comm, filename, file->mode, ios->info, &(file->fh)); - if(ierr == PIO_NOERR){ - if(ios->io_rank==0){ - printf("%d Setting IO buffer size on all iotasks to %ld\n",ios->io_rank,PIO_BUFFER_SIZE_LIMIT); - } - int oldfill; - ierr = ncmpi_buffer_attach(file->fh, PIO_BUFFER_SIZE_LIMIT ); - // ierr = ncmpi_set_fill(file->fh, NC_FILL, &oldfill); - } - break; + case PIO_IOTYPE_PNETCDF: + ierr = ncmpi_create(ios->io_comm, filename, file->mode, ios->info, &(file->fh)); + if(ierr == PIO_NOERR){ + if(ios->io_rank==0){ + printf("%d Setting IO buffer size on all iotasks to %ld\n",ios->io_rank,PIO_BUFFER_SIZE_LIMIT); + } + int oldfill; + ierr = ncmpi_buffer_attach(file->fh, PIO_BUFFER_SIZE_LIMIT ); + // ierr = ncmpi_set_fill(file->fh, NC_FILL, &oldfill); + } + break; #endif - default: - ierr = iotype_error(file->iotype,__FILE__,__LINE__); + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } } - } - - ierr = check_netcdf(file, ierr, __FILE__,__LINE__); - - if(ierr == PIO_NOERR){ - mpierr = MPI_Bcast(&(file->mode), 1, MPI_INT, ios->ioroot, ios->union_comm); - file->mode = file->mode | PIO_WRITE; // This flag is implied by netcdf create functions but we need to know if its set - pio_add_to_file_list(file); - *ncidp = file->fh; - } - if(ios->io_rank==0){ - printf("Create file %s %d\n",filename,file->fh); //,file->fh,file->id,ios->io_rank,ierr); -// if(file->fh==5) print_trace(stdout); - } - return ierr; + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + { + if ((mpierr = MPI_Bcast(&file->mode, 1, MPI_INT, ios->ioroot, ios->union_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + file->mode = file->mode | PIO_WRITE; // This flag is implied by netcdf create functions but we need to know if its set + + if ((mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->ioroot, ios->union_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + *ncidp = file->fh; + pio_add_to_file_list(file); + } + + if (ios->io_rank == 0) + LOG((1, "Create file %s %d", filename, file->fh)); + + return ierr; } -/** - ** @ingroup PIO_closefile - ** @brief close a file previously opened with PIO - ** @param ncid: the file pointer +/** Close a file previously opened with PIO. + * @ingroup PIO_closefile + * + * @param ncid: the file pointer */ int PIOc_closefile(int ncid) { - int ierr; - int msg; - int mpierr; - iosystem_desc_t *ios; - file_desc_t *file; - - ierr = PIO_NOERR; - - file = pio_get_file_from_id(ncid); - if(file == NULL) - return PIO_EBADID; - ios = file->iosystem; - msg = 0; - if((file->mode & PIO_WRITE)){ - PIOc_sync(ncid); - } - if(ios->async_interface && ! ios->ioproc){ - if(ios->comp_rank==0) - mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); - } - - if(ios->ioproc){ - switch(file->iotype){ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* Sync changes before closing. */ + if (file->mode & PIO_WRITE) + PIOc_sync(ncid); + + /* If async is in use and this is a comp tasks, then the compmaster + * sends a msg to the pio_msg_handler running on the IO master and + * waiting for a message. Then broadcast the ncid over the intercomm + * to the IO tasks. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_CLOSE_FILE; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { + switch (file->iotype) + { #ifdef _NETCDF #ifdef _NETCDF4 - case PIO_IOTYPE_NETCDF4P: - ierr = nc_close(file->fh); - break; - case PIO_IOTYPE_NETCDF4C: + case PIO_IOTYPE_NETCDF4P: + ierr = nc_close(file->fh); + break; + case PIO_IOTYPE_NETCDF4C: #endif - case PIO_IOTYPE_NETCDF: - if(ios->io_rank==0){ - ierr = nc_close(file->fh); - } - break; + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_close(file->fh); + } + break; #endif #ifdef _PNETCDF - case PIO_IOTYPE_PNETCDF: - if((file->mode & PIO_WRITE)){ - ierr = ncmpi_buffer_detach(file->fh); - } - ierr = ncmpi_close(file->fh); - break; + case PIO_IOTYPE_PNETCDF: + if((file->mode & PIO_WRITE)){ + ierr = ncmpi_buffer_detach(file->fh); + } + ierr = ncmpi_close(file->fh); + break; #endif - default: - ierr = iotype_error(file->iotype,__FILE__,__LINE__); + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } } - } - if(ios->io_rank==0){ - printf("Close file %d \n",file->fh); -// if(file->fh==5) print_trace(stdout); - } - - ierr = check_netcdf(file, ierr, __FILE__,__LINE__); - int iret = pio_delete_file_from_list(ncid); + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + /* Delete file from our list of open files. */ + pio_delete_file_from_list(ncid); - return ierr; + return ierr; } -/** - ** @ingroup PIO_deletefile - ** @brief Delete a file - ** @param iosysid : a pio system handle - ** @param filename : a filename +/** Delete a file. + * @ingroup PIO_deletefile + * + * @param iosysid : a pio system handle + * @param filename : a filename */ int PIOc_deletefile(const int iosysid, const char filename[]) { - int ierr; - int msg; - int mpierr; - int chkerr; - iosystem_desc_t *ios; - - ierr = PIO_NOERR; - ios = pio_get_iosystem_from_id(iosysid); - - if(ios == NULL) - return PIO_EBADID; - - msg = 0; - - if(ios->async_interface && ! ios->ioproc){ - if(ios->comp_rank==0) - mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - // mpierr = MPI_Bcast(iosysid,1, MPI_INT, ios->compmaster, ios->intercomm); - } - // The barriers are needed to assure that no task is trying to operate on the file while it is being deleted. - if(ios->ioproc){ - MPI_Barrier(ios->io_comm); + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + int msg = PIO_MSG_DELETE_FILE; + size_t len; + + /* Get the IO system info from the id. */ + if (!(ios = pio_get_iosystem_from_id(iosysid))) + return PIO_EBADID; + + /* If async is in use, send message to IO master task. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + if(ios->comp_rank==0) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + len = strlen(filename); + if (!mpierr) + mpierr = MPI_Bcast(&len, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)filename, len + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + } + + /* If this is an IO task, then call the netCDF function. The + * barriers are needed to assure that no task is trying to operate + * on the file while it is being deleted. */ + if(ios->ioproc){ + MPI_Barrier(ios->io_comm); #ifdef _NETCDF - if(ios->io_rank==0) - ierr = nc_delete(filename); + if(ios->io_rank==0) + ierr = nc_delete(filename); #else #ifdef _PNETCDF - ierr = ncmpi_delete(filename, ios->info); + ierr = ncmpi_delete(filename, ios->info); #endif #endif - MPI_Barrier(ios->io_comm); - } - // Special case - always broadcast the return from the - MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm); - - + MPI_Barrier(ios->io_comm); + } + + // Special case - always broadcast the return from the + MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm); - return ierr; + return ierr; } -/// -/// PIO interface to nc_sync -/// -/// This routine is called collectively by all tasks in the communicator ios.union_comm. -/// -/// Refer to the netcdf documentation. -/// -/** -* @name PIOc_sync -*/ -int PIOc_sync (int ncid) +/** + * PIO interface to nc_sync This routine is called collectively by all + * tasks in the communicator ios.union_comm. + * + * Refer to the netcdf documentation. + */ +int PIOc_sync(int ncid) { - int ierr; - int msg; - int mpierr; - iosystem_desc_t *ios; - file_desc_t *file; - wmulti_buffer *wmb, *twmb; - - ierr = PIO_NOERR; - - file = pio_get_file_from_id(ncid); - if(file == NULL) - return PIO_EBADID; - ios = file->iosystem; - msg = PIO_MSG_SYNC; - - if(ios->async_interface && ! ios->ioproc){ - if(ios->compmaster) - mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); - } - - if((file->mode & PIO_WRITE)){ - // cn_buffer_report( *ios, true); - wmb = &(file->buffer); - while(wmb != NULL){ - // printf("%s %d %d %d\n",__FILE__,__LINE__,wmb->ioid, wmb->validvars); - if(wmb->validvars>0){ - flush_buffer(ncid, wmb, true); - } - twmb = wmb; - wmb = wmb->next; - if(twmb == &(file->buffer)){ - twmb->ioid=-1; - twmb->next=NULL; - }else{ - brel(twmb); - } + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + wmulti_buffer *wmb, *twmb; + + /* Get the file info from the ncid. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, send message to IO master tasks. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_SYNC; + + if(ios->comp_rank == 0) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } } - flush_output_buffer(file, true, 0); - if(ios->ioproc){ - switch(file->iotype){ + if (file->mode & PIO_WRITE) + { + // cn_buffer_report( *ios, true); + wmb = &(file->buffer); + while(wmb != NULL){ + // printf("%s %d %d %d\n",__FILE__,__LINE__,wmb->ioid, wmb->validvars); + if(wmb->validvars>0){ + flush_buffer(ncid, wmb, true); + } + twmb = wmb; + wmb = wmb->next; + if(twmb == &(file->buffer)){ + twmb->ioid=-1; + twmb->next=NULL; + }else{ + brel(twmb); + } + } + flush_output_buffer(file, true, 0); + + if(ios->ioproc){ + switch(file->iotype){ #ifdef _NETCDF #ifdef _NETCDF4 - case PIO_IOTYPE_NETCDF4P: - ierr = nc_sync(file->fh);; - break; - case PIO_IOTYPE_NETCDF4C: + case PIO_IOTYPE_NETCDF4P: + ierr = nc_sync(file->fh);; + break; + case PIO_IOTYPE_NETCDF4C: #endif - case PIO_IOTYPE_NETCDF: - if(ios->io_rank==0){ - ierr = nc_sync(file->fh);; - } - break; + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_sync(file->fh);; + } + break; #endif #ifdef _PNETCDF - case PIO_IOTYPE_PNETCDF: - ierr = ncmpi_sync(file->fh);; - break; + case PIO_IOTYPE_PNETCDF: + ierr = ncmpi_sync(file->fh);; + break; #endif - default: - ierr = iotype_error(file->iotype,__FILE__,__LINE__); - } - } + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } - ierr = check_netcdf(file, ierr, __FILE__,__LINE__); - } - return ierr; + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + } + return ierr; } diff --git a/externals/pio2/src/clib/pio_get_nc_async.c b/externals/pio2/src/clib/pio_get_nc_async.c new file mode 100644 index 000000000000..7f6aeb79ce3d --- /dev/null +++ b/externals/pio2/src/clib/pio_get_nc_async.c @@ -0,0 +1,921 @@ +/** + * @file + * PIO functions to get data (excluding varm functions). + * + * @author Ed Hartnett + * @date 2016 + * + * @see http://code.google.com/p/parallelio/ + */ + +#include +#include +#include + +/** + * Internal PIO function which provides a type-neutral interface to + * nc_get_vars. + * + * Users should not call this function directly. Instead, call one of + * the derived functions, depending on the type of data you are + * reading: PIOc_get_vars_text(), PIOc_get_vars_uchar(), + * PIOc_get_vars_schar(), PIOc_get_vars_ushort(), + * PIOc_get_vars_short(), PIOc_get_vars_uint(), PIOc_get_vars_int(), + * PIOc_get_vars_long(), PIOc_get_vars_float(), + * PIOc_get_vars_double(), PIOc_get_vars_ulonglong(), + * PIOc_get_vars_longlong() + * + * This routine is called collectively by all tasks in the + * communicator ios.union_comm. + * + * @param ncid identifies the netCDF file + * @param varid the variable ID number + * @param start an array of start indicies (must have same number of + * entries as variable has dimensions). If NULL, indices of 0 will be + * used. + * + * @param count an array of counts (must have same number of entries + * as variable has dimensions). If NULL, counts matching the size of + * the variable will be used. + * + * @param stride an array of strides (must have same number of + * entries as variable has dimensions). If NULL, strides of 1 will be + * used. + * + * @param xtype the netCDF type of the data being passed in buf. Data + * will be automatically covnerted from the type of the variable being + * read from to this type. + * + * @param buf pointer to the data to be written. + * + * @return PIO_NOERR on success, error code otherwise. + */ +int PIOc_get_vars_tc(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, nc_type xtype, void *buf) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + int ndims; /* The number of dimensions in the variable. */ + int *dimids; /* The IDs of the dimensions for this variable. */ + PIO_Offset typelen; /* Size (in bytes) of the data type of data in buf. */ + PIO_Offset num_elem = 1; /* Number of data elements in the buffer. */ + int bcast = false; + + LOG((1, "PIOc_get_vars_tc ncid = %d varid = %d start = %d count = %d " + "stride = %d xtype = %d", ncid, varid, start, count, stride, xtype)); + + /* User must provide a place to put some data. */ + if (!buf) + return PIO_EINVAL; + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* Run these on all tasks if async is not in use, but only on + * non-IO tasks if async is in use. */ + if (!ios->async_interface || !ios->ioproc) + { + /* Get the length of the data type. */ + if ((ierr = PIOc_inq_type(ncid, xtype, NULL, &typelen))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Get the number of dims for this var. */ + if ((ierr = PIOc_inq_varndims(ncid, varid, &ndims))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + PIO_Offset dimlen[ndims]; + + /* If no count array was passed, we need to know the dimlens + * so we can calculate how many data elements are in the + * buf. */ + if (!count) + { + int dimid[ndims]; + + /* Get the dimids for this var. */ + if ((ierr = PIOc_inq_vardimid(ncid, varid, dimid))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Get the length of each dimension. */ + for (int vd = 0; vd < ndims; vd++) + if ((ierr = PIOc_inq_dimlen(ncid, dimid[vd], &dimlen[vd]))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + } + + /* Figure out the real start, count, and stride arrays. (The + * user may have passed in NULLs.) */ + PIO_Offset rstart[ndims], rcount[ndims], rstride[ndims]; + for (int vd = 0; vd < ndims; vd++) + { + rstart[vd] = start ? start[vd] : 0; + rcount[vd] = count ? count[vd] : dimlen[vd]; + rstride[vd] = stride ? stride[vd] : 1; + } + + /* How many elements in buf? */ + for (int vd = 0; vd < ndims; vd++) + num_elem *= (rcount[vd] - rstart[vd])/rstride[vd]; + LOG((2, "PIOc_get_vars_tc num_elem = %d", num_elem)); + } + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_GET_VARS; + char start_present = start ? true : false; + char count_present = count ? true : false; + char stride_present = stride ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + /* Send the function parameters and associated informaiton + * to the msg handler. */ + if (!mpierr) + mpierr = MPI_Bcast(&ncid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&ndims, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&start_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr && start_present) + mpierr = MPI_Bcast((PIO_Offset *)start, ndims, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&count_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr && count_present) + mpierr = MPI_Bcast((PIO_Offset *)count, ndims, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&stride_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr && stride_present) + mpierr = MPI_Bcast((PIO_Offset *)stride, ndims, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&num_elem, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_get_vars_tc ncid = %d varid = %d ndims = %d start_present = %d " + "count_present = %d stride_present = %d xtype = %d num_elem = %d", ncid, varid, + ndims, start_present, count_present, stride_present, xtype, num_elem)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + /* Broadcast values currently only known on computation tasks to IO tasks. */ + if ((mpierr = MPI_Bcast(&num_elem, 1, MPI_OFFSET, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + { +#ifdef PNET_READ_AND_BCAST + LOG((1, "PNET_READ_AND_BCAST")); + ncmpi_begin_indep_data(file->fh); + + /* Only the IO master does the IO, so we are not really + * getting parallel IO here. */ + if (ios->iomaster) + { + switch(xtype) + { + case NC_BYTE: + ierr = ncmpi_get_vars_schar(ncid, varid, start, count, stride, buf); + break; + case NC_CHAR: + ierr = ncmpi_get_vars_text(ncid, varid, start, count, stride, buf); + break; + case NC_SHORT: + ierr = ncmpi_get_vars_short(ncid, varid, start, count, stride, buf); + break; + case NC_INT: + ierr = ncmpi_get_vars_int(ncid, varid, start, count, stride, buf); + break; + case NC_FLOAT: + ierr = ncmpi_get_vars_float(ncid, varid, start, count, stride, buf); + break; + case NC_DOUBLE: + ierr = ncmpi_get_vars_double(ncid, varid, start, count, stride, buf); + break; + case NC_INT64: + ierr = ncmpi_get_vars_longlong(ncid, varid, start, count, stride, buf); + break; + default: + LOG((0, "Unknown type for pnetcdf file! xtype = %d", xtype)); + } + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else /* PNET_READ_AND_BCAST */ + LOG((1, "not PNET_READ_AND_BCAST")); + switch(xtype) + { + case NC_BYTE: + ierr = ncmpi_get_vars_schar_all(ncid, varid, start, count, stride, buf); + break; + case NC_CHAR: + ierr = ncmpi_get_vars_text_all(ncid, varid, start, count, stride, buf); + break; + case NC_SHORT: + ierr = ncmpi_get_vars_short_all(ncid, varid, start, count, stride, buf); + break; + case NC_INT: + ierr = ncmpi_get_vars_int_all(ncid, varid, start, count, stride, buf); + for (int i = 0; i < 4; i++) + LOG((2, "((int *)buf)[%d] = %d", i, ((int *)buf)[0])); + break; + case NC_FLOAT: + ierr = ncmpi_get_vars_float_all(ncid, varid, start, count, stride, buf); + break; + case NC_DOUBLE: + ierr = ncmpi_get_vars_double_all(ncid, varid, start, count, stride, buf); + break; + case NC_INT64: + ierr = ncmpi_get_vars_longlong_all(ncid, varid, start, count, stride, buf); + break; + default: + LOG((0, "Unknown type for pnetcdf file! xtype = %d", xtype)); + } +#endif /* PNET_READ_AND_BCAST */ + } +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + switch(xtype) + { + case NC_BYTE: + ierr = nc_get_vars_schar(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_CHAR: + ierr = nc_get_vars_schar(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_SHORT: + ierr = nc_get_vars_short(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_INT: + ierr = nc_get_vars_int(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_FLOAT: + ierr = nc_get_vars_float(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_DOUBLE: + ierr = nc_get_vars_double(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; +#ifdef _NETCDF4 + case NC_UBYTE: + ierr = nc_get_vars_uchar(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_USHORT: + ierr = nc_get_vars_ushort(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_UINT: + ierr = nc_get_vars_uint(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_INT64: + ierr = nc_get_vars_longlong(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_UINT64: + ierr = nc_get_vars_ulonglong(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + /* case NC_STRING: */ + /* ierr = nc_get_vars_string(ncid, varid, (size_t *)start, (size_t *)count, */ + /* (ptrdiff_t *)stride, (void *)buf); */ + /* break; */ + default: + ierr = nc_get_vars(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); +#endif /* _NETCDF4 */ + } +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Send the data. */ + LOG((2, "PIOc_get_vars_tc bcasting data num_elem = %d typelen = %d", num_elem, + typelen)); + if (!mpierr) + mpierr = MPI_Bcast((void *)buf, num_elem * typelen, MPI_BYTE, ios->ioroot, + ios->my_comm); + return ierr; +} + +int PIOc_get_vars_text(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_CHAR, buf); +} + +int PIOc_get_vars_uchar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, unsigned char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_UBYTE, buf); +} + +int PIOc_get_vars_schar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, signed char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_BYTE, buf); +} + +int PIOc_get_vars_ushort(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, unsigned short *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_USHORT, buf); +} + +int PIOc_get_vars_short(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, short *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_SHORT, buf); +} + +int PIOc_get_vars_uint(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, unsigned int *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_UINT, buf); +} + +int PIOc_get_vars_int(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, int *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_INT, buf); +} + +int PIOc_get_vars_long(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_LONG, buf); +} + +int PIOc_get_vars_float(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, float *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_FLOAT, buf); +} + +int PIOc_get_vars_double(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, double *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_DOUBLE, buf); +} + +int PIOc_get_vars_ulonglong(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, + unsigned long long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_UINT64, buf); +} + +int PIOc_get_vars_longlong(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, long long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, stride, NC_UINT64, buf); +} + +int PIOc_get_vara_text(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_CHAR, buf); +} + +int PIOc_get_vara_uchar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, unsigned char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_UBYTE, buf); +} + +int PIOc_get_vara_schar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, signed char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_BYTE, buf); +} + +int PIOc_get_vara_ushort(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, unsigned short *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_USHORT, buf); +} + +int PIOc_get_vara_short(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, short *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_SHORT, buf); +} + +int PIOc_get_vara_long(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_LONG, buf); +} + +int PIOc_get_vara_uint(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, unsigned int *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_UINT, buf); +} + +int PIOc_get_vara_int(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, int *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_INT, buf); +} + +int PIOc_get_vara_float(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, float *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_FLOAT, buf); +} + +int PIOc_get_vara_double(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, double *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_DOUBLE, buf); +} + +int PIOc_get_vara_ulonglong(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, unsigned long long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_UINT64, buf); +} + +int PIOc_get_vara_longlong(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, long long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, start, count, NULL, NC_INT64, buf); +} + +int PIOc_get_var_text(int ncid, int varid, char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_CHAR, buf); +} + +int PIOc_get_var_uchar(int ncid, int varid, unsigned char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_UBYTE, buf); +} + +int PIOc_get_var_schar(int ncid, int varid, signed char *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_BYTE, buf); +} + +int PIOc_get_var_ushort(int ncid, int varid, unsigned short *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_USHORT, buf); +} + +int PIOc_get_var_short(int ncid, int varid, short *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_SHORT, buf); +} + +int PIOc_get_var_uint(int ncid, int varid, unsigned int *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_UINT, buf); +} + +int PIOc_get_var_int(int ncid, int varid, int *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_INT, buf); +} + +int PIOc_get_var_long (int ncid, int varid, long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_LONG, buf); +} + +int PIOc_get_var_float(int ncid, int varid, float *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_FLOAT, buf); +} + +int PIOc_get_var_double(int ncid, int varid, double *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_DOUBLE, buf); +} + +int PIOc_get_var_ulonglong(int ncid, int varid, unsigned long long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_UINT64, buf); +} + +int PIOc_get_var_longlong(int ncid, int varid, long long *buf) +{ + return PIOc_get_vars_tc(ncid, varid, NULL, NULL, NULL, NC_INT64, buf); +} + +int PIOc_get_var1_tc(int ncid, int varid, const PIO_Offset *index, nc_type xtype, + void *buf) +{ + int ndims; + int ierr; + + /* Find the number of dimensions. */ + if ((ierr = PIOc_inq_varndims(ncid, varid, &ndims))) + return ierr; + + /* Set up count array. */ + PIO_Offset count[ndims]; + for (int c = 0; c < ndims; c++) + count[c] = 1; + + return PIOc_get_vars_tc(ncid, varid, index, count, NULL, xtype, buf); +} + +int PIOc_get_var1_text(int ncid, int varid, const PIO_Offset *index, char *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_CHAR, buf); +} + +int PIOc_get_var1_uchar (int ncid, int varid, const PIO_Offset *index, unsigned char *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_UBYTE, buf); +} + +int PIOc_get_var1_schar(int ncid, int varid, const PIO_Offset *index, signed char *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_BYTE, buf); +} + +int PIOc_get_var1_ushort(int ncid, int varid, const PIO_Offset *index, unsigned short *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_USHORT, buf); +} + +int PIOc_get_var1_short(int ncid, int varid, const PIO_Offset *index, short *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_SHORT, buf); +} + +int PIOc_get_var1_uint(int ncid, int varid, const PIO_Offset *index, unsigned int *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_UINT, buf); +} + +int PIOc_get_var1_long (int ncid, int varid, const PIO_Offset *index, long *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_LONG, buf); +} + +int PIOc_get_var1_int(int ncid, int varid, const PIO_Offset *index, int *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_INT, buf); +} + +int PIOc_get_var1_float(int ncid, int varid, const PIO_Offset *index, float *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_FLOAT, buf); +} + +int PIOc_get_var1_double (int ncid, int varid, const PIO_Offset *index, double *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_DOUBLE, buf); +} + +int PIOc_get_var1_ulonglong (int ncid, int varid, const PIO_Offset *index, + unsigned long long *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_INT64, buf); +} + + +int PIOc_get_var1_longlong(int ncid, int varid, const PIO_Offset *index, + long long *buf) +{ + return PIOc_get_var1_tc(ncid, varid, index, NC_INT64, buf); +} + +int PIOc_get_var (int ncid, int varid, void *buf, PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VAR; + ibufcnt = bufcount; + ibuftype = buftype; + ierr = PIO_NOERR; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_var(file->fh, varid, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_var(file->fh, varid, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_var(file->fh, varid, buf, bufcount, buftype);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_var_all(file->fh, varid, buf, bufcount, buftype);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + + + + + + +int PIOc_get_var1 (int ncid, int varid, const PIO_Offset *index, void *buf, PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VAR1; + ibufcnt = bufcount; + ibuftype = buftype; + ierr = PIO_NOERR; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_var1(file->fh, varid, (size_t *) index, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_var1(file->fh, varid, (size_t *) index, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_var1(file->fh, varid, index, buf, bufcount, buftype);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_var1_all(file->fh, varid, index, buf, bufcount, buftype);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_vara (int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, void *buf, PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARA; + ibufcnt = bufcount; + ibuftype = buftype; + ierr = PIO_NOERR; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_vara(file->fh, varid, (size_t *) start, (size_t *) count, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_vara(file->fh, varid, (size_t *) start, (size_t *) count, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_vara(file->fh, varid, start, count, buf, bufcount, buftype);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_vara_all(file->fh, varid, start, count, buf, bufcount, buftype);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + + + + + + +int PIOc_get_vars (int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, const PIO_Offset *stride, void *buf, PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARS; + ibufcnt = bufcount; + ibuftype = buftype; + ierr = PIO_NOERR; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_vars(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_vars(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_vars(file->fh, varid, start, count, stride, buf, bufcount, buftype);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_vars_all(file->fh, varid, start, count, stride, buf, bufcount, buftype);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + diff --git a/externals/pio2/src/clib/pio_internal.h b/externals/pio2/src/clib/pio_internal.h index 8a42dfa26015..40d7e12f4509 100644 --- a/externals/pio2/src/clib/pio_internal.h +++ b/externals/pio2/src/clib/pio_internal.h @@ -1,7 +1,19 @@ +/** + * @file + * Private headers and defines for the PIO C interface. + * @author Jim Edwards + * @date 2014 + * + * @see http://code.google.com/p/parallelio/ + */ + #ifndef __PIO_INTERNAL__ #define __PIO_INTERNAL__ + #include -// It seems that some versions of openmpi fail to define MPI_OFFSET + +/* It seems that some versions of openmpi fail to define + * MPI_OFFSET. */ #ifdef OMPI_OFFSET_DATATYPE #ifndef MPI_OFFSET #define MPI_OFFSET OMPI_OFFSET_DATATYPE @@ -17,17 +29,22 @@ #include #endif +#if PIO_ENABLE_LOGGING +void pio_log(int severity, const char *fmt, ...); +#define LOG(e) pio_log e +#else +#define LOG(e) +#endif /* PIO_ENABLE_LOGGING */ -#define max(a,b) \ - ({ __typeof__ (a) _a = (a); \ - __typeof__ (b) _b = (b); \ - _a > _b ? _a : _b; }) - -#define min(a,b) \ - ({ __typeof__ (a) _a = (a); \ - __typeof__ (b) _b = (b); \ - _a < _b ? _a : _b; }) +#define max(a,b) \ + ({ __typeof__ (a) _a = (a); \ + __typeof__ (b) _b = (b); \ + _a > _b ? _a : _b; }) +#define min(a,b) \ + ({ __typeof__ (a) _a = (a); \ + __typeof__ (b) _b = (b); \ + _a < _b ? _a : _b; }) #define MAX_GATHER_BLOCK_SIZE 0 #define PIO_REQUEST_ALLOC_CHUNK 16 @@ -36,121 +53,116 @@ extern "C" { #endif -extern PIO_Offset PIO_BUFFER_SIZE_LIMIT; -extern bool PIO_Save_Decomps; - - -/** - ** @brief Used to sort map points in the subset rearranger -*/ -typedef struct mapsort -{ - int rfrom; - PIO_Offset soffset; - PIO_Offset iomap; -} mapsort; - -/** - * @brief swapm defaults. - * -*/ -typedef struct pio_swapm_defaults -{ - int nreqs; - bool handshake; - bool isend; -} pio_swapm_defaults; - - - void pio_get_env(void); - int pio_add_to_iodesc_list(io_desc_t *iodesc); - io_desc_t *pio_get_iodesc_from_id(int ioid); - int pio_delete_iodesc_from_list(int ioid); - - file_desc_t *pio_get_file_from_id(int ncid); - int pio_delete_file_from_list(int ncid); - void pio_add_to_file_list(file_desc_t *file); - void pio_push_request(file_desc_t *file, int request); - - iosystem_desc_t *pio_get_iosystem_from_id(int iosysid); - int pio_add_to_iosystem_list(iosystem_desc_t *ios); - - int check_netcdf(file_desc_t *file,const int status, const char *fname, const int line); - int iotype_error(const int iotype, const char *fname, const int line); - void piodie(const char *msg,const char *fname, const int line); - void pioassert(bool exp, const char *msg,const char *fname, const int line); - int CalcStartandCount(const int basetype, const int ndims, const int *gdims, const int num_io_procs, - const int myiorank, PIO_Offset *start, PIO_Offset *kount); - void CheckMPIReturn(const int ierr,const char file[],const int line); - int pio_fc_gather( void *sendbuf, const int sendcnt, const MPI_Datatype sendtype, - void *recvbuf, const int recvcnt, const MPI_Datatype recvtype, const int root, - MPI_Comm comm, const int flow_cntl); - int pio_fc_gatherv( void *sendbuf, const int sendcnt, const MPI_Datatype sendtype, - void *recvbuf, const int recvcnts[], const int recvdispl[], const MPI_Datatype recvtype, const int root, - MPI_Comm comm, const int flow_cntl); - - int pio_fc_gatherv( void *sendbuf, const int sendcnt, const MPI_Datatype sendtype, - void *recvbuf, const int recvcnts[], const int rdispls[], const MPI_Datatype recvtype, const int root, - MPI_Comm comm, const int flow_cntl); - - int pio_swapm(void *sndbuf, int sndlths[], int sdispls[], MPI_Datatype stypes[], - void *rcvbuf, int rcvlths[], int rdispls[], MPI_Datatype rtypes[], - MPI_Comm comm, const bool handshake, bool isend, const int max_requests); - - long long lgcd_array(int nain, long long*ain); - - void PIO_Offset_size(MPI_Datatype *dtype, int *tsize); - PIO_Offset GCDblocksize(const int arrlen, const PIO_Offset arr_in[]); - - int subset_rearrange_create(const iosystem_desc_t ios,const int maplen, PIO_Offset compmap[], const int gsize[], - const int ndim, io_desc_t *iodesc); - - - int box_rearrange_create(const iosystem_desc_t ios,const int maplen, const PIO_Offset compmap[], const int gsize[], - const int ndim, io_desc_t *iodesc); - - - int rearrange_io2comp(const iosystem_desc_t ios, io_desc_t *iodesc, void *sbuf, - void *rbuf); - int rearrange_comp2io(const iosystem_desc_t ios, io_desc_t *iodesc, void *sbuf, - void *rbuf, const int nvars); - int calcdisplace(const int bsize, const int numblocks,const PIO_Offset map[],int displace[]); - io_desc_t *malloc_iodesc(const int piotype, const int ndims); - void performance_tune_rearranger(iosystem_desc_t ios, io_desc_t *iodesc); - - int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize); - void compute_maxIObuffersize(MPI_Comm io_comm, io_desc_t *iodesc); - io_region *alloc_region(const int ndims); - int pio_delete_iosystem_from_list(int piosysid); - int gcd(int a, int b); - long long lgcd (long long a,long long b ); - int gcd_array(int nain, int *ain); - void free_region_list(io_region *top); - void gindex_to_coord(const int ndims, const PIO_Offset gindex, const PIO_Offset gstride[], PIO_Offset *gcoord); - PIO_Offset coord_to_lindex(const int ndims, const PIO_Offset lcoord[], const PIO_Offset count[]); - - int ceil2(const int i); - int pair(const int np, const int p, const int k); - int define_iodesc_datatypes(const iosystem_desc_t ios, io_desc_t *iodesc); - - int create_mpi_datatypes(const MPI_Datatype basetype,const int msgcnt,const PIO_Offset dlen, - const PIO_Offset mindex[],const int mcount[],int *mfrom, MPI_Datatype mtype[]); - int compare_offsets(const void *a,const void *b) ; - - int subset_rearrange_create(const iosystem_desc_t ios, int maplen, PIO_Offset compmap[], - const int gsize[], const int ndims, io_desc_t *iodesc); - void print_trace (FILE *fp); - void cn_buffer_report(iosystem_desc_t ios, bool collective); - void compute_buffer_init(iosystem_desc_t ios); - void free_cn_buffer_pool(iosystem_desc_t ios); -void flush_buffer(int ncid, wmulti_buffer *wmb, bool flushtodisk); - void piomemerror(iosystem_desc_t ios, size_t req, char *fname, const int line); - void compute_maxaggregate_bytes(const iosystem_desc_t ios, io_desc_t *iodesc); + extern PIO_Offset PIO_BUFFER_SIZE_LIMIT; + extern bool PIO_Save_Decomps; + + /** Used to sort map points in the subset rearranger. */ + typedef struct mapsort + { + int rfrom; + PIO_Offset soffset; + PIO_Offset iomap; + } mapsort; + + /** swapm defaults. */ + typedef struct pio_swapm_defaults + { + int nreqs; + bool handshake; + bool isend; + } pio_swapm_defaults; + + void pio_get_env(void); + int pio_add_to_iodesc_list(io_desc_t *iodesc); + io_desc_t *pio_get_iodesc_from_id(int ioid); + int pio_delete_iodesc_from_list(int ioid); + + file_desc_t *pio_get_file_from_id(int ncid); + int pio_delete_file_from_list(int ncid); + void pio_add_to_file_list(file_desc_t *file); + void pio_push_request(file_desc_t *file, int request); + + iosystem_desc_t *pio_get_iosystem_from_id(int iosysid); + int pio_add_to_iosystem_list(iosystem_desc_t *ios); + + int check_netcdf(file_desc_t *file,const int status, const char *fname, const int line); + int iotype_error(const int iotype, const char *fname, const int line); + void piodie(const char *msg,const char *fname, const int line); + void pioassert(bool exp, const char *msg,const char *fname, const int line); + int CalcStartandCount(const int basetype, const int ndims, const int *gdims, const int num_io_procs, + const int myiorank, PIO_Offset *start, PIO_Offset *kount); + void CheckMPIReturn(const int ierr,const char file[],const int line); + int pio_fc_gather( void *sendbuf, const int sendcnt, const MPI_Datatype sendtype, + void *recvbuf, const int recvcnt, const MPI_Datatype recvtype, const int root, + MPI_Comm comm, const int flow_cntl); + int pio_fc_gatherv( void *sendbuf, const int sendcnt, const MPI_Datatype sendtype, + void *recvbuf, const int recvcnts[], const int recvdispl[], const MPI_Datatype recvtype, const int root, + MPI_Comm comm, const int flow_cntl); + + int pio_fc_gatherv( void *sendbuf, const int sendcnt, const MPI_Datatype sendtype, + void *recvbuf, const int recvcnts[], const int rdispls[], const MPI_Datatype recvtype, const int root, + MPI_Comm comm, const int flow_cntl); + + int pio_swapm(void *sndbuf, int sndlths[], int sdispls[], MPI_Datatype stypes[], + void *rcvbuf, int rcvlths[], int rdispls[], MPI_Datatype rtypes[], + MPI_Comm comm, const bool handshake, bool isend, const int max_requests); + + long long lgcd_array(int nain, long long*ain); + + void PIO_Offset_size(MPI_Datatype *dtype, int *tsize); + PIO_Offset GCDblocksize(const int arrlen, const PIO_Offset arr_in[]); + + int subset_rearrange_create(const iosystem_desc_t ios,const int maplen, PIO_Offset compmap[], const int gsize[], + const int ndim, io_desc_t *iodesc); + + + int box_rearrange_create(const iosystem_desc_t ios,const int maplen, const PIO_Offset compmap[], const int gsize[], + const int ndim, io_desc_t *iodesc); + + + int rearrange_io2comp(const iosystem_desc_t ios, io_desc_t *iodesc, void *sbuf, + void *rbuf); + int rearrange_comp2io(const iosystem_desc_t ios, io_desc_t *iodesc, void *sbuf, + void *rbuf, const int nvars); + int calcdisplace(const int bsize, const int numblocks,const PIO_Offset map[],int displace[]); + io_desc_t *malloc_iodesc(const int piotype, const int ndims); + void performance_tune_rearranger(iosystem_desc_t ios, io_desc_t *iodesc); + + int flush_output_buffer(file_desc_t *file, bool force, PIO_Offset addsize); + void compute_maxIObuffersize(MPI_Comm io_comm, io_desc_t *iodesc); + io_region *alloc_region(const int ndims); + int pio_delete_iosystem_from_list(int piosysid); + int gcd(int a, int b); + long long lgcd (long long a,long long b ); + int gcd_array(int nain, int *ain); + void free_region_list(io_region *top); + void gindex_to_coord(const int ndims, const PIO_Offset gindex, const PIO_Offset gstride[], PIO_Offset *gcoord); + PIO_Offset coord_to_lindex(const int ndims, const PIO_Offset lcoord[], const PIO_Offset count[]); + + int ceil2(const int i); + int pair(const int np, const int p, const int k); + int define_iodesc_datatypes(const iosystem_desc_t ios, io_desc_t *iodesc); + + int create_mpi_datatypes(const MPI_Datatype basetype,const int msgcnt,const PIO_Offset dlen, + const PIO_Offset mindex[],const int mcount[],int *mfrom, MPI_Datatype mtype[]); + int compare_offsets(const void *a,const void *b) ; + + int subset_rearrange_create(const iosystem_desc_t ios, int maplen, PIO_Offset compmap[], + const int gsize[], const int ndims, io_desc_t *iodesc); + void print_trace (FILE *fp); + void cn_buffer_report(iosystem_desc_t ios, bool collective); + void compute_buffer_init(iosystem_desc_t ios); + void free_cn_buffer_pool(iosystem_desc_t ios); + void flush_buffer(int ncid, wmulti_buffer *wmb, bool flushtodisk); + void piomemerror(iosystem_desc_t ios, size_t req, char *fname, const int line); + void compute_maxaggregate_bytes(const iosystem_desc_t ios, io_desc_t *iodesc); + int check_mpi(file_desc_t *file, const int mpierr, const char *filename, + const int line); #ifdef BGQ - void identity(MPI_Comm comm, int *iotask); - void determineiotasks(const MPI_Comm comm, int *numiotasks,int *base, int *stride, int *rearr, - bool *iamIOtask); + void identity(MPI_Comm comm, int *iotask); + void determineiotasks(const MPI_Comm comm, int *numiotasks,int *base, int *stride, int *rearr, + bool *iamIOtask); #endif @@ -158,214 +170,215 @@ void flush_buffer(int ncid, wmulti_buffer *wmb, bool flushtodisk); } #endif -enum PIO_MSG{ - PIO_MSG_OPEN_FILE, - PIO_MSG_CREATE_FILE, - PIO_MSG_INQ_ATT, - PIO_MSG_INQ_FORMAT, - PIO_MSG_INQ_VARID, - PIO_MSG_INQ_VARNATTS, - PIO_MSG_DEF_VAR, - PIO_MSG_INQ_VAR, - PIO_MSG_INQ_VARNAME, - PIO_MSG_PUT_ATT_DOUBLE, - PIO_MSG_PUT_ATT_INT, - PIO_MSG_RENAME_ATT, - PIO_MSG_DEL_ATT, - PIO_MSG_INQ_NATTS, - PIO_MSG_INQ, - PIO_MSG_GET_ATT_TEXT, - PIO_MSG_GET_ATT_SHORT, - PIO_MSG_PUT_ATT_LONG, - PIO_MSG_REDEF, - PIO_MSG_SET_FILL, - PIO_MSG_ENDDEF, - PIO_MSG_RENAME_VAR, - PIO_MSG_PUT_ATT_SHORT, - PIO_MSG_PUT_ATT_TEXT, - PIO_MSG_INQ_ATTNAME, - PIO_MSG_GET_ATT_ULONGLONG, - PIO_MSG_GET_ATT_USHORT, - PIO_MSG_PUT_ATT_ULONGLONG, - PIO_MSG_INQ_DIMLEN, - PIO_MSG_GET_ATT_UINT, - PIO_MSG_GET_ATT_LONGLONG, - PIO_MSG_PUT_ATT_SCHAR, - PIO_MSG_PUT_ATT_FLOAT, - PIO_MSG_INQ_NVARS, - PIO_MSG_RENAME_DIM, - PIO_MSG_INQ_VARNDIMS, - PIO_MSG_GET_ATT_LONG, - PIO_MSG_INQ_DIM, - PIO_MSG_INQ_DIMID, - PIO_MSG_INQ_UNLIMDIM, - PIO_MSG_INQ_VARDIMID, - PIO_MSG_INQ_ATTLEN, - PIO_MSG_INQ_DIMNAME, - PIO_MSG_PUT_ATT_USHORT, - PIO_MSG_GET_ATT_FLOAT, - PIO_MSG_SYNC, - PIO_MSG_PUT_ATT_LONGLONG, - PIO_MSG_PUT_ATT_UINT, - PIO_MSG_GET_ATT_SCHAR, - PIO_MSG_INQ_ATTID, - PIO_MSG_DEF_DIM, - PIO_MSG_INQ_NDIMS, - PIO_MSG_INQ_VARTYPE, - PIO_MSG_GET_ATT_INT, - PIO_MSG_GET_ATT_DOUBLE, - PIO_MSG_INQ_ATTTYPE, - PIO_MSG_PUT_ATT_UCHAR, - PIO_MSG_GET_ATT_UCHAR, - PIO_MSG_PUT_VARS_UCHAR, - PIO_MSG_GET_VAR1_SCHAR, - PIO_MSG_GET_VARS_ULONGLONG, - PIO_MSG_GET_VARM_UCHAR, - PIO_MSG_GET_VARM_SCHAR, - PIO_MSG_GET_VARS_SHORT, - PIO_MSG_GET_VAR_DOUBLE, - PIO_MSG_GET_VARA_DOUBLE, - PIO_MSG_GET_VAR_INT, - PIO_MSG_GET_VAR_USHORT, - PIO_MSG_PUT_VARS_USHORT, - PIO_MSG_GET_VARA_TEXT, - PIO_MSG_PUT_VARS_ULONGLONG, - PIO_MSG_GET_VARA_INT, - PIO_MSG_PUT_VARM, - PIO_MSG_GET_VAR1_FLOAT, - PIO_MSG_GET_VAR1_SHORT, - PIO_MSG_GET_VARS_INT, - PIO_MSG_PUT_VARS_UINT, - PIO_MSG_GET_VAR_TEXT, - PIO_MSG_GET_VARM_DOUBLE, - PIO_MSG_PUT_VARM_UCHAR, - PIO_MSG_PUT_VAR_USHORT, - PIO_MSG_GET_VARS_SCHAR, - PIO_MSG_GET_VARA_USHORT, - PIO_MSG_PUT_VAR1_LONGLONG, - PIO_MSG_PUT_VARA_UCHAR, - PIO_MSG_PUT_VARM_SHORT, - PIO_MSG_PUT_VAR1_LONG, - PIO_MSG_PUT_VARS_LONG, - PIO_MSG_GET_VAR1_USHORT, - PIO_MSG_PUT_VAR_SHORT, - PIO_MSG_PUT_VARA_INT, - PIO_MSG_GET_VAR_FLOAT, - PIO_MSG_PUT_VAR1_USHORT, - PIO_MSG_PUT_VARA_TEXT, - PIO_MSG_PUT_VARM_TEXT, - PIO_MSG_GET_VARS_UCHAR, - PIO_MSG_GET_VAR, - PIO_MSG_PUT_VARM_USHORT, - PIO_MSG_GET_VAR1_LONGLONG, - PIO_MSG_GET_VARS_USHORT, - PIO_MSG_GET_VAR_LONG, - PIO_MSG_GET_VAR1_DOUBLE, - PIO_MSG_PUT_VAR_ULONGLONG, - PIO_MSG_PUT_VAR_INT, - PIO_MSG_GET_VARA_UINT, - PIO_MSG_PUT_VAR_LONGLONG, - PIO_MSG_GET_VARS_LONGLONG, - PIO_MSG_PUT_VAR_SCHAR, - PIO_MSG_PUT_VAR_UINT, - PIO_MSG_PUT_VAR, - PIO_MSG_PUT_VARA_USHORT, - PIO_MSG_GET_VAR_LONGLONG, - PIO_MSG_GET_VARA_SHORT, - PIO_MSG_PUT_VARS_SHORT, - PIO_MSG_PUT_VARA_UINT, - PIO_MSG_PUT_VARA_SCHAR, - PIO_MSG_PUT_VARM_ULONGLONG, - PIO_MSG_PUT_VAR1_UCHAR, - PIO_MSG_PUT_VARM_INT, - PIO_MSG_PUT_VARS_SCHAR, - PIO_MSG_GET_VARA_LONG, - PIO_MSG_PUT_VAR1, - PIO_MSG_GET_VAR1_INT, - PIO_MSG_GET_VAR1_ULONGLONG, - PIO_MSG_GET_VAR_UCHAR, - PIO_MSG_PUT_VARA_FLOAT, - PIO_MSG_GET_VARA_UCHAR, - PIO_MSG_GET_VARS_FLOAT, - PIO_MSG_PUT_VAR1_FLOAT, - PIO_MSG_PUT_VARM_FLOAT, - PIO_MSG_PUT_VAR1_TEXT, - PIO_MSG_PUT_VARS_TEXT, - PIO_MSG_PUT_VARM_LONG, - PIO_MSG_GET_VARS_LONG, - PIO_MSG_PUT_VARS_DOUBLE, - PIO_MSG_GET_VAR1, - PIO_MSG_GET_VAR_UINT, - PIO_MSG_PUT_VARA_LONGLONG, - PIO_MSG_GET_VARA, - PIO_MSG_PUT_VAR_DOUBLE, - PIO_MSG_GET_VARA_SCHAR, - PIO_MSG_PUT_VAR_FLOAT, - PIO_MSG_GET_VAR1_UINT, - PIO_MSG_GET_VARS_UINT, - PIO_MSG_PUT_VAR1_ULONGLONG, - PIO_MSG_PUT_VARM_UINT, - PIO_MSG_PUT_VAR1_UINT, - PIO_MSG_PUT_VAR1_INT, - PIO_MSG_GET_VARA_FLOAT, - PIO_MSG_GET_VARM_TEXT, - PIO_MSG_PUT_VARS_FLOAT, - PIO_MSG_GET_VAR1_TEXT, - PIO_MSG_PUT_VARA_SHORT, - PIO_MSG_PUT_VAR1_SCHAR, - PIO_MSG_PUT_VARA_ULONGLONG, - PIO_MSG_PUT_VARM_DOUBLE, - PIO_MSG_GET_VARM_INT, - PIO_MSG_PUT_VARA, - PIO_MSG_PUT_VARA_LONG, - PIO_MSG_GET_VARM_UINT, - PIO_MSG_GET_VARM, - PIO_MSG_PUT_VAR1_DOUBLE, - PIO_MSG_GET_VARS_DOUBLE, - PIO_MSG_GET_VARA_LONGLONG, - PIO_MSG_GET_VAR_ULONGLONG, - PIO_MSG_PUT_VARM_SCHAR, - PIO_MSG_GET_VARA_ULONGLONG, - PIO_MSG_GET_VAR_SHORT, - PIO_MSG_GET_VARM_FLOAT, - PIO_MSG_PUT_VAR_TEXT, - PIO_MSG_PUT_VARS_INT, - PIO_MSG_GET_VAR1_LONG, - PIO_MSG_GET_VARM_LONG, - PIO_MSG_GET_VARM_USHORT, - PIO_MSG_PUT_VAR1_SHORT, - PIO_MSG_PUT_VARS_LONGLONG, - PIO_MSG_GET_VARM_LONGLONG, - PIO_MSG_GET_VARS_TEXT, - PIO_MSG_PUT_VARA_DOUBLE, - PIO_MSG_PUT_VARS, - PIO_MSG_PUT_VAR_UCHAR, - PIO_MSG_GET_VAR1_UCHAR, - PIO_MSG_PUT_VAR_LONG, - PIO_MSG_GET_VARS, - PIO_MSG_GET_VARM_SHORT, - PIO_MSG_GET_VARM_ULONGLONG, - PIO_MSG_PUT_VARM_LONGLONG, - PIO_MSG_GET_VAR_SCHAR, - PIO_MSG_GET_ATT_UBYTE, - PIO_MSG_PUT_ATT_STRING, - PIO_MSG_GET_ATT_STRING, - PIO_MSG_PUT_ATT_UBYTE, - PIO_MSG_INQ_VAR_FILL, - PIO_MSG_DEF_VAR_FILL, - PIO_MSG_DEF_VAR_DEFLATE, - PIO_MSG_INQ_VAR_DEFLATE, - PIO_MSG_INQ_VAR_SZIP, - PIO_MSG_DEF_VAR_FLETCHER32, - PIO_MSG_INQ_VAR_FLETCHER32, - PIO_MSG_DEF_VAR_CHUNKING, - PIO_MSG_INQ_VAR_CHUNKING, - PIO_MSG_DEF_VAR_ENDIAN, - PIO_MSG_INQ_VAR_ENDIAN, - PIO_MSG_SET_CHUNK_CACHE, - PIO_MSG_GET_CHUNK_CACHE, - PIO_MSG_SET_VAR_CHUNK_CACHE, - PIO_MSG_GET_VAR_CHUNK_CACHE +/** These are the messages that can be sent over the intercomm when + * async is being used. */ +enum PIO_MSG +{ + PIO_MSG_OPEN_FILE, + PIO_MSG_CREATE_FILE, + PIO_MSG_INQ_ATT, + PIO_MSG_INQ_FORMAT, + PIO_MSG_INQ_VARID, + PIO_MSG_DEF_VAR, + PIO_MSG_INQ_VAR, + PIO_MSG_PUT_ATT_DOUBLE, + PIO_MSG_PUT_ATT_INT, + PIO_MSG_RENAME_ATT, + PIO_MSG_DEL_ATT, + PIO_MSG_INQ, + PIO_MSG_GET_ATT_TEXT, + PIO_MSG_GET_ATT_SHORT, + PIO_MSG_PUT_ATT_LONG, + PIO_MSG_REDEF, + PIO_MSG_SET_FILL, + PIO_MSG_ENDDEF, + PIO_MSG_RENAME_VAR, + PIO_MSG_PUT_ATT_SHORT, + PIO_MSG_PUT_ATT_TEXT, + PIO_MSG_INQ_ATTNAME, + PIO_MSG_GET_ATT_ULONGLONG, + PIO_MSG_GET_ATT_USHORT, + PIO_MSG_PUT_ATT_ULONGLONG, + PIO_MSG_GET_ATT_UINT, + PIO_MSG_GET_ATT_LONGLONG, + PIO_MSG_PUT_ATT_SCHAR, + PIO_MSG_PUT_ATT_FLOAT, + PIO_MSG_RENAME_DIM, + PIO_MSG_GET_ATT_LONG, + PIO_MSG_INQ_DIM, + PIO_MSG_INQ_DIMID, + PIO_MSG_PUT_ATT_USHORT, + PIO_MSG_GET_ATT_FLOAT, + PIO_MSG_SYNC, + PIO_MSG_PUT_ATT_LONGLONG, + PIO_MSG_PUT_ATT_UINT, + PIO_MSG_GET_ATT_SCHAR, + PIO_MSG_INQ_ATTID, + PIO_MSG_DEF_DIM, + PIO_MSG_GET_ATT_INT, + PIO_MSG_GET_ATT_DOUBLE, + PIO_MSG_PUT_ATT_UCHAR, + PIO_MSG_GET_ATT_UCHAR, + PIO_MSG_PUT_VARS_UCHAR, + PIO_MSG_GET_VAR1_SCHAR, + PIO_MSG_GET_VARS_ULONGLONG, + PIO_MSG_GET_VARM_UCHAR, + PIO_MSG_GET_VARM_SCHAR, + PIO_MSG_GET_VARS_SHORT, + PIO_MSG_GET_VAR_DOUBLE, + PIO_MSG_GET_VARA_DOUBLE, + PIO_MSG_GET_VAR_INT, + PIO_MSG_GET_VAR_USHORT, + PIO_MSG_PUT_VARS_USHORT, + PIO_MSG_GET_VARA_TEXT, + PIO_MSG_PUT_VARS_ULONGLONG, + PIO_MSG_GET_VARA_INT, + PIO_MSG_PUT_VARM, + PIO_MSG_GET_VAR1_FLOAT, + PIO_MSG_GET_VAR1_SHORT, + PIO_MSG_GET_VARS_INT, + PIO_MSG_PUT_VARS_UINT, + PIO_MSG_GET_VAR_TEXT, + PIO_MSG_GET_VARM_DOUBLE, + PIO_MSG_PUT_VARM_UCHAR, + PIO_MSG_PUT_VAR_USHORT, + PIO_MSG_GET_VARS_SCHAR, + PIO_MSG_GET_VARA_USHORT, + PIO_MSG_PUT_VAR1_LONGLONG, + PIO_MSG_PUT_VARA_UCHAR, + PIO_MSG_PUT_VARM_SHORT, + PIO_MSG_PUT_VAR1_LONG, + PIO_MSG_PUT_VARS_LONG, + PIO_MSG_GET_VAR1_USHORT, + PIO_MSG_PUT_VAR_SHORT, + PIO_MSG_PUT_VARA_INT, + PIO_MSG_GET_VAR_FLOAT, + PIO_MSG_PUT_VAR1_USHORT, + PIO_MSG_PUT_VARA_TEXT, + PIO_MSG_PUT_VARM_TEXT, + PIO_MSG_GET_VARS_UCHAR, + PIO_MSG_GET_VAR, + PIO_MSG_PUT_VARM_USHORT, + PIO_MSG_GET_VAR1_LONGLONG, + PIO_MSG_GET_VARS_USHORT, + PIO_MSG_GET_VAR_LONG, + PIO_MSG_GET_VAR1_DOUBLE, + PIO_MSG_PUT_VAR_ULONGLONG, + PIO_MSG_PUT_VAR_INT, + PIO_MSG_GET_VARA_UINT, + PIO_MSG_PUT_VAR_LONGLONG, + PIO_MSG_GET_VARS_LONGLONG, + PIO_MSG_PUT_VAR_SCHAR, + PIO_MSG_PUT_VAR_UINT, + PIO_MSG_PUT_VAR, + PIO_MSG_PUT_VARA_USHORT, + PIO_MSG_GET_VAR_LONGLONG, + PIO_MSG_GET_VARA_SHORT, + PIO_MSG_PUT_VARS_SHORT, + PIO_MSG_PUT_VARA_UINT, + PIO_MSG_PUT_VARA_SCHAR, + PIO_MSG_PUT_VARM_ULONGLONG, + PIO_MSG_PUT_VAR1_UCHAR, + PIO_MSG_PUT_VARM_INT, + PIO_MSG_PUT_VARS_SCHAR, + PIO_MSG_GET_VARA_LONG, + PIO_MSG_PUT_VAR1, + PIO_MSG_GET_VAR1_INT, + PIO_MSG_GET_VAR1_ULONGLONG, + PIO_MSG_GET_VAR_UCHAR, + PIO_MSG_PUT_VARA_FLOAT, + PIO_MSG_GET_VARA_UCHAR, + PIO_MSG_GET_VARS_FLOAT, + PIO_MSG_PUT_VAR1_FLOAT, + PIO_MSG_PUT_VARM_FLOAT, + PIO_MSG_PUT_VAR1_TEXT, + PIO_MSG_PUT_VARS_TEXT, + PIO_MSG_PUT_VARM_LONG, + PIO_MSG_GET_VARS_LONG, + PIO_MSG_PUT_VARS_DOUBLE, + PIO_MSG_GET_VAR1, + PIO_MSG_GET_VAR_UINT, + PIO_MSG_PUT_VARA_LONGLONG, + PIO_MSG_GET_VARA, + PIO_MSG_PUT_VAR_DOUBLE, + PIO_MSG_GET_VARA_SCHAR, + PIO_MSG_PUT_VAR_FLOAT, + PIO_MSG_GET_VAR1_UINT, + PIO_MSG_GET_VARS_UINT, + PIO_MSG_PUT_VAR1_ULONGLONG, + PIO_MSG_PUT_VARM_UINT, + PIO_MSG_PUT_VAR1_UINT, + PIO_MSG_PUT_VAR1_INT, + PIO_MSG_GET_VARA_FLOAT, + PIO_MSG_GET_VARM_TEXT, + PIO_MSG_PUT_VARS_FLOAT, + PIO_MSG_GET_VAR1_TEXT, + PIO_MSG_PUT_VARA_SHORT, + PIO_MSG_PUT_VAR1_SCHAR, + PIO_MSG_PUT_VARA_ULONGLONG, + PIO_MSG_PUT_VARM_DOUBLE, + PIO_MSG_GET_VARM_INT, + PIO_MSG_PUT_VARA, + PIO_MSG_PUT_VARA_LONG, + PIO_MSG_GET_VARM_UINT, + PIO_MSG_GET_VARM, + PIO_MSG_PUT_VAR1_DOUBLE, + PIO_MSG_GET_VARS_DOUBLE, + PIO_MSG_GET_VARA_LONGLONG, + PIO_MSG_GET_VAR_ULONGLONG, + PIO_MSG_PUT_VARM_SCHAR, + PIO_MSG_GET_VARA_ULONGLONG, + PIO_MSG_GET_VAR_SHORT, + PIO_MSG_GET_VARM_FLOAT, + PIO_MSG_PUT_VAR_TEXT, + PIO_MSG_PUT_VARS_INT, + PIO_MSG_GET_VAR1_LONG, + PIO_MSG_GET_VARM_LONG, + PIO_MSG_GET_VARM_USHORT, + PIO_MSG_PUT_VAR1_SHORT, + PIO_MSG_PUT_VARS_LONGLONG, + PIO_MSG_GET_VARM_LONGLONG, + PIO_MSG_GET_VARS_TEXT, + PIO_MSG_PUT_VARA_DOUBLE, + PIO_MSG_PUT_VARS, + PIO_MSG_PUT_VAR_UCHAR, + PIO_MSG_GET_VAR1_UCHAR, + PIO_MSG_PUT_VAR_LONG, + PIO_MSG_GET_VARS, + PIO_MSG_GET_VARM_SHORT, + PIO_MSG_GET_VARM_ULONGLONG, + PIO_MSG_PUT_VARM_LONGLONG, + PIO_MSG_GET_VAR_SCHAR, + PIO_MSG_GET_ATT_UBYTE, + PIO_MSG_PUT_ATT_STRING, + PIO_MSG_GET_ATT_STRING, + PIO_MSG_PUT_ATT_UBYTE, + PIO_MSG_INQ_VAR_FILL, + PIO_MSG_DEF_VAR_FILL, + PIO_MSG_DEF_VAR_DEFLATE, + PIO_MSG_INQ_VAR_DEFLATE, + PIO_MSG_INQ_VAR_SZIP, + PIO_MSG_DEF_VAR_FLETCHER32, + PIO_MSG_INQ_VAR_FLETCHER32, + PIO_MSG_DEF_VAR_CHUNKING, + PIO_MSG_INQ_VAR_CHUNKING, + PIO_MSG_DEF_VAR_ENDIAN, + PIO_MSG_INQ_VAR_ENDIAN, + PIO_MSG_SET_CHUNK_CACHE, + PIO_MSG_GET_CHUNK_CACHE, + PIO_MSG_SET_VAR_CHUNK_CACHE, + PIO_MSG_GET_VAR_CHUNK_CACHE, + PIO_MSG_INITDECOMP_DOF, + PIO_MSG_WRITEDARRAY, + PIO_MSG_READDARRAY, + PIO_MSG_SETERRORHANDLING, + PIO_MSG_FREEDECOMP, + PIO_MSG_CLOSE_FILE, + PIO_MSG_DELETE_FILE, + PIO_MSG_EXIT, + PIO_MSG_GET_ATT, + PIO_MSG_PUT_ATT, + PIO_MSG_INQ_TYPE }; -#endif +#endif /* __PIO_INTERNAL__ */ diff --git a/externals/pio2/src/clib/pio_lists.c b/externals/pio2/src/clib/pio_lists.c index e69a944bb20c..efa0868c4441 100644 --- a/externals/pio2/src/clib/pio_lists.c +++ b/externals/pio2/src/clib/pio_lists.c @@ -9,38 +9,35 @@ static iosystem_desc_t *pio_iosystem_list=NULL; static file_desc_t *pio_file_list = NULL; static file_desc_t *current_file=NULL; +/** Add a new entry to the global list of open files. + * + * @param file pointer to the file_desc_t struct for the new file. +*/ void pio_add_to_file_list(file_desc_t *file) { file_desc_t *cfile; - int cnt=-1; - // on iotasks the fh returned from netcdf should be unique, on non-iotasks we - // need to generate a unique fh, we do this with cnt, its a negative index + /* This file will be at the end of the list, and have no next. */ file->next = NULL; - cfile = pio_file_list; - current_file = file; - if(cfile==NULL){ - pio_file_list = file; - }else{ - cnt = min(cnt,cfile->fh-1); - while(cfile->next != NULL) - { - cfile=cfile->next; - cnt = min(cnt,cfile->fh-1); - } - cfile->next = file; - } - if(! file->iosystem->ioproc || ((file->iotype != PIO_IOTYPE_PNETCDF && - file->iotype != PIO_IOTYPE_NETCDF4P) && - file->iosystem->io_rank>0)) - file->fh = cnt; + /* Get a pointer to the global list of files. */ cfile = pio_file_list; -} - - + /* Keep a global pointer to the current file. */ + current_file = file; + /* If there is nothing in the list, then file will be the first + * entry. Otherwise, move to end of the list. */ + if (!cfile) + pio_file_list = file; + else + { + while (cfile->next) + cfile = cfile->next; + cfile->next = file; + } +} + file_desc_t *pio_get_file_from_id(int ncid) { file_desc_t *cfile; @@ -61,7 +58,7 @@ file_desc_t *pio_get_file_from_id(int ncid) } return cfile; } - + int pio_delete_file_from_list(int ncid) { @@ -78,7 +75,7 @@ int pio_delete_file_from_list(int ncid) } if(current_file==cfile) current_file=pfile; - free(cfile); + free(cfile); return PIO_NOERR; } pfile = cfile; @@ -148,7 +145,7 @@ iosystem_desc_t *pio_get_iosystem_from_id(int iosysid) ciosystem = ciosystem->next; } return NULL; - + } int pio_add_to_iodesc_list(io_desc_t *iodesc) @@ -170,7 +167,7 @@ int pio_add_to_iodesc_list(io_desc_t *iodesc) return iodesc->ioid; } - + io_desc_t *pio_get_iodesc_from_id(int ioid) { io_desc_t *ciodesc; @@ -195,7 +192,7 @@ io_desc_t *pio_get_iodesc_from_id(int ioid) return ciodesc; } - + int pio_delete_iodesc_from_list(int ioid) { diff --git a/externals/pio2/src/clib/pio_msg.c b/externals/pio2/src/clib/pio_msg.c new file mode 100644 index 000000000000..e6220d850cde --- /dev/null +++ b/externals/pio2/src/clib/pio_msg.c @@ -0,0 +1,2119 @@ +/** + * @file + * @author Ed Hartnett + * @date 2016 + * @brief PIO async msg handling + * + * @see http://code.google.com/p/parallelio/ + */ + +#include +#include +#include + +/* MPI serial builds stub out MPI functions so that the MPI code can + * work on one processor. This function is missing from our serial MPI + * implementation, so it is included here. This can be removed after + * it is added to the MPI serial library. */ +/* #ifdef USE_MPI_SERIAL */ +/* int MPI_Intercomm_merge(MPI_Comm intercomm, int high, MPI_Comm *newintracomm) */ +/* { */ +/* return MPI_SUCCESS; */ +/* } */ +/* #endif /\* USE_MPI_SERIAL *\/ */ + +#ifdef PIO_ENABLE_LOGGING +extern int my_rank; +extern int pio_log_level; +#endif /* PIO_ENABLE_LOGGING */ + +/** This function is run on the IO tasks to find netCDF type + * length. */ +int inq_type_handler(iosystem_desc_t *ios) +{ + int ncid; + int xtype; + char name_present, size_present; + char *namep = NULL, name[NC_MAX_NAME + 1]; + PIO_Offset *sizep = NULL, size; + int mpierr; + int ret; + + LOG((1, "inq_type_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&xtype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&size_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + + /* Handle null pointer issues. */ + if (name_present) + namep = name; + if (size_present) + sizep = &size; + + /* Call the function. */ + if ((ret = PIOc_inq_type(ncid, xtype, namep, sizep))) + return ret; + + LOG((1, "inq_type_handler succeeded!")); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to find netCDF file + * format. */ +int inq_format_handler(iosystem_desc_t *ios) +{ + int ncid; + int *formatp = NULL, format; + char format_present; + int mpierr; + int ret; + + LOG((1, "inq_format_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&format_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "inq_format_handler got parameters ncid = %d format_present = %d", + ncid, format_present)); + + /* Manage NULL pointers. */ + if (format_present) + formatp = &format; + + /* Call the function. */ + if ((ret = PIOc_inq_format(ncid, formatp))) + return ret; + + if (formatp) + LOG((2, "inq_format_handler format = %d", *formatp)); + LOG((1, "inq_format_handler succeeded!")); + + return PIO_NOERR; +} + +/** This function is run on the IO tasks to create a netCDF file. */ +int create_file_handler(iosystem_desc_t *ios) +{ + int ncid; + int len; + int iotype; + char *filename; + int mode; + int mpierr; + int ret; + + LOG((1, "create_file_handler comproot = %d\n", ios->comproot)); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&len, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "create_file_handler got parameter len = %d\n", len)); + if (!(filename = malloc(len + 1 * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)filename, len + 1, MPI_CHAR, 0, + ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&iotype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&mode, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "create_file_handler got parameters len = %d " + "filename = %s iotype = %d mode = %d\n", + len, filename, iotype, mode)); + + /* Call the create file function. */ + if ((ret = PIOc_createfile(ios->iosysid, &ncid, &iotype, filename, mode))) + return ret; + + /* Free resources. */ + free(filename); + + LOG((1, "create_file_handler succeeded!")); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to close a netCDF file. It is + * only ever run on the IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int close_file_handler(iosystem_desc_t *ios) +{ + int ncid; + int mpierr; + int ret; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d close_file_handler\n", my_rank)); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "%d create_file_handler got parameter ncid = %d\n", ncid)); + + /* Call the close file function. */ + if ((ret = PIOc_closefile(ncid))) + return ret; + + LOG((1, "close_file_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to inq a netCDF file. It is + * only ever run on the IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_handler(iosystem_desc_t *ios) +{ + int ncid; + int ndims, nvars, ngatts, unlimdimid; + int *ndimsp = NULL, *nvarsp = NULL, *ngattsp = NULL, *unlimdimidp = NULL; + char ndims_present, nvars_present, ngatts_present, unlimdimid_present; + int mpierr; + int ret; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d inq_handler\n", my_rank)); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&ndims_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&nvars_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&ngatts_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&unlimdimid_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "%d inq_handler ndims_present = %d nvars_present = %d ngatts_present = %d unlimdimid_present = %d\n", + ndims_present, nvars_present, ngatts_present, unlimdimid_present)); + + /* NULLs passed in to any of the pointers in the original call + * need to be matched with NULLs here. Assign pointers where + * non-NULL pointers were passed in. */ + if (ndims_present) + ndimsp = &ndims; + if (nvars_present) + nvarsp = &nvars; + if (ngatts_present) + ngattsp = &ngatts; + if (unlimdimid_present) + unlimdimidp = &unlimdimid; + + /* Call the inq function to get the values. */ + if ((ret = PIOc_inq(ncid, ndimsp, nvarsp, ngattsp, unlimdimidp))) + return ret; + + return PIO_NOERR; +} + +/** Do an inq_dim on a netCDF dimension. This function is only run on + * IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_dim_handler(iosystem_desc_t *ios, int msg) +{ + int ncid; + int dimid; + char name_present, len_present; + char *dimnamep = NULL; + PIO_Offset *dimlenp = NULL; + char dimname[NC_MAX_NAME + 1]; + PIO_Offset dimlen; + + int mpierr; + int ret; + + LOG((1, "inq_dim_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&dimid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&len_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "inq_handler name_present = %d len_present = %d", name_present, + len_present)); + + /* Set the non-null pointers. */ + if (name_present) + dimnamep = dimname; + if (len_present) + dimlenp = &dimlen; + + /* Call the inq function to get the values. */ + if ((ret = PIOc_inq_dim(ncid, dimid, dimnamep, dimlenp))) + return ret; + + return PIO_NOERR; +} + +/** Do an inq_dimid on a netCDF dimension name. This function is only + * run on IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_dimid_handler(iosystem_desc_t *ios) +{ + int ncid; + int *dimidp = NULL, dimid; + int mpierr; + int id_present; + int ret; + int namelen; + char *name; + + LOG((1, "inq_dimid_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&id_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "inq_dimid_handler ncid = %d namelen = %d name = %s id_present = %d", + ncid, namelen, name, id_present)); + + /* Set non-null pointer. */ + if (id_present) + dimidp = &dimid; + + /* Call the inq_dimid function. */ + if ((ret = PIOc_inq_dimid(ncid, name, dimidp))) + return ret; + + /* Free resources. */ + free(name); + + return PIO_NOERR; +} + +/** Handle attribute inquiry operations. This code only runs on IO + * tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_att_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + int ret; + char *name5; + int namelen; + int *op, *ip; + nc_type xtype, *xtypep = NULL; + PIO_Offset len, *lenp = NULL; + char xtype_present, len_present; + + LOG((1, "inq_att_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm))) + return PIO_EIO; + if (!(name5 = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name5, namelen + 1, MPI_CHAR, ios->compmaster, + ios->intercomm))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast(&xtype_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&len_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + + /* Match NULLs in collective function call. */ + if (xtype_present) + xtypep = &xtype; + if (len_present) + lenp = &len; + + /* Call the function to learn about the attribute. */ + if ((ret = PIOc_inq_att(ncid, varid, name5, xtypep, lenp))) + return ret; + + return PIO_NOERR; +} + +/** Handle attribute inquiry operations. This code only runs on IO + * tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_attname_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int attnum; + char name[NC_MAX_NAME + 1], *namep = NULL; + char name_present; + int mpierr; + int ret; + + LOG((1, "inq_att_name_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&attnum, 1, MPI_INT, ios->compmaster, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "inq_attname_handler got ncid = %d varid = %d attnum = %d name_present = %d", + ncid, varid, attnum, name_present)); + + /* Match NULLs in collective function call. */ + if (name_present) + namep = name; + + /* Call the function to learn about the attribute. */ + if ((ret = PIOc_inq_attname(ncid, varid, attnum, namep))) + return ret; + + return PIO_NOERR; +} + +/** Handle attribute inquiry operations. This code only runs on IO + * tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_attid_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int attnum; + char *name; + int namelen; + int id, *idp = NULL; + char id_present; + int mpierr; + int ret; + + LOG((1, "inq_attid_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast(name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&id_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "inq_attid_handler got ncid = %d varid = %d attnum = %d id_present = %d", + ncid, varid, attnum, id_present)); + + /* Match NULLs in collective function call. */ + if (id_present) + idp = &id; + + /* Call the function to learn about the attribute. */ + if ((ret = PIOc_inq_attid(ncid, varid, name, idp))) + return ret; + + /* Free resources. */ + free(name); + + return PIO_NOERR; +} + +/** Handle attribute operations. This code only runs on IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int att_put_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + int ierr; + char *name; + int namelen; + PIO_Offset attlen, typelen; + nc_type atttype; + int *op, *ip; + int iotype; + + LOG((1, "att_put_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, + ios->intercomm); + if ((mpierr = MPI_Bcast(&atttype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&attlen, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if (!(op = malloc(attlen * typelen))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)op, attlen * typelen, MPI_BYTE, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "att_put_handler ncid = %d varid = %d namelen = %d name = %s iotype = %d" + "atttype = %d attlen = %d typelen = %d", + ncid, varid, namelen, name, iotype, atttype, attlen, typelen)); + + /* Call the function to read the attribute. */ + if ((ierr = PIOc_put_att(ncid, varid, name, atttype, attlen, op))) + return ierr; + LOG((2, "put_handler called PIOc_put_att, ierr = %d", ierr)); + + /* Free resources. */ + free(name); + free(op); + + LOG((2, "put_handler complete!")); + return PIO_NOERR; +} + +/** Handle attribute operations. This code only runs on IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int att_get_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + int ierr; + char *name; + int namelen; + PIO_Offset attlen, typelen; + nc_type atttype; + int *op, *ip; + int iotype; + + LOG((1, "att_get_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, + ios->intercomm); + if ((mpierr = MPI_Bcast(&iotype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&atttype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&attlen, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "att_get_handler ncid = %d varid = %d namelen = %d name = %s iotype = %d" + "atttype = %d attlen = %d typelen = %d", + ncid, varid, namelen, name, iotype, atttype, attlen, typelen)); + + /* Allocate space for the attribute data. */ + if (!(ip = malloc(attlen * typelen))) + return PIO_ENOMEM; + + /* Call the function to read the attribute. */ + if ((ierr = PIOc_get_att(ncid, varid, name, ip))) + return ierr; + + /* Free resources. */ + free(name); + free(ip); + + return PIO_NOERR; +} + +/** Handle var put operations. This code only runs on IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int put_vars_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + int ierr; + char *name; + int namelen; + PIO_Offset typelen; /** Length (in bytes) of this type. */ + nc_type xtype; /** Type of the data being written. */ + char start_present, count_present, stride_present; + PIO_Offset *startp = NULL, *countp = NULL, *stridep = NULL; + int ndims; /** Number of dimensions. */ + void *buf; /** Buffer for data storage. */ + PIO_Offset num_elem; /** Number of data elements in the buffer. */ + + LOG((1, "put_vars_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&ndims, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + + /* Now we know how big to make these arrays. */ + PIO_Offset start[ndims], count[ndims], stride[ndims]; + + if ((mpierr = MPI_Bcast(&start_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if (!mpierr && start_present) + { + if ((mpierr = MPI_Bcast(start, ndims, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "put_vars_handler getting start[0] = %d ndims = %d", start[0], ndims)); + } + if ((mpierr = MPI_Bcast(&count_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if (!mpierr && count_present) + if ((mpierr = MPI_Bcast(count, ndims, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&stride_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if (!mpierr && stride_present) + if ((mpierr = MPI_Bcast(stride, ndims, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&xtype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&num_elem, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "put_vars_handler ncid = %d varid = %d ndims = %d start_present = %d " + "count_present = %d stride_present = %d xtype = %d num_elem = %d typelen = %d", + ncid, varid, ndims, start_present, count_present, stride_present, xtype, + num_elem, typelen)); + + for (int d = 0; d < ndims; d++) + { + if (start_present) + LOG((2, "start[%d] = %d\n", d, start[d])); + if (count_present) + LOG((2, "count[%d] = %d\n", d, count[d])); + if (stride_present) + LOG((2, "stride[%d] = %d\n", d, stride[d])); + } + + /* Allocate room for our data. */ + if (!(buf = malloc(num_elem * typelen))) + return PIO_ENOMEM; + + /* Get the data. */ + if ((mpierr = MPI_Bcast(buf, num_elem * typelen, MPI_BYTE, 0, ios->intercomm))) + return PIO_EIO; + + /* for (int e = 0; e < num_elem; e++) */ + /* LOG((2, "element %d = %d", e, ((int *)buf)[e])); */ + + /* Set the non-NULL pointers. */ + if (start_present) + startp = start; + if (count_present) + countp = count; + if (stride_present) + stridep = stride; + + /* Call the function to write the data. */ + switch(xtype) + { + case NC_BYTE: + ierr = PIOc_put_vars_schar(ncid, varid, startp, countp, stridep, buf); + break; + case NC_CHAR: + ierr = PIOc_put_vars_schar(ncid, varid, startp, countp, stridep, buf); + break; + case NC_SHORT: + ierr = PIOc_put_vars_short(ncid, varid, startp, countp, stridep, buf); + break; + case NC_INT: + ierr = PIOc_put_vars_int(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_FLOAT: + ierr = PIOc_put_vars_float(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_DOUBLE: + ierr = PIOc_put_vars_double(ncid, varid, startp, countp, + stridep, buf); + break; +#ifdef _NETCDF4 + case NC_UBYTE: + ierr = PIOc_put_vars_uchar(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_USHORT: + ierr = PIOc_put_vars_ushort(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_UINT: + ierr = PIOc_put_vars_uint(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_INT64: + ierr = PIOc_put_vars_longlong(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_UINT64: + ierr = PIOc_put_vars_ulonglong(ncid, varid, startp, countp, + stridep, buf); + break; + /* case NC_STRING: */ + /* ierr = PIOc_put_vars_string(ncid, varid, startp, countp, */ + /* stridep, (void *)buf); */ + /* break; */ + /* default:*/ + /* ierr = PIOc_put_vars(ncid, varid, startp, countp, */ + /* stridep, buf); */ +#endif /* _NETCDF4 */ + } + + return PIO_NOERR; +} + +/** Handle var get operations. This code only runs on IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int get_vars_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + int ierr; + char *name; + int namelen; + PIO_Offset typelen; /** Length (in bytes) of this type. */ + nc_type xtype; /** Type of the data being written. */ + char start_present, count_present, stride_present; + PIO_Offset *startp = NULL, *countp = NULL, *stridep = NULL; + int ndims; /** Number of dimensions. */ + void *buf; /** Buffer for data storage. */ + PIO_Offset num_elem; /** Number of data elements in the buffer. */ + + LOG((1, "get_vars_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&ndims, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + + /* Now we know how big to make these arrays. */ + PIO_Offset start[ndims], count[ndims], stride[ndims]; + + if ((mpierr = MPI_Bcast(&start_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if (!mpierr && start_present) + { + if ((mpierr = MPI_Bcast(start, ndims, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "put_vars_handler getting start[0] = %d ndims = %d", start[0], ndims)); + } + if ((mpierr = MPI_Bcast(&count_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if (!mpierr && count_present) + if ((mpierr = MPI_Bcast(count, ndims, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&stride_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if (!mpierr && stride_present) + if ((mpierr = MPI_Bcast(stride, ndims, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&xtype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&num_elem, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "get_vars_handler ncid = %d varid = %d ndims = %d start_present = %d " + "count_present = %d stride_present = %d xtype = %d num_elem = %d typelen = %d", + ncid, varid, ndims, start_present, count_present, stride_present, xtype, + num_elem, typelen)); + + for (int d = 0; d < ndims; d++) + { + if (start_present) + LOG((2, "start[%d] = %d\n", d, start[d])); + if (count_present) + LOG((2, "count[%d] = %d\n", d, count[d])); + if (stride_present) + LOG((2, "stride[%d] = %d\n", d, stride[d])); + } + + /* Allocate room for our data. */ + if (!(buf = malloc(num_elem * typelen))) + return PIO_ENOMEM; + + /* Set the non-NULL pointers. */ + if (start_present) + startp = start; + if (count_present) + countp = count; + if (stride_present) + stridep = stride; + + /* Call the function to read the data. */ + switch(xtype) + { + case NC_BYTE: + ierr = PIOc_get_vars_schar(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_CHAR: + ierr = PIOc_get_vars_schar(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_SHORT: + ierr = PIOc_get_vars_short(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_INT: + ierr = PIOc_get_vars_int(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_FLOAT: + ierr = PIOc_get_vars_float(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_DOUBLE: + ierr = PIOc_get_vars_double(ncid, varid, startp, countp, + stridep, buf); + break; +#ifdef _NETCDF4 + case NC_UBYTE: + ierr = PIOc_get_vars_uchar(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_USHORT: + ierr = PIOc_get_vars_ushort(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_UINT: + ierr = PIOc_get_vars_uint(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_INT64: + ierr = PIOc_get_vars_longlong(ncid, varid, startp, countp, + stridep, buf); + break; + case NC_UINT64: + ierr = PIOc_get_vars_ulonglong(ncid, varid, startp, countp, + stridep, buf); + break; + /* case NC_STRING: */ + /* ierr = PIOc_get_vars_string(ncid, varid, startp, countp, */ + /* stridep, (void *)buf); */ + /* break; */ + /* default:*/ + /* ierr = PIOc_get_vars(ncid, varid, startp, countp, */ + /* stridep, buf); */ +#endif /* _NETCDF4 */ + } + + LOG((1, "get_vars_handler succeeded!")); + return PIO_NOERR; +} + +/** Do an inq_var on a netCDF variable. This function is only run on + * IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @param msg the message sent my the comp root task. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_var_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + char name_present, xtype_present, ndims_present, dimids_present, natts_present; + char name[NC_MAX_NAME + 1], *namep; + nc_type xtype, *xtypep = NULL; + int *ndimsp = NULL, *dimidsp = NULL, *nattsp = NULL; + int ndims, dimids[NC_MAX_DIMS], natts; + int ret; + + LOG((1, "inq_var_handler")); + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&xtype_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&ndims_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&dimids_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&natts_present, 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2,"inq_var_handler ncid = %d varid = %d name_present = %d xtype_present = %d ndims_present = %d " + "dimids_present = %d natts_present = %d\n", + ncid, varid, name_present, xtype_present, ndims_present, dimids_present, natts_present)); + + /* Set the non-NULL pointers. */ + if (name_present) + namep = name; + if (xtype_present) + xtypep = &xtype; + if (ndims_present) + ndimsp = &ndims; + if (dimids_present) + dimidsp = dimids; + if (natts_present) + nattsp = &natts; + + /* Call the inq function to get the values. */ + if ((ret = PIOc_inq_var(ncid, varid, namep, xtypep, ndimsp, dimidsp, nattsp))) + return ret; + + if (ndims_present) + LOG((2, "inq_var_handler ndims = %d", ndims)); + + return PIO_NOERR; +} + +/** Do an inq_varid on a netCDF variable name. This function is only + * run on IO tasks. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int inq_varid_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int mpierr; + int ret; + int namelen; + char *name; + + /* Get the parameters for this function that the the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + + /* Call the inq_dimid function. */ + if ((ret = PIOc_inq_varid(ncid, name, &varid))) + return ret; + + /* Free resources. */ + free(name); + + return PIO_NOERR; +} + +/** This function is run on the IO tasks to sync a netCDF file. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int sync_file_handler(iosystem_desc_t *ios) +{ + int ncid; + int mpierr; + int ret; + + LOG((1, "sync_file_handler")); + + /* Get the parameters for this function that the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "sync_file_handler got parameter ncid = %d", ncid)); + + /* Call the sync file function. */ + if ((ret = PIOc_sync(ncid))) + return ret; + + LOG((2, "sync_file_handler succeeded!")); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to enddef a netCDF file. + * + * @param ios pointer to the iosystem_desc_t. + * @return PIO_NOERR for success, error code otherwise. +*/ +int change_def_file_handler(iosystem_desc_t *ios, int msg) +{ + int ncid; + int mpierr; + int ret; + + LOG((1, "change_def_file_handler")); + + /* Get the parameters for this function that the comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + + /* Call the function. */ + ret = (msg == PIO_MSG_ENDDEF) ? PIOc_enddef(ncid) : PIOc_redef(ncid); + + LOG((1, "change_def_file_handler succeeded!")); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to define a netCDF + * variable. */ +int def_var_handler(iosystem_desc_t *ios) +{ + int ncid; + int len, namelen; + int iotype; + char *name; + int mode; + int mpierr; + int ret; + int varid; + nc_type xtype; + int ndims; + int *dimids; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d def_var_handler comproot = %d\n", my_rank, ios->comproot)); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc(namelen + 1 * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, 0, + ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&xtype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&ndims, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(dimids = malloc(ndims * sizeof(int)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast(dimids, ndims, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((1, "%d def_var_handler got parameters namelen = %d " + "name = %s len = %d ncid = %d\n", + my_rank, namelen, name, len, ncid)); + + /* Call the create file function. */ + if ((ret = PIOc_def_var(ncid, name, xtype, ndims, dimids, &varid))) + return ret; + + /* Free resources. */ + free(name); + free(dimids); + + LOG((1, "%d def_var_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to define a netCDF + * dimension. */ +int def_dim_handler(iosystem_desc_t *ios) +{ + int ncid; + int len, namelen; + int iotype; + char *name; + int mode; + int mpierr; + int ret; + int dimid; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "def_dim_handler comproot = %d", ios->comproot)); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc(namelen + 1 * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, 0, + ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&len, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "def_dim_handler got parameters namelen = %d " + "name = %s len = %d ncid = %d", namelen, name, len, ncid)); + + /* Call the create file function. */ + if ((ret = PIOc_def_dim(ncid, name, len, &dimid))) + return ret; + + /* Free resources. */ + free(name); + + LOG((1, "%d def_dim_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to rename a netCDF + * dimension. */ +int rename_dim_handler(iosystem_desc_t *ios) +{ + int ncid; + int len, namelen; + int iotype; + char *name; + int mode; + int mpierr; + int ret; + int dimid; + char name1[NC_MAX_NAME + 1]; + + LOG((1, "rename_dim_handler")); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&dimid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "rename_dim_handler got parameters namelen = %d " + "name = %s ncid = %d dimid = %d", namelen, name, ncid, dimid)); + + /* Call the create file function. */ + if ((ret = PIOc_rename_dim(ncid, dimid, name))) + return ret; + + /* Free resources. */ + free(name); + + LOG((1, "%d rename_dim_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to rename a netCDF + * dimension. */ +int rename_var_handler(iosystem_desc_t *ios) +{ + int ncid; + int len, namelen; + int iotype; + char *name; + int mode; + int mpierr; + int ret; + int varid; + char name1[NC_MAX_NAME + 1]; + + LOG((1, "rename_var_handler")); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "rename_var_handler got parameters namelen = %d " + "name = %s ncid = %d varid = %d", namelen, name, ncid, varid)); + + /* Call the create file function. */ + if ((ret = PIOc_rename_var(ncid, varid, name))) + return ret; + + /* Free resources. */ + free(name); + + LOG((1, "%d rename_var_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to rename a netCDF + * attribute. */ +int rename_att_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int namelen, newnamelen; + char *name, *newname; + int mpierr; + int ret; + + LOG((1, "rename_att_handler")); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast(name, namelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&newnamelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(newname = malloc((newnamelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast(newname, newnamelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "rename_att_handler got parameters namelen = %d name = %s ncid = %d varid = %d " + "newnamelen = %d newname = %s", namelen, name, ncid, varid, newnamelen, newname)); + + /* Call the create file function. */ + if ((ret = PIOc_rename_att(ncid, varid, name, newname))) + return ret; + + /* Free resources. */ + free(name); + free(newname); + + LOG((1, "%d rename_att_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to delete a netCDF + * attribute. */ +int delete_att_handler(iosystem_desc_t *ios) +{ + int ncid; + int varid; + int namelen, newnamelen; + char *name, *newname; + int mpierr; + int ret; + + LOG((1, "delete_att_handler")); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&ncid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&varid, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(name = malloc((namelen + 1) * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast(name, namelen + 1, MPI_CHAR, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "delete_att_handler namelen = %d name = %s ncid = %d varid = %d ", + namelen, name, ncid, varid)); + + /* Call the create file function. */ + if ((ret = PIOc_del_att(ncid, varid, name))) + return ret; + + /* Free resources. */ + free(name); + + LOG((1, "delete_att_handler succeeded!")); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to open a netCDF file. + * + * @param ios pointer to the iosystem_desc_t data. + * + * @return PIO_NOERR for success, error code otherwise. */ +int open_file_handler(iosystem_desc_t *ios) +{ + int ncid; + int len; + int iotype; + char *filename; + int mode; + int mpierr; + int ret; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d open_file_handler comproot = %d\n", my_rank, ios->comproot)); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&len, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "open_file_handler got parameter len = %d", len)); + if (!(filename = malloc(len + 1 * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)filename, len + 1, MPI_CHAR, 0, + ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&iotype, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if ((mpierr = MPI_Bcast(&mode, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + LOG((2, "open_file_handler got parameters len = %d filename = %s iotype = %d mode = %d\n", + len, filename, iotype, mode)); + + /* Call the open file function. */ + if ((ret = PIOc_openfile(ios->iosysid, &ncid, &iotype, filename, mode))) + return ret; + + /* Free resources. */ + free(filename); + + LOG((1, "%d open_file_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +/** This function is run on the IO tasks to delete a netCDF file. + * + * @param ios pointer to the iosystem_desc_t data. + * + * @return PIO_NOERR for success, error code otherwise. */ +int delete_file_handler(iosystem_desc_t *ios) +{ + int ncid; + int len; + char *filename; + int mpierr; + int ret; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d delete_file_handler comproot = %d\n", my_rank, ios->comproot)); + + /* Get the parameters for this function that the he comp master + * task is broadcasting. */ + if ((mpierr = MPI_Bcast(&len, 1, MPI_INT, 0, ios->intercomm))) + return PIO_EIO; + if (!(filename = malloc(len + 1 * sizeof(char)))) + return PIO_ENOMEM; + if ((mpierr = MPI_Bcast((void *)filename, len + 1, MPI_CHAR, 0, + ios->intercomm))) + return PIO_EIO; + LOG((1, "%d delete_file_handler got parameters len = %d filename = %s\n", + my_rank, len, filename)); + + /* Call the delete file function. */ + if ((ret = PIOc_deletefile(ios->iosysid, filename))) + return ret; + + /* Free resources. */ + free(filename); + + LOG((1, "%d delete_file_handler succeeded!\n", my_rank)); + return PIO_NOERR; +} + +int initdecomp_dof_handler(iosystem_desc_t *ios) +{ + return PIO_NOERR; +} + +int writedarray_handler(iosystem_desc_t *ios) +{ + return PIO_NOERR; +} + +int readdarray_handler(iosystem_desc_t *ios) +{ + return PIO_NOERR; +} + +int seterrorhandling_handler(iosystem_desc_t *ios) +{ + return PIO_NOERR; +} + +int var_handler(iosystem_desc_t *ios, int msg) +{ + return PIO_NOERR; +} + +int freedecomp_handler(iosystem_desc_t *ios) +{ + return PIO_NOERR; +} + +int finalize_handler(iosystem_desc_t *ios) +{ + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d finalize_handler called\n", my_rank)); + return PIO_NOERR; +} + +int pio_callback_handler(iosystem_desc_t *ios, int msg) +{ + return PIO_NOERR; +} + +/** This function is called by the IO tasks. This function will not + return, unless there is an error. */ +int pio_msg_handler(int io_rank, int component_count, iosystem_desc_t *iosys) +{ + iosystem_desc_t *my_iosys; + int msg = 0; + MPI_Request req[component_count]; + MPI_Status status; + int index; + int mpierr; + int ret = PIO_NOERR; + + int my_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); + LOG((1, "%d pio_msg_handler called\n", my_rank)); + + /* Have IO comm rank 0 (the ioroot) register to receive + * (non-blocking) for a message from each of the comproots. */ + if (!io_rank) + { + for (int cmp = 0; cmp < component_count; cmp++) + { + my_iosys = &iosys[cmp]; + LOG((1, "%d about to call MPI_Irecv\n", my_rank)); + mpierr = MPI_Irecv(&msg, 1, MPI_INT, my_iosys->comproot, MPI_ANY_TAG, + my_iosys->union_comm, &req[cmp]); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + } + } + + /* If the message is not -1, keep processing messages. */ + while (msg != -1) + { + /* Wait until any one of the requests are complete. */ + if (!io_rank) + { + LOG((1, "%d about to call MPI_Waitany req[0] = %d MPI_REQUEST_NULL = %d\n", + my_rank, req[0], MPI_REQUEST_NULL)); + mpierr = MPI_Waitany(component_count, req, &index, &status); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + LOG((3, "Waitany returned index = %d req[%d] = %d", + index, index, req[index])); + } + + /* Broadcast the index of the computational component that + * originated the request to the rest of the IO tasks. */ + mpierr = MPI_Bcast(&index, 1, MPI_INT, 0, iosys->io_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + my_iosys = &iosys[index]; + LOG((3, "index MPI_Bcast complete index = %d", index)); + + /* Broadcast the msg value to the rest of the IO tasks. */ + LOG((3, "about to call msg MPI_Bcast")); + mpierr = MPI_Bcast(&msg, 1, MPI_INT, 0, my_iosys->io_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + LOG((1, "pio_msg_handler msg MPI_Bcast complete msg = %d", msg)); + + /* Handle the message. This code is run on all IO tasks. */ + switch (msg) + { + case PIO_MSG_INQ_TYPE: + inq_type_handler(my_iosys); + break; + case PIO_MSG_INQ_FORMAT: + inq_format_handler(my_iosys); + break; + case PIO_MSG_CREATE_FILE: + create_file_handler(my_iosys); + LOG((2, "returned from create_file_handler")); + break; + case PIO_MSG_SYNC: + sync_file_handler(my_iosys); + break; + case PIO_MSG_ENDDEF: + case PIO_MSG_REDEF: + LOG((2, "calling change_def_file_handler")); + change_def_file_handler(my_iosys, msg); + LOG((2, "returned from change_def_file_handler")); + break; + case PIO_MSG_OPEN_FILE: + open_file_handler(my_iosys); + break; + case PIO_MSG_CLOSE_FILE: + close_file_handler(my_iosys); + break; + case PIO_MSG_DELETE_FILE: + delete_file_handler(my_iosys); + break; + case PIO_MSG_RENAME_DIM: + rename_dim_handler(my_iosys); + break; + case PIO_MSG_RENAME_VAR: + rename_var_handler(my_iosys); + break; + case PIO_MSG_RENAME_ATT: + rename_att_handler(my_iosys); + break; + case PIO_MSG_DEL_ATT: + delete_att_handler(my_iosys); + break; + case PIO_MSG_DEF_DIM: + def_dim_handler(my_iosys); + break; + case PIO_MSG_DEF_VAR: + def_var_handler(my_iosys); + break; + case PIO_MSG_INQ: + inq_handler(my_iosys); + break; + case PIO_MSG_INQ_DIM: + inq_dim_handler(my_iosys, msg); + break; + case PIO_MSG_INQ_DIMID: + inq_dimid_handler(my_iosys); + break; + case PIO_MSG_INQ_VAR: + inq_var_handler(my_iosys); + break; + case PIO_MSG_GET_ATT: + ret = att_get_handler(my_iosys); + break; + case PIO_MSG_PUT_ATT: + ret = att_put_handler(my_iosys); + break; + case PIO_MSG_INQ_VARID: + inq_varid_handler(my_iosys); + break; + case PIO_MSG_INQ_ATT: + inq_att_handler(my_iosys); + break; + case PIO_MSG_INQ_ATTNAME: + inq_attname_handler(my_iosys); + break; + case PIO_MSG_INQ_ATTID: + inq_attid_handler(my_iosys); + break; + case PIO_MSG_GET_VARS: + get_vars_handler(my_iosys); + break; + case PIO_MSG_PUT_VARS: + put_vars_handler(my_iosys); + break; + case PIO_MSG_INITDECOMP_DOF: + initdecomp_dof_handler(my_iosys); + break; + case PIO_MSG_WRITEDARRAY: + writedarray_handler(my_iosys); + break; + case PIO_MSG_READDARRAY: + readdarray_handler(my_iosys); + break; + case PIO_MSG_SETERRORHANDLING: + seterrorhandling_handler(my_iosys); + break; + case PIO_MSG_FREEDECOMP: + freedecomp_handler(my_iosys); + break; + case PIO_MSG_EXIT: + finalize_handler(my_iosys); + msg = -1; + break; + default: + pio_callback_handler(my_iosys, msg); + } + + /* If an error was returned by the handler, do something! */ + LOG((3, "pio_msg_handler checking error ret = %d", ret)); + if (ret) + { + LOG((0, "hander returned error code %d", ret)); + MPI_Finalize(); + } + + LOG((3, "pio_msg_handler getting ready to listen")); + /* Unless finalize was called, listen for another msg from the + * component whose message we just handled. */ + if (!io_rank && msg != -1) + { + LOG((3, "pio_msg_handler about to Irecv")); + my_iosys = &iosys[index]; + mpierr = MPI_Irecv(&msg, 1, MPI_INT, my_iosys->comproot, MPI_ANY_TAG, my_iosys->union_comm, + &req[index]); + LOG((3, "pio_msg_handler called MPI_Irecv req[%d] = %d\n", index, req[index])); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + } + + } + + return PIO_NOERR; +} + +int +pio_iosys_print(int my_rank, iosystem_desc_t *iosys) +{ + printf("%d iosysid: %d\n", my_rank, iosys->iosysid); + if (iosys->union_comm == MPI_COMM_NULL) + printf("%d union_comm: MPI_COMM_NULL ", my_rank); + else + printf("%d union_comm: %d ", my_rank, iosys->union_comm); + + if (iosys->comp_comm == MPI_COMM_NULL) + printf("comp_comm: MPI_COMM_NULL "); + else + printf("comp_comm: %d ", iosys->comp_comm); + + if (iosys->io_comm == MPI_COMM_NULL) + printf("io_comm: MPI_COMM_NULL "); + else + printf("io_comm: %d ", iosys->io_comm); + + if (iosys->intercomm == MPI_COMM_NULL) + printf("intercomm: MPI_COMM_NULL\n"); + else + printf("intercomm: %d\n", iosys->intercomm); + + printf("%d num_iotasks=%d num_comptasks=%d union_rank=%d, comp_rank=%d, " + "io_rank=%d async_interface=%d\n", + my_rank, iosys->num_iotasks, iosys->num_comptasks, iosys->union_rank, + iosys->comp_rank, iosys->io_rank, iosys->async_interface); + + printf("%d ioroot=%d comproot=%d iomaster=%d, compmaster=%d\n", + my_rank, iosys->ioroot, iosys->comproot, iosys->iomaster, + iosys->compmaster); + + printf("%d iotasks:", my_rank); + for (int i = 0; i < iosys->num_iotasks; i++) + printf("%d ", iosys->ioranks[i]); + printf("\n"); + return PIO_NOERR; +} + +/** @ingroup PIO_init + * Library initialization used when IO tasks are distinct from compute + * tasks. + * + * This is a collective call. Input parameters are read on + * comp_rank=0 values on other tasks are ignored. This variation of + * PIO_init sets up a distinct set of tasks to handle IO, these tasks + * do not return from this call. Instead they go to an internal loop + * and wait to receive further instructions from the computational + * tasks. + * + * For 4 tasks, to have 2 of them be computational, and 2 of them + * be IO, I would provide the following: + * + * component_count = 1 + * + * peer_comm = MPI_COMM_WORLD + * + * comp_comms = an array with one element, an MPI (intra) communicator + * that contains the two tasks designated to do computation + * (processors 0, 1). + + * io_comm = an MPI (intra) communicator with the other two tasks (2, + * 3). + * + * iosysidp = pointer that gets the IO system ID. + * + * Fortran function (from PIO1, in piolib_mod.F90) is: + * + * subroutine init_intercom(component_count, peer_comm, comp_comms, + * io_comm, iosystem, rearr_opts) + * + * Some notes from Jim: + * + * Components and Component Count + * ------------------------------ + * + * It's a cesm thing - the cesm model is composed of several component + * models (atm, ocn, ice, lnd, etc) that may or may not be collocated + * on mpi tasks. Since for intercomm the IOCOMM tasks are a subset of + * the compute tasks for a given component we have a separate iocomm + * for each model component. and we call init_inracomm independently + * for each component. + * + * When the IO tasks are independent of any model component then we + * can have all of the components share one set of iotasks and we call + * init_intercomm once with the information for all components. + * + * Inter vs Intra Communicators + * ---------------------------- + * + * ​For an intra you just need to provide the compute comm, pio creates + * an io comm as a subset of that compute comm. + * + * For an inter you need to provide multiple comms - peer comm is the + * communicator that is going to encompass all of the tasks - usually + * this will be mpi_comm_world. Then you need to provide a comm for + * each component model that will share the io server, then an + * io_comm. + * + * Example of Communicators + * ------------------------ + * + * Starting from MPI_COMM_WORLD the calling program will create an + * IO_COMM and one or more COMP_COMMs, I think an example might be best: + * + * Suppose we have 10 tasks and 2 of them will be IO tasks. Then 0:7 + * are in COMP_COMM and 8:9 are in IO_COMM In this case on tasks 0:7 + * COMP_COMM is defined and IO_COMM is MPI_COMM_NULL and on tasks 8:9 + * IO_COMM is defined and COMP_COMM is MPI_COMM_NULL The communicators + * to handle communications between COMP_COMM and IO_COMM are defined + * in init_intercomm and held in a pio internal data structure. + * + * Return or Not + * ------------- + * + * The io_comm tasks do not return from the init_intercomm routine. + * + * Sequence of Events to do Asynch I/O + * ----------------------------------- + * + * Here is the sequence of events that needs to occur when an IO + * operation is called from the collection of compute tasks. I'm + * going to use pio_put_var because write_darray has some special + * characteristics that make it a bit more complicated... + * + * Compute tasks call pio_put_var with an integer argument + * + * The MPI_Send sends a message from comp_rank=0 to io_rank=0 on + * union_comm (a comm defined as the union of io and compute tasks) + * msg is an integer which indicates the function being called, in + * this case the msg is PIO_MSG_PUT_VAR_INT + * + * The iotasks now know what additional arguments they should expect + * to receive from the compute tasks, in this case a file handle, a + * variable id, the length of the array and the array itself. + * + * The iotasks now have the information they need to complete the + * operation and they call the pio_put_var routine. (In pio1 this bit + * of code is in pio_get_put_callbacks.F90.in) + * + * After the netcdf operation is completed (in the case of an inq or + * get operation) the result is communicated back to the compute + * tasks. + * + * + * @param component_count The number of computational (ex. model) + * components to associate with this IO component + * + * @param peer_comm The communicator from which all other communicator + * arguments are derived + * + * @param comp_comms An array containing the computational + * communicator for each of the computational components. The I/O + * tasks pass MPI_COMM_NULL for this parameter. + * +`* @param io_comm The io communicator. Processing tasks pass + * MPI_COMM_NULL for this parameter. + * + * @param iosysidp An array of length component_count. It will get the + * iosysid for each component. + * + * @return PIO_NOERR on success, error code otherwise. + */ +int PIOc_Init_Intercomm(int component_count, MPI_Comm peer_comm, + MPI_Comm *comp_comms, MPI_Comm io_comm, int *iosysidp) +{ + iosystem_desc_t *iosys; + iosystem_desc_t *my_iosys; + int ierr = PIO_NOERR; + int mpierr; + int iam; + int io_leader, comp_leader; + int root; + MPI_Group io_grp, comm_grp, union_grp; + + /* Allocate struct to hold io system info for each component. */ + if (!(iosys = (iosystem_desc_t *) calloc(1, sizeof(iosystem_desc_t) * component_count))) + ierr = PIO_ENOMEM; + + if (!ierr) + for (int cmp = 0; cmp < component_count; cmp++) + { + /* These are used when using the intercomm. */ + int comp_master = MPI_PROC_NULL, io_master = MPI_PROC_NULL; + + /* Get a pointer to the iosys struct */ + my_iosys = &iosys[cmp]; + + /* Create an MPI info object. */ + CheckMPIReturn(MPI_Info_create(&(my_iosys->info)),__FILE__,__LINE__); + + /* This task is part of the computation communicator. */ + if (comp_comms[cmp] != MPI_COMM_NULL) + { + /* Copy the computation communicator. */ + mpierr = MPI_Comm_dup(comp_comms[cmp], &my_iosys->comp_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Create an MPI group with the computation tasks. */ + mpierr = MPI_Comm_group(my_iosys->comp_comm, &my_iosys->compgroup); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find out how many tasks are in this communicator. */ + mpierr = MPI_Comm_size(iosys->comp_comm, &my_iosys->num_comptasks); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Set the rank within the comp_comm. */ + mpierr = MPI_Comm_rank(my_iosys->comp_comm, &my_iosys->comp_rank); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find the rank of the io leader in peer_comm. */ + iam = -1; + mpierr = MPI_Allreduce(&iam, &io_leader, 1, MPI_INT, MPI_MAX, peer_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find the rank of the comp leader in peer_comm. */ + if (!my_iosys->comp_rank) + { + mpierr = MPI_Comm_rank(peer_comm, &iam); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + } + else + iam = -1; + + /* Find the lucky comp_leader task. */ + mpierr = MPI_Allreduce(&iam, &comp_leader, 1, MPI_INT, MPI_MAX, peer_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Is this the compmaster? Only if the comp_rank is zero. */ + if (!my_iosys->comp_rank) + { + my_iosys->compmaster = MPI_ROOT; + comp_master = MPI_ROOT; + } + else + my_iosys->compmaster = MPI_PROC_NULL; + + /* Set up the intercomm from the computation side. */ + mpierr = MPI_Intercomm_create(my_iosys->comp_comm, 0, peer_comm, + io_leader, cmp, &my_iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Create the union communicator. */ + mpierr = MPI_Intercomm_merge(my_iosys->intercomm, 0, &my_iosys->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + } + else + { + my_iosys->comp_comm = MPI_COMM_NULL; + my_iosys->compgroup = MPI_GROUP_NULL; + my_iosys->comp_rank = -1; + } + + /* This task is part of the IO communicator, so set up the + * IO stuff. */ + if (io_comm != MPI_COMM_NULL) + { + /* Copy the IO communicator. */ + mpierr = MPI_Comm_dup(io_comm, &my_iosys->io_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Get an MPI group that includes the io tasks. */ + mpierr = MPI_Comm_group(my_iosys->io_comm, &my_iosys->iogroup); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find out how many tasks are in this communicator. */ + mpierr = MPI_Comm_size(iosys->io_comm, &my_iosys->num_iotasks); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Set the rank within the io_comm. */ + mpierr = MPI_Comm_rank(my_iosys->io_comm, &my_iosys->io_rank); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find the rank of the io leader in peer_comm. */ + if (!my_iosys->io_rank) + { + mpierr = MPI_Comm_rank(peer_comm, &iam); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + } + else + iam = -1; + + /* Find the lucky io_leader task. */ + mpierr = MPI_Allreduce(&iam, &io_leader, 1, MPI_INT, MPI_MAX, peer_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find the rank of the comp leader in peer_comm. */ + iam = -1; + mpierr = MPI_Allreduce(&iam, &comp_leader, 1, MPI_INT, MPI_MAX, peer_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* This is an io task. */ + my_iosys->ioproc = true; + + /* Is this the iomaster? Only if the io_rank is zero. */ + if (!my_iosys->io_rank) + { + my_iosys->iomaster = MPI_ROOT; + io_master = MPI_ROOT; + } + else + my_iosys->iomaster = 0; + + /* Set up the intercomm from the I/O side. */ + mpierr = MPI_Intercomm_create(my_iosys->io_comm, 0, peer_comm, + comp_leader, cmp, &my_iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Create the union communicator. */ + mpierr = MPI_Intercomm_merge(my_iosys->intercomm, 0, &my_iosys->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + } + else + { + my_iosys->io_comm = MPI_COMM_NULL; + my_iosys->iogroup = MPI_GROUP_NULL; + my_iosys->io_rank = -1; + my_iosys->ioproc = false; + my_iosys->iomaster = false; + } + + /* my_comm points to the union communicator for async, and + * the comp_comm for non-async. It should not be freed + * since it is not a proper copy of the commuicator, just + * a copy of the reference to it. */ + my_iosys->my_comm = my_iosys->union_comm; + + /* Find rank in union communicator. */ + mpierr = MPI_Comm_rank(my_iosys->union_comm, &my_iosys->union_rank); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Find the rank of the io leader in the union communicator. */ + if (!my_iosys->io_rank) + my_iosys->ioroot = my_iosys->union_rank; + else + my_iosys->ioroot = -1; + + /* Distribute the answer to all tasks. */ + mpierr = MPI_Allreduce(&my_iosys->ioroot, &root, 1, MPI_INT, MPI_MAX, + my_iosys->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + my_iosys->ioroot = root; + + /* Find the rank of the computation leader in the union + * communicator. */ + if (!my_iosys->comp_rank) + my_iosys->comproot = my_iosys->union_rank; + else + my_iosys->comproot = -1; + + /* Distribute the answer to all tasks. */ + mpierr = MPI_Allreduce(&my_iosys->comproot, &root, 1, MPI_INT, MPI_MAX, + my_iosys->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + my_iosys->comproot = root; + + /* Send the number of tasks in the IO and computation + communicators to each other over the intercomm. This is + a one-to-all bcast from the local task that passes + MPI_ROOT as the root (all other local tasks should pass + MPI_PROC_NULL as the root). The bcast is recieved by + all the members of the leaf group which each pass the + rank of the root relative to the root group. */ + if (io_comm != MPI_COMM_NULL) + { + comp_master = 0; + mpierr = MPI_Bcast(&my_iosys->num_comptasks, 1, MPI_INT, comp_master, + my_iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + mpierr = MPI_Bcast(&my_iosys->num_iotasks, 1, MPI_INT, io_master, + my_iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + } + else + { + io_master = 0; + mpierr = MPI_Bcast(&my_iosys->num_comptasks, 1, MPI_INT, comp_master, + my_iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + mpierr = MPI_Bcast(&my_iosys->num_iotasks, 1, MPI_INT, io_master, + my_iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + } + + /* Allocate an array to hold the ranks of the IO tasks + * within the union communicator. */ + if (!(my_iosys->ioranks = malloc(my_iosys->num_iotasks * sizeof(int)))) + return PIO_ENOMEM; + + /* Allocate a temp array to help get the IO ranks. */ + int *tmp_ioranks; + if (!(tmp_ioranks = malloc(my_iosys->num_iotasks * sizeof(int)))) + return PIO_ENOMEM; + + /* Init array, then have IO tasks set their values, then + * use allreduce to distribute results to all tasks. */ + for (int cnt = 0 ; cnt < my_iosys->num_iotasks; cnt++) + tmp_ioranks[cnt] = -1; + if (io_comm != MPI_COMM_NULL) + tmp_ioranks[my_iosys->io_rank] = my_iosys->union_rank; + mpierr = MPI_Allreduce(tmp_ioranks, my_iosys->ioranks, my_iosys->num_iotasks, MPI_INT, MPI_MAX, + my_iosys->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + + /* Free temp array. */ + free(tmp_ioranks); + + /* Set the default error handling. */ + my_iosys->error_handler = PIO_INTERNAL_ERROR; + + /* We do support asynch interface. */ + my_iosys->async_interface = true; + + /* For debug purposes, print the contents of the struct. */ + /*int my_rank;*/ + /* MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);*/ + + /* for (int t = 0; t < my_iosys->num_iotasks + my_iosys->num_comptasks; t++) */ + /* { */ + /* MPI_Barrier(my_iosys->union_comm); */ + /* if (my_rank == t) */ + /* pio_iosys_print(my_rank, my_iosys); */ + /* } */ + + /* Add this id to the list of PIO iosystem ids. */ + iosysidp[cmp] = pio_add_to_iosystem_list(my_iosys); + LOG((2, "added to iosystem_list iosysid = %d", iosysidp[cmp])); + + /* Now call the function from which the IO tasks will not + * return until the PIO_MSG_EXIT message is sent. */ + if (io_comm != MPI_COMM_NULL) + if ((ierr = pio_msg_handler(my_iosys->io_rank, component_count, iosys))) + return ierr; + } + + /* If there was an error, make sure all tasks see it. */ + if (ierr) + { + mpierr = MPI_Bcast(&ierr, 1, MPI_INT, 0, iosys->intercomm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + } + + return ierr; +} diff --git a/externals/pio2/src/clib/pio_nc.c b/externals/pio2/src/clib/pio_nc.c index f511475a4f6c..52a376f0c266 100644 --- a/externals/pio2/src/clib/pio_nc.c +++ b/externals/pio2/src/clib/pio_nc.c @@ -122,7 +122,7 @@ int PIOc_inq_dimname (int ncid, int dimid, char *name) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_DIMNAME; + msg = PIO_MSG_INQ_DIM; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -961,7 +961,7 @@ int PIOc_inq_vartype (int ncid, int varid, nc_type *xtypep) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_VARTYPE; + msg = PIO_MSG_INQ_VAR; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -1108,7 +1108,7 @@ int PIOc_inq_vardimid (int ncid, int varid, int *dimidsp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_VARDIMID; + msg = PIO_MSG_INQ_VAR; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -1340,7 +1340,7 @@ int PIOc_inq_attlen (int ncid, int varid, const char *name, PIO_Offset *lenp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_ATTLEN; + msg = PIO_MSG_INQ_ATT; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -1415,7 +1415,7 @@ int PIOc_inq_atttype (int ncid, int varid, const char *name, nc_type *xtypep) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_ATTTYPE; + msg = PIO_MSG_INQ_ATT; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -1561,7 +1561,7 @@ int PIOc_inq_natts (int ncid, int *ngattsp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_NATTS; + msg = PIO_MSG_INQ; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -2322,7 +2322,7 @@ int PIOc_inq_attname (int ncid, int varid, int attnum, char *name) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_ATTNAME; + msg = PIO_MSG_INQ_ATT; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -2551,7 +2551,7 @@ int PIOc_inq_unlimdim (int ncid, int *unlimdimidp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_UNLIMDIM; + msg = PIO_MSG_INQ; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -2702,7 +2702,7 @@ int PIOc_inq_ndims (int ncid, int *ndimsp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_NDIMS; + msg = PIO_MSG_INQ; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -2848,7 +2848,7 @@ int PIOc_inq_nvars (int ncid, int *nvarsp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_NVARS; + msg = PIO_MSG_INQ; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -3141,7 +3141,7 @@ int PIOc_inq_varnatts (int ncid, int varid, int *nattsp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_VARNATTS; + msg = PIO_MSG_INQ_VAR; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -3444,7 +3444,7 @@ int PIOc_inq_dimlen (int ncid, int dimid, PIO_Offset *lenp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_DIMLEN; + msg = PIO_MSG_INQ_DIM; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) @@ -3674,7 +3674,7 @@ int PIOc_inq_varndims (int ncid, int varid, int *ndimsp) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_VARNDIMS; + msg = PIO_MSG_INQ_VAR; if(file->varlist[varid].ndims > 0){ (*ndimsp) = file->varlist[varid].ndims; return PIO_NOERR; @@ -3753,7 +3753,7 @@ int PIOc_inq_varname (int ncid, int varid, char *name) if(file == NULL) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_INQ_VARNAME; + msg = PIO_MSG_INQ_VAR; if(ios->async_interface && ! ios->ioproc){ if(ios->compmaster) diff --git a/externals/pio2/src/clib/pio_nc4.c b/externals/pio2/src/clib/pio_nc4.c index 735e3755a99d..a311ed003f4f 100644 --- a/externals/pio2/src/clib/pio_nc4.c +++ b/externals/pio2/src/clib/pio_nc4.c @@ -235,28 +235,40 @@ int PIOc_inq_var_deflate(int ncid, int varid, int *shufflep, int PIOc_def_var_chunking(int ncid, int varid, int storage, const PIO_Offset *chunksizesp) { - int ierr; - int msg; - int mpierr; - iosystem_desc_t *ios; - file_desc_t *file; + iosystem_desc_t *ios; /** Pointer to io system information. */ + file_desc_t *file; /** Pointer to file information. */ + int ierr = PIO_NOERR; /** Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /** Return code from MPI function codes. */ char *errstr; - errstr = NULL; - ierr = PIO_NOERR; + /* Find the info about this file. */ if (!(file = pio_get_file_from_id(ncid))) return PIO_EBADID; ios = file->iosystem; - msg = PIO_MSG_DEF_VAR_CHUNKING; - if (ios->async_interface && ! ios->ioproc) + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) { - if (ios->compmaster) - mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); - mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + if (!ios->ioproc) + { + int msg = PIO_MSG_DEF_VAR_CHUNKING; + + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); } + /* If this is an IO task, then call the netCDF function. */ if (ios->ioproc) { switch (file->iotype) @@ -287,20 +299,12 @@ int PIOc_def_var_chunking(int ncid, int varid, int storage, } } - /* Allocate an error string if needed. */ - if (ierr != PIO_NOERR) - { - errstr = (char *) malloc((strlen(__FILE__) + 20)* sizeof(char)); - sprintf(errstr,"in file %s",__FILE__); - } - - /* Check for netCDF error. */ - ierr = check_netcdf(file, ierr, errstr,__LINE__); - - /* Free the error string if it was allocated. */ - if (errstr != NULL) - free(errstr); - + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + return ierr; } diff --git a/externals/pio2/src/clib/pio_nc_async.c b/externals/pio2/src/clib/pio_nc_async.c new file mode 100644 index 000000000000..147fc548d7ab --- /dev/null +++ b/externals/pio2/src/clib/pio_nc_async.c @@ -0,0 +1,2513 @@ +/** + * @file + * PIO interfaces to + * [NetCDF](http://www.unidata.ucar.edu/software/netcdf/docs/modules.html) + * support functions + + * This file provides an interface to the + * [NetCDF](http://www.unidata.ucar.edu/software/netcdf/docs/modules.html) + * support functions. Each subroutine calls the underlying netcdf or + * pnetcdf or netcdf4 functions from the appropriate subset of mpi + * tasks (io_comm). Each routine must be called collectively from + * union_comm. + * + * @author Jim Edwards (jedwards@ucar.edu), Ed Hartnett + * @date Feburary 2014, April 2016 + */ + +#include +#include +#include + +/** + * @ingroup PIOc_inq + * The PIO-C interface for the NetCDF function nc_inq. + * + * This routine is called collectively by all tasks in the + * communicator ios.union_comm. For more information on the underlying + * NetCDF commmand please read about this function in the NetCDF + * documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__datasets.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * + * @return PIO_NOERR for success, error code otherwise. See + * PIOc_Set_File_Error_Handling + */ +int PIOc_inq(int ncid, int *ndimsp, int *nvarsp, int *ngattsp, int *unlimdimidp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_inq ncid = %d", ncid)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ; /* Message for async notification. */ + char ndims_present = ndimsp ? true : false; + char nvars_present = nvarsp ? true : false; + char ngatts_present = ngattsp ? true : false; + char unlimdimid_present = unlimdimidp ? true : false; + + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&ndims_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&nvars_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&ngatts_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&unlimdimid_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_inq ncid = %d ndims_present = %d nvars_present = %d ngatts_present = %d unlimdimid_present = %d", + ncid, ndims_present, nvars_present, ngatts_present, unlimdimid_present)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + { + LOG((2, "PIOc_inq calling ncmpi_inq unlimdimidp = %d", unlimdimidp)); + ierr = ncmpi_inq(ncid, ndimsp, nvarsp, ngattsp, unlimdimidp); + LOG((2, "PIOc_inq called ncmpi_inq")); + if (unlimdimidp) + LOG((2, "PIOc_inq returned from ncmpi_inq unlimdimid = %d", *unlimdimidp)); + } +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype == PIO_IOTYPE_NETCDF && file->do_io) + { + LOG((2, "PIOc_inq calling classic nc_inq")); + /* Should not be necessary to do this - nc_inq should + * handle null pointers. This has been reported as a bug + * to netCDF developers. */ + int tmp_ndims, tmp_nvars, tmp_ngatts, tmp_unlimdimid; + LOG((2, "PIOc_inq calling classic nc_inq")); + ierr = nc_inq(ncid, &tmp_ndims, &tmp_nvars, &tmp_ngatts, &tmp_unlimdimid); + LOG((2, "PIOc_inq calling classic nc_inq")); + if (unlimdimidp) + LOG((2, "classic tmp_unlimdimid = %d", tmp_unlimdimid)); + if (ndimsp) + *ndimsp = tmp_ndims; + if (nvarsp) + *nvarsp = tmp_nvars; + if (ngattsp) + *ngattsp = tmp_ngatts; + if (unlimdimidp) + *unlimdimidp = tmp_unlimdimid; + if (unlimdimidp) + LOG((2, "classic unlimdimid = %d", *unlimdimidp)); + } + else if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + { + LOG((2, "PIOc_inq calling netcdf-4 nc_inq")); + ierr = nc_inq(ncid, ndimsp, nvarsp, ngattsp, unlimdimidp); + } +#endif /* _NETCDF */ + LOG((2, "PIOc_inq netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + { + if (ndimsp) + if ((mpierr = MPI_Bcast(ndimsp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + if (nvarsp) + if ((mpierr = MPI_Bcast(nvarsp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + if (ngattsp) + if ((mpierr = MPI_Bcast(ngattsp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + if (unlimdimidp) + if ((mpierr = MPI_Bcast(unlimdimidp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_ndims + * The PIO-C interface for the NetCDF function nc_inq_ndims. + */ +int PIOc_inq_ndims (int ncid, int *ndimsp) +{ + LOG((1, "PIOc_inq_ndims")); + return PIOc_inq(ncid, ndimsp, NULL, NULL, NULL); +} + +/** + * @ingroup PIOc_inq_nvars + * The PIO-C interface for the NetCDF function nc_inq_nvars. + */ +int PIOc_inq_nvars(int ncid, int *nvarsp) +{ + return PIOc_inq(ncid, NULL, nvarsp, NULL, NULL); +} + +/** + * @ingroup PIOc_inq_natts + * The PIO-C interface for the NetCDF function nc_inq_natts. + */ +int PIOc_inq_natts(int ncid, int *ngattsp) +{ + return PIOc_inq(ncid, NULL, NULL, ngattsp, NULL); +} + +/** + * @ingroup PIOc_inq_unlimdim + * The PIO-C interface for the NetCDF function nc_inq_unlimdim. + */ +int PIOc_inq_unlimdim(int ncid, int *unlimdimidp) +{ + LOG((1, "PIOc_inq_unlimdim ncid = %d unlimdimidp = %d", ncid, unlimdimidp)); + return PIOc_inq(ncid, NULL, NULL, NULL, unlimdimidp); +} + +/** Internal function to provide inq_type function for pnetcdf. */ +int pioc_pnetcdf_inq_type(int ncid, nc_type xtype, char *name, + PIO_Offset *sizep) +{ + int typelen; + char typename[NC_MAX_NAME + 1]; + + switch (xtype) + { + case NC_UBYTE: + case NC_BYTE: + case NC_CHAR: + typelen = 1; + break; + case NC_SHORT: + case NC_USHORT: + typelen = 2; + break; + case NC_UINT: + case NC_INT: + case NC_FLOAT: + typelen = 4; + break; + case NC_UINT64: + case NC_INT64: + case NC_DOUBLE: + typelen = 8; + break; + } + + /* If pointers were supplied, copy results. */ + if (sizep) + *sizep = typelen; + if (name) + strcpy(name, "some type"); + + return PIO_NOERR; +} + +/** + * @ingroup PIOc_typelen + * The PIO-C interface for the NetCDF function nctypelen. + */ +int PIOc_inq_type(int ncid, nc_type xtype, char *name, PIO_Offset *sizep) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + int typelen; + + LOG((1, "PIOc_inq_type ncid = %d xtype = %d", ncid, xtype)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_TYPE; /* Message for async notification. */ + char name_present = name ? true : false; + char size_present = sizep ? true : false; + + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&size_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = pioc_pnetcdf_inq_type(ncid, xtype, name, sizep); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_type(ncid, xtype, name, (size_t *)sizep); +#endif /* _NETCDF */ + LOG((2, "PIOc_inq_type netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + { + if (name) + { + int slen; + if (ios->iomaster) + slen = strlen(name); + if ((mpierr = MPI_Bcast(&slen, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (!mpierr) + if ((mpierr = MPI_Bcast((void *)name, slen + 1, MPI_CHAR, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + if (sizep) + if ((mpierr = MPI_Bcast(sizep , 1, MPI_OFFSET, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_format + * The PIO-C interface for the NetCDF function nc_inq_format. + */ +int PIOc_inq_format (int ncid, int *formatp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_inq ncid = %d", ncid)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_FORMAT; + char format_present = formatp ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&format_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_format(file->fh, formatp); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_format(file->fh, formatp); +#endif /* _NETCDF */ + LOG((2, "PIOc_inq netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + { + if (formatp) + if ((mpierr = MPI_Bcast(formatp , 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_dim + * The PIO-C interface for the NetCDF function nc_inq_dim. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__dimensions.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param lenp a pointer that will get the number of values + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_dim(int ncid, int dimid, char *name, PIO_Offset *lenp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_inq_dim")); + + /* Get the file info, based on the ncid. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_DIM; + char name_present = name ? true : false; + char len_present = lenp ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&dimid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_inq netcdf Bcast name_present = %d", name_present)); + if (!mpierr) + mpierr = MPI_Bcast(&len_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_inq netcdf Bcast len_present = %d", len_present)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_dim(file->fh, dimid, name, lenp);; +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_dim(file->fh, dimid, name, (size_t *)lenp);; +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + { + if (name) + { + int slen; + if (ios->iomaster) + slen = strlen(name); + if ((mpierr = MPI_Bcast(&slen, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if ((mpierr = MPI_Bcast((void *)name, slen + 1, MPI_CHAR, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + if (lenp) + if ((mpierr = MPI_Bcast(lenp , 1, MPI_OFFSET, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_dimname + * The PIO-C interface for the NetCDF function nc_inq_dimname. + */ +int PIOc_inq_dimname(int ncid, int dimid, char *name) +{ + return PIOc_inq_dim(ncid, dimid, name, NULL); +} + +/** + * @ingroup PIOc_inq_dimlen + * The PIO-C interface for the NetCDF function nc_inq_dimlen. + */ +int PIOc_inq_dimlen(int ncid, int dimid, PIO_Offset *lenp) +{ + return PIOc_inq_dim(ncid, dimid, NULL, lenp); +} + +/** + * @ingroup PIOc_inq_dimid + * The PIO-C interface for the NetCDF function nc_inq_dimid. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__dimensions.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param idp a pointer that will get the id of the variable or attribute. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_dimid(int ncid, const char *name, int *idp) +{ + iosystem_desc_t *ios; + file_desc_t *file; + int ierr = PIO_NOERR; + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* Name must be provided. */ + if (!name) + return PIO_EINVAL; + + LOG((1, "PIOc_inq_dimid name = %s", name)); + + /* Get the file info, based on the ncid. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If using async, and not an IO task, then send parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_DIMID; + char id_present = idp ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + int namelen = strlen(name); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&id_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* IO tasks call the netCDF functions. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_dimid(file->fh, name, idp);; +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_dimid(file->fh, name, idp);; +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results. */ + if (!ierr) + if (idp) + if ((mpierr = MPI_Bcast(idp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_inq_var + * The PIO-C interface for the NetCDF function nc_inq_var. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__variables.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @param xtypep a pointer that will get the type of the attribute. + * @param nattsp a pointer that will get the number of attributes + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_var(int ncid, int varid, char *name, nc_type *xtypep, int *ndimsp, + int *dimidsp, int *nattsp) +{ + iosystem_desc_t *ios; + file_desc_t *file; + int ndims; /* The number of dimensions for this variable. */ + int ierr = PIO_NOERR; + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_inq_var ncid = %d varid = %d", ncid, varid)); + + /* Get the file info, based on the ncid. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_VAR; + char name_present = name ? true : false; + char xtype_present = xtypep ? true : false; + char ndims_present = ndimsp ? true : false; + char dimids_present = dimidsp ? true : false; + char natts_present = nattsp ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&ndims_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&dimids_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&natts_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_inq_var name_present = %d xtype_present = %d ndims_present = %d " + "dimids_present = %d, natts_present = %d nattsp = %d", + name_present, xtype_present, ndims_present, dimids_present, natts_present, nattsp)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* Call the netCDF layer. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + { + ierr = ncmpi_inq_varndims(file->fh, varid, &ndims); + if (!ierr) + ierr = ncmpi_inq_var(file->fh, varid, name, xtypep, ndimsp, dimidsp, nattsp);; + } +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + { + ierr = nc_inq_varndims(file->fh, varid, &ndims); + if (!ierr) + ierr = nc_inq_var(file->fh, varid, name, xtypep, ndimsp, dimidsp, nattsp); + } +#endif /* _NETCDF */ + } + + if (ndimsp) + LOG((2, "PIOc_inq_var ndims = %d ierr = %d", *ndimsp, ierr)); + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast the results for non-null pointers. */ + if (!ierr) + { + if (name) + { + int slen; + if(ios->iomaster) + slen = strlen(name); + if ((mpierr = MPI_Bcast(&slen, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if ((mpierr = MPI_Bcast((void *)name, slen + 1, MPI_CHAR, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + if (xtypep) + if ((mpierr = MPI_Bcast(xtypep, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + if (ndimsp) + { + if (ios->ioroot) + LOG((2, "PIOc_inq_var about to Bcast ndims = %d ios->ioroot = %d", *ndimsp, ios->ioroot)); + if ((mpierr = MPI_Bcast(ndimsp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + file->varlist[varid].ndims = *ndimsp; + LOG((2, "PIOc_inq_var Bcast ndims = %d", *ndimsp)); + } + if (dimidsp) + { + if ((mpierr = MPI_Bcast(&ndims, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if ((mpierr = MPI_Bcast(dimidsp, ndims, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + if (nattsp) + if ((mpierr = MPI_Bcast(nattsp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_varname + * The PIO-C interface for the NetCDF function nc_inq_varname. + */ +int PIOc_inq_varname (int ncid, int varid, char *name) +{ + return PIOc_inq_var(ncid, varid, name, NULL, NULL, NULL, NULL); +} + +/** + * @ingroup PIOc_inq_vartype + * The PIO-C interface for the NetCDF function nc_inq_vartype. + */ +int PIOc_inq_vartype (int ncid, int varid, nc_type *xtypep) +{ + return PIOc_inq_var(ncid, varid, NULL, xtypep, NULL, NULL, NULL); +} + +/** + * @ingroup PIOc_inq_varndims + * The PIO-C interface for the NetCDF function nc_inq_varndims. + */ +int PIOc_inq_varndims (int ncid, int varid, int *ndimsp) +{ + return PIOc_inq_var(ncid, varid, NULL, NULL, ndimsp, NULL, NULL); +} + +/** + * @ingroup PIOc_inq_vardimid + * The PIO-C interface for the NetCDF function nc_inq_vardimid. + */ +int PIOc_inq_vardimid(int ncid, int varid, int *dimidsp) +{ + return PIOc_inq_var(ncid, varid, NULL, NULL, NULL, dimidsp, NULL); +} + +/** + * @ingroup PIOc_inq_varnatts + * The PIO-C interface for the NetCDF function nc_inq_varnatts. + */ +int PIOc_inq_varnatts (int ncid, int varid, int *nattsp) +{ + return PIOc_inq_var(ncid, varid, NULL, NULL, NULL, NULL, nattsp); +} + +/** + * @ingroup PIOc_inq_varid + * The PIO-C interface for the NetCDF function nc_inq_varid. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__variables.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @param varidp a pointer that will get the variable id + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_varid (int ncid, const char *name, int *varidp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* Caller must provide name. */ + if (!name || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + /* Get file info based on ncid. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + LOG((1, "PIOc_inq_varid ncid = %d name = %s", ncid, name)); + + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_VARID; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + int namelen; + namelen = strlen(name); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_varid(file->fh, name, varidp);; +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_varid(file->fh, name, varidp); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (varidp) + if ((mpierr = MPI_Bcast(varidp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_inq_att + * The PIO-C interface for the NetCDF function nc_inq_att. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @param xtypep a pointer that will get the type of the attribute. + * @param lenp a pointer that will get the number of values + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_att(int ncid, int varid, const char *name, nc_type *xtypep, + PIO_Offset *lenp) +{ + int msg = PIO_MSG_INQ_ATT; + iosystem_desc_t *ios; + file_desc_t *file; + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + int ierr = PIO_NOERR; + + /* Caller must provide a name. */ + if (!name) + return PIO_EINVAL; + + LOG((1, "PIOc_inq_att ncid = %d varid = %d xtpyep = %d lenp = %d", + ncid, varid, xtypep, lenp)); + + /* Find file based on ncid. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + char xtype_present = xtypep ? true : false; + char len_present = lenp ? true : false; + int namelen = strlen(name); + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&len_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_att(file->fh, varid, name, xtypep, lenp); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_att(file->fh, varid, name, xtypep, (size_t *)lenp); +#endif /* _NETCDF */ + LOG((2, "PIOc_inq netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results. */ + if (!ierr) + { + if(xtypep) + if ((mpierr = MPI_Bcast(xtypep, 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + if(lenp) + if ((mpierr = MPI_Bcast(lenp, 1, MPI_OFFSET, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_attlen + * The PIO-C interface for the NetCDF function nc_inq_attlen. + */ +int PIOc_inq_attlen (int ncid, int varid, const char *name, PIO_Offset *lenp) +{ + return PIOc_inq_att(ncid, varid, name, NULL, lenp); +} + +/** + * @ingroup PIOc_inq_atttype + * The PIO-C interface for the NetCDF function nc_inq_atttype. + */ +int PIOc_inq_atttype(int ncid, int varid, const char *name, nc_type *xtypep) +{ + return PIOc_inq_att(ncid, varid, name, xtypep, NULL); +} + +/** + * @ingroup PIOc_inq_attname + * The PIO-C interface for the NetCDF function nc_inq_attname. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @param attnum the attribute ID. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_attname(int ncid, int varid, int attnum, char *name) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_inq_attname ncid = %d varid = %d attnum = %d", ncid, varid, + attnum)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_ATTNAME; + char name_present = name ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&attnum, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&name_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_attname(file->fh, varid, attnum, name);; +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_attname(file->fh, varid, attnum, name);; +#endif /* _NETCDF */ + LOG((2, "PIOc_inq_attname netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + if (name) + { + int namelen = strlen(name); + if ((mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + if ((mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->ioroot, + ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_inq_attid + * The PIO-C interface for the NetCDF function nc_inq_attid. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @param idp a pointer that will get the id of the variable or attribute. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_attid(int ncid, int varid, const char *name, int *idp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* User must provide name shorter than NC_MAX_NAME +1. */ + if (!name || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_inq_attid ncid = %d varid = %d name = %s", ncid, varid, name)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_ATTID; + int namelen = strlen(name); + char id_present = idp ? true : false; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((char *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&id_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_attid(file->fh, varid, name, idp);; +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_attid(file->fh, varid, name, idp);; +#endif /* _NETCDF */ + LOG((2, "PIOc_inq_attname netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results. */ + if (!ierr) + { + if (idp) + if ((mpierr = MPI_Bcast(idp, 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + } + + return ierr; +} + +/** + * @ingroup PIOc_rename_dim + * The PIO-C interface for the NetCDF function nc_rename_dim. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__dimensions.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_rename_dim(int ncid, int dimid, const char *name) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* User must provide name of correct length. */ + if (!name || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_rename_dim ncid = %d dimid = %d name = %s", ncid, dimid, name)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_RENAME_DIM; /* Message for async notification. */ + int namelen = strlen(name); + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&dimid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_rename_dim Bcast file->fh = %d dimid = %d namelen = %d name = %s", + file->fh, dimid, namelen, name)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_rename_dim(file->fh, dimid, name); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_rename_dim(file->fh, dimid, name);; +#endif /* _NETCDF */ + LOG((2, "PIOc_inq netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_rename_var + * The PIO-C interface for the NetCDF function nc_rename_var. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__variables.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_rename_var(int ncid, int varid, const char *name) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* User must provide name of correct length. */ + if (!name || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_rename_var ncid = %d varid = %d name = %s", ncid, varid, name)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_RENAME_VAR; /* Message for async notification. */ + int namelen = strlen(name); + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_rename_var Bcast file->fh = %d varid = %d namelen = %d name = %s", + file->fh, varid, namelen, name)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_rename_var(file->fh, varid, name); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_rename_var(file->fh, varid, name);; +#endif /* _NETCDF */ + LOG((2, "PIOc_inq netcdf call returned %d", ierr)); + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_rename_att + * The PIO-C interface for the NetCDF function nc_rename_att. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @return PIO_NOERR for success, error code otherwise. See + * PIOc_Set_File_Error_Handling + */ +int PIOc_rename_att (int ncid, int varid, const char *name, + const char *newname) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI functions. */ + + /* User must provide names of correct length. */ + if (!name || strlen(name) > NC_MAX_NAME || + !newname || strlen(newname) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_rename_att ncid = %d varid = %d name = %s newname = %s", + ncid, varid, name, newname)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_RENAME_ATT; /* Message for async notification. */ + int namelen = strlen(name); + int newnamelen = strlen(newname); + + if (ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((char *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&newnamelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((char *)newname, newnamelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_rename_att(file->fh, varid, name, newname); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_rename_att(file->fh, varid, name, newname); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + LOG((2, "PIOc_rename_att succeeded")); + return ierr; +} + +/** + * @ingroup PIOc_del_att + * The PIO-C interface for the NetCDF function nc_del_att. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_del_att(int ncid, int varid, const char *name) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI functions. */ + + /* User must provide name of correct length. */ + if (!name || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_del_att ncid = %d varid = %d name = %s", ncid, varid, name)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_DEL_ATT; + int namelen = strlen(name); /* Length of name string. */ + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((char *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_del_att(file->fh, varid, name); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_del_att(file->fh, varid, name); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + LOG((2, "PIOc_del_att succeeded")); + return ierr; +} + +/** + * @ingroup PIOc_set_fill + * The PIO-C interface for the NetCDF function nc_set_fill. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__datasets.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_set_fill (int ncid, int fillmode, int *old_modep) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI functions. */ + + LOG((1, "PIOc_set_fill ncid = %d fillmode = %d old_modep = %d", ncid, fillmode, + old_modep)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_SET_FILL; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_set_fill(file->fh, fillmode, old_modep); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_set_fill(file->fh, fillmode, old_modep); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + LOG((2, "PIOc_set_fill succeeded")); + return ierr; +} + +/** This is an internal function that handles both PIOc_enddef and + * PIOc_redef. + * @param ncid the ncid of the file to enddef or redef + * @param is_enddef set to non-zero for enddef, 0 for redef. + * @returns PIO_NOERR on success, error code on failure. */ +int pioc_change_def(int ncid, int is_enddef) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI functions. */ + + LOG((1, "pioc_change_def ncid = %d is_enddef = %d", ncid, is_enddef)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + LOG((2, "pioc_change_def found file")); + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = is_enddef ? PIO_MSG_ENDDEF : PIO_MSG_REDEF; + LOG((2, "sending message msg = %d", msg)); + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + LOG((2, "pioc_change_def ncid = %d mpierr = %d", file->fh, mpierr)); + } + + /* Handle MPI errors. */ + LOG((2, "pioc_change_def handling MPI errors")); + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + LOG((2, "pioc_change_def ios->ioproc = %d", ios->ioproc)); + if (ios->ioproc) + { + LOG((2, "pioc_change_def calling netcdf function")); +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + if (is_enddef) + ierr = ncmpi_enddef(file->fh); + else + ierr = ncmpi_redef(file->fh); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + if (is_enddef) + ierr = nc_enddef(file->fh); + else + ierr = nc_redef(file->fh); +#endif /* _NETCDF */ + LOG((2, "pioc_change_def ierr = %d", ierr)); + } + + /* Broadcast and check the return code. */ + LOG((2, "pioc_change_def bcasting return code ierr = %d", ierr)); + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + LOG((2, "pioc_change_def succeeded")); + + return ierr; +} + +/** + * @ingroup PIOc_enddef + * The PIO-C interface for the NetCDF function nc_enddef. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__datasets.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_enddef(int ncid) +{ + return pioc_change_def(ncid, 1); +} + +/** + * @ingroup PIOc_redef + * The PIO-C interface for the NetCDF function nc_redef. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__datasets.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_redef(int ncid) +{ + return pioc_change_def(ncid, 0); +} + +/** + * @ingroup PIOc_def_dim + * The PIO-C interface for the NetCDF function nc_def_dim. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__dimensions.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param idp a pointer that will get the id of the variable or attribute. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_def_dim (int ncid, const char *name, PIO_Offset len, int *idp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* User must provide name. */ + if (!name || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_def_dim ncid = %d name = %s len = %d", ncid, name, len)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_DEF_DIM; + int namelen = strlen(name); + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&len, 1, MPI_INT, ios->compmaster, ios->intercomm); + } + + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_def_dim(file->fh, name, len, idp);; +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_def_dim(file->fh, name, (size_t)len, idp); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr2, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + if (idp) + if ((mpierr = MPI_Bcast(idp , 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_def_var + * The PIO-C interface for the NetCDF function nc_def_var. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__variables.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @param varidp a pointer that will get the variable id + * @return PIO_NOERR for success, error code otherwise. See + * PIOc_Set_File_Error_Handling + */ +int PIOc_def_var (int ncid, const char *name, nc_type xtype, int ndims, + const int *dimidsp, int *varidp) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + /* User must provide name and storage for varid. */ + if (!name || !varidp || strlen(name) > NC_MAX_NAME) + { + check_netcdf(file, PIO_EINVAL, __FILE__, __LINE__); + return PIO_EINVAL; + } + + /* Get the file information. */ + if (!(file = pio_get_file_from_id(ncid))) + { + check_netcdf(file, PIO_EBADID, __FILE__, __LINE__); + return PIO_EBADID; + } + ios = file->iosystem; + + /* If using async, and not an IO task, then send parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_DEF_VAR; + int namelen = strlen(name); + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&(ncid), 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&ndims, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)dimidsp, ndims, MPI_INT, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_def_var(ncid, name, xtype, ndims, dimidsp, varidp); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_def_var(ncid, name, xtype, ndims, dimidsp, varidp); +#ifdef _NETCDF4 + /* For netCDF-4 serial files, turn on compression for this variable. */ + if (!ierr && file->iotype == PIO_IOTYPE_NETCDF4C) + ierr = nc_def_var_deflate(ncid, *varidp, 0, 1, 1); + + /* For netCDF-4 parallel files, set parallel access to collective. */ + if (!ierr && file->iotype == PIO_IOTYPE_NETCDF4P) + ierr = nc_var_par_access(ncid, *varidp, NC_COLLECTIVE); +#endif /* _NETCDF4 */ +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results. */ + if (!ierr) + if (varidp) + if ((mpierr = MPI_Bcast(varidp , 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_inq_var_fill + * The PIO-C interface for the NetCDF function nc_inq_var_fill. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__variables.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_inq_var_fill(int ncid, int varid, int *no_fill, void *fill_valuep) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_inq ncid = %d", ncid)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_INQ_VAR_FILL; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_inq_var_fill(file->fh, varid, no_fill, fill_valuep); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_inq_var_fill(file->fh, varid, no_fill, fill_valuep); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. Ignore NULL parameters. */ + if (!ierr) + if (fill_valuep) + if ((mpierr = MPI_Bcast(fill_valuep, 1, MPI_INT, ios->ioroot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_get_att + * The PIO-C interface for the NetCDF function nc_get_att. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @return PIO_NOERR for success, error code otherwise. See + * PIOc_Set_File_Error_Handling + */ +int PIOc_get_att(int ncid, int varid, const char *name, void *ip) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + PIO_Offset attlen, typelen; + nc_type atttype; + + /* User must provide a name and destination pointer. */ + if (!name || !ip || strlen(name) > NC_MAX_NAME) + return PIO_EINVAL; + + LOG((1, "PIOc_get_att ncid %d varid %d name %s", ncid, varid, name)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* Run these on all tasks if async is not in use, but only on + * non-IO tasks if async is in use. */ + if (!ios->async_interface || !ios->ioproc) + { + /* Get the type and length of the attribute. */ + if ((ierr = PIOc_inq_att(file->fh, varid, name, &atttype, &attlen))) + { + check_netcdf(file, ierr, __FILE__, __LINE__); + return ierr; + } + + /* Get the length (in bytes) of the type. */ + if ((ierr = PIOc_inq_type(file->fh, atttype, NULL, &typelen))) + { + check_netcdf(file, ierr, __FILE__, __LINE__); + return ierr; + } + } + + /* If async is in use, and this is not an IO task, bcast the + * parameters and the attribute and type information we fetched. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_GET_ATT; + + /* Send the message to IO master. */ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + + /* Send the function parameters. */ + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + int namelen = strlen(name); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&file->iotype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&atttype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&attlen, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + /* Broadcast values currently only known on computation tasks to IO tasks. */ + LOG((2, "PIOc_get_att bcast from comproot = %d attlen = %d typelen = %d", ios->comproot, attlen, typelen)); + if ((mpierr = MPI_Bcast(&attlen, 1, MPI_OFFSET, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + LOG((2, "PIOc_get_att bcast complete attlen = %d typelen = %d", attlen, typelen)); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_get_att(file->fh, varid, name, ip); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_get_att(file->fh, varid, name, ip); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Broadcast results to all tasks. */ + if (!ierr) + { + if ((mpierr = MPI_Bcast(ip, (int)attlen * typelen, MPI_BYTE, ios->ioroot, + ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + } + return ierr; +} + +/** + * @ingroup PIOc_put_att + * The PIO-C interface for the NetCDF function nc_put_att. + * + * This routine is called collectively by all tasks in the communicator + * ios.union_comm. For more information on the underlying NetCDF commmand + * please read about this function in the NetCDF documentation at: + * http://www.unidata.ucar.edu/software/netcdf/docs/group__attributes.html + * + * @param ncid the ncid of the open file, obtained from + * PIOc_openfile() or PIOc_createfile(). + * @param varid the variable ID. + * @return PIO_NOERR for success, error code otherwise. See PIOc_Set_File_Error_Handling + */ +int PIOc_put_att(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const void *op) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + PIO_Offset typelen; /* Length (in bytes) of the type. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + + LOG((1, "PIOc_put_att ncid = %d varid = %d name = %s", ncid, varid, name)); + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* Run these on all tasks if async is not in use, but only on + * non-IO tasks if async is in use. */ + if (!ios->async_interface || !ios->ioproc) + { + /* Get the length (in bytes) of the type. */ + if ((ierr = PIOc_inq_type(ncid, xtype, NULL, &typelen))) + { + check_netcdf(file, ierr, __FILE__, __LINE__); + return ierr; + } + LOG((2, "PIOc_put_att typelen = %d", ncid, typelen)); + } + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_PUT_ATT; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + if (!mpierr) + mpierr = MPI_Bcast(&file->fh, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + int namelen = strlen(name); + if (!mpierr) + mpierr = MPI_Bcast(&namelen, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)name, namelen + 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&len, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast((void *)op, len * typelen, MPI_BYTE, ios->compmaster, + ios->intercomm); + LOG((2, "PIOc_put_att finished bcast ncid = %d varid = %d namelen = %d name = %s " + "len = %d typelen = %d", file->fh, varid, namelen, name, len, typelen)); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + return check_mpi(file, mpierr, __FILE__, __LINE__); + + /* Broadcast values currently only known on computation tasks to IO tasks. */ + LOG((2, "PIOc_put_att bcast from comproot = %d typelen = %d", ios->comproot, typelen)); + if ((mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->comproot, ios->my_comm))) + check_mpi(file, mpierr, __FILE__, __LINE__); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + ierr = ncmpi_put_att(file->fh, varid, name, xtype, len, op); +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + ierr = nc_put_att(file->fh, varid, name, xtype, (size_t)len, op); +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + { + check_mpi(file, mpierr, __FILE__, __LINE__); + return PIO_EIO; + } + check_netcdf(file, ierr, __FILE__, __LINE__); + + return ierr; +} + +/** + * @ingroup PIOc_get_att_double + * The PIO-C interface for the NetCDF function nc_get_att_double. + */ +int PIOc_get_att_double(int ncid, int varid, const char *name, double *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_uchar + * The PIO-C interface for the NetCDF function nc_get_att_uchar. + */ +int PIOc_get_att_uchar (int ncid, int varid, const char *name, unsigned char *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_ushort + * The PIO-C interface for the NetCDF function nc_get_att_ushort. + */ +int PIOc_get_att_ushort (int ncid, int varid, const char *name, unsigned short *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_uint + * The PIO-C interface for the NetCDF function nc_get_att_uint. + */ +int PIOc_get_att_uint (int ncid, int varid, const char *name, unsigned int *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_long + * The PIO-C interface for the NetCDF function nc_get_att_long. + */ +int PIOc_get_att_long (int ncid, int varid, const char *name, long *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_ubyte + * The PIO-C interface for the NetCDF function nc_get_att_ubyte. + */ +int PIOc_get_att_ubyte (int ncid, int varid, const char *name, unsigned char *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_text + * The PIO-C interface for the NetCDF function nc_get_att_text. + */ +int PIOc_get_att_text (int ncid, int varid, const char *name, char *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_schar + * The PIO-C interface for the NetCDF function nc_get_att_schar. + */ +int PIOc_get_att_schar (int ncid, int varid, const char *name, signed char *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_ulonglong + * The PIO-C interface for the NetCDF function nc_get_att_ulonglong. + */ +int PIOc_get_att_ulonglong (int ncid, int varid, const char *name, unsigned long long *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_short + * The PIO-C interface for the NetCDF function nc_get_att_short. + */ +int PIOc_get_att_short (int ncid, int varid, const char *name, short *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_int + * The PIO-C interface for the NetCDF function nc_get_att_int. + */ +int PIOc_get_att_int(int ncid, int varid, const char *name, int *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_longlong + * The PIO-C interface for the NetCDF function nc_get_att_longlong. + */ +int PIOc_get_att_longlong(int ncid, int varid, const char *name, long long *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_get_att_float + * The PIO-C interface for the NetCDF function nc_get_att_float. + */ +int PIOc_get_att_float (int ncid, int varid, const char *name, float *ip) +{ + return PIOc_get_att(ncid, varid, name, (void *)ip); +} + +/** + * @ingroup PIOc_put_att_schar + * The PIO-C interface for the NetCDF function nc_put_att_schar. + */ +int PIOc_put_att_schar(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const signed char *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_long + * The PIO-C interface for the NetCDF function nc_put_att_long. + */ +int PIOc_put_att_long(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const long *op) +{ + return PIOc_put_att(ncid, varid, name, NC_CHAR, len, op); +} + +/** + * @ingroup PIOc_put_att_int + * The PIO-C interface for the NetCDF function nc_put_att_int. + */ +int PIOc_put_att_int(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const int *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_uchar + * The PIO-C interface for the NetCDF function nc_put_att_uchar. + */ +int PIOc_put_att_uchar(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const unsigned char *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_longlong + * The PIO-C interface for the NetCDF function nc_put_att_longlong. + */ +int PIOc_put_att_longlong(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const long long *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_uint + * The PIO-C interface for the NetCDF function nc_put_att_uint. + */ +int PIOc_put_att_uint(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const unsigned int *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_ubyte + * The PIO-C interface for the NetCDF function nc_put_att_ubyte. + */ +int PIOc_put_att_ubyte(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const unsigned char *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_float + * The PIO-C interface for the NetCDF function nc_put_att_float. + */ +int PIOc_put_att_float(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const float *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_ulonglong + * The PIO-C interface for the NetCDF function nc_put_att_ulonglong. + */ +int PIOc_put_att_ulonglong(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const unsigned long long *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_ushort + * The PIO-C interface for the NetCDF function nc_put_att_ushort. + */ +int PIOc_put_att_ushort(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const unsigned short *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_text + * The PIO-C interface for the NetCDF function nc_put_att_text. + */ +int PIOc_put_att_text(int ncid, int varid, const char *name, + PIO_Offset len, const char *op) +{ + return PIOc_put_att(ncid, varid, name, NC_CHAR, len, op); +} + +/** + * @ingroup PIOc_put_att_short + * The PIO-C interface for the NetCDF function nc_put_att_short. + */ +int PIOc_put_att_short(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const short *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + +/** + * @ingroup PIOc_put_att_double + * The PIO-C interface for the NetCDF function nc_put_att_double. + */ +int PIOc_put_att_double(int ncid, int varid, const char *name, nc_type xtype, + PIO_Offset len, const double *op) +{ + return PIOc_put_att(ncid, varid, name, xtype, len, op); +} + + diff --git a/externals/pio2/src/clib/pio_put_nc_async.c b/externals/pio2/src/clib/pio_put_nc_async.c new file mode 100644 index 000000000000..9ef0d63da125 --- /dev/null +++ b/externals/pio2/src/clib/pio_put_nc_async.c @@ -0,0 +1,988 @@ +/** + * @file + * PIO functions to write data. + * + * @author Ed Hartnett + * @date 2016 + * @see http://code.google.com/p/parallelio/ + */ + +#include +#include +#include + +/** + * Internal PIO function which provides a type-neutral interface to + * nc_put_vars. + * + * Users should not call this function directly. Instead, call one of + * the derived functions, depending on the type of data you are + * writing: PIOc_put_vars_text(), PIOc_put_vars_uchar(), + * PIOc_put_vars_schar(), PIOc_put_vars_ushort(), + * PIOc_put_vars_short(), PIOc_put_vars_uint(), PIOc_put_vars_int(), + * PIOc_put_vars_long(), PIOc_put_vars_float(), + * PIOc_put_vars_longlong(), PIOc_put_vars_double(), + * PIOc_put_vars_ulonglong(). + * + * This routine is called collectively by all tasks in the + * communicator ios.union_comm. + * + * @param ncid identifies the netCDF file + * @param varid the variable ID number + * @param start an array of start indicies (must have same number of + * entries as variable has dimensions). If NULL, indices of 0 will be + * used. + * @param count an array of counts (must have same number of entries + * as variable has dimensions). If NULL, counts matching the size of + * the variable will be used. + * @param stride an array of strides (must have same number of + * entries as variable has dimensions). If NULL, strides of 1 will be + * used. + * @param xtype the netCDF type of the data being passed in buf. Data + * will be automatically covnerted from this type to the type of the + * variable being written to. + * @param buf pointer to the data to be written. + * + * @return PIO_NOERR on success, error code otherwise. + * @private + */ +int PIOc_put_vars_tc(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, nc_type xtype, const void *buf) +{ + iosystem_desc_t *ios; /* Pointer to io system information. */ + file_desc_t *file; /* Pointer to file information. */ + int ierr = PIO_NOERR; /* Return code from function calls. */ + int mpierr = MPI_SUCCESS, mpierr2; /* Return code from MPI function codes. */ + int ndims; /* The number of dimensions in the variable. */ + int *dimids; /* The IDs of the dimensions for this variable. */ + PIO_Offset typelen; /* Size (in bytes) of the data type of data in buf. */ + PIO_Offset num_elem = 1; /* Number of data elements in the buffer. */ + char start_present = start ? true : false; /* Is start non-NULL? */ + char count_present = count ? true : false; /* Is count non-NULL? */ + char stride_present = stride ? true : false; /* Is stride non-NULL? */ + PIO_Offset *rstart, *rcount, *rstride; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + LOG((1, "PIOc_put_vars_tc ncid = %d varid = %d start = %d count = %d " + "stride = %d xtype = %d", ncid, varid, start, count, stride, xtype)); + + /* User must provide some data. */ + if (!buf) + return PIO_EINVAL; + + /* Find the info about this file. */ + if (!(file = pio_get_file_from_id(ncid))) + return PIO_EBADID; + ios = file->iosystem; + + /* Run these on all tasks if async is not in use, but only on + * non-IO tasks if async is in use. */ + if (!ios->async_interface || !ios->ioproc) + { + /* Get the number of dims for this var. */ + if ((ierr = PIOc_inq_varndims(ncid, varid, &ndims))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Get the length of the data type. */ + if ((ierr = PIOc_inq_type(ncid, xtype, NULL, &typelen))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + PIO_Offset dimlen[ndims]; + + /* If no count array was passed, we need to know the dimlens + * so we can calculate how many data elements are in the + * buf. */ + if (!count) + { + int dimid[ndims]; + + /* Get the dimids for this var. */ + if ((ierr = PIOc_inq_vardimid(ncid, varid, dimid))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + + /* Get the length of each dimension. */ + for (int vd = 0; vd < ndims; vd++) + if ((ierr = PIOc_inq_dimlen(ncid, dimid[vd], &dimlen[vd]))) + return check_netcdf(file, ierr, __FILE__, __LINE__); + } + + /* Allocate memory for these arrays, now that we know ndims. */ + if (!(rstart = malloc(ndims * sizeof(PIO_Offset)))) + return check_netcdf(file, PIO_ENOMEM, __FILE__, __LINE__); + if (!(rcount = malloc(ndims * sizeof(PIO_Offset)))) + return check_netcdf(file, PIO_ENOMEM, __FILE__, __LINE__); + if (!(rstride = malloc(ndims * sizeof(PIO_Offset)))) + return check_netcdf(file, PIO_ENOMEM, __FILE__, __LINE__); + + /* Figure out the real start, count, and stride arrays. (The + * user may have passed in NULLs.) */ + for (int vd = 0; vd < ndims; vd++) + { + rstart[vd] = start ? start[vd] : 0; + rcount[vd] = count ? count[vd] : dimlen[vd]; + rstride[vd] = stride ? stride[vd] : 1; + } + + /* How many elements in buf? */ + for (int vd = 0; vd < ndims; vd++) + num_elem *= (rcount[vd] - rstart[vd])/rstride[vd]; + LOG((2, "PIOc_put_vars_tc num_elem = %d", num_elem)); + } + + /* If async is in use, and this is not an IO task, bcast the parameters. */ + if (ios->async_interface) + { + if (!ios->ioproc) + { + int msg = PIO_MSG_PUT_VARS; + + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + + /* Send the function parameters and associated informaiton + * to the msg handler. */ + if (!mpierr) + mpierr = MPI_Bcast(&ncid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&varid, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&ndims, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&start_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr && start_present) + mpierr = MPI_Bcast((PIO_Offset *)start, ndims, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&count_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr && count_present) + mpierr = MPI_Bcast((PIO_Offset *)count, ndims, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&stride_present, 1, MPI_CHAR, ios->compmaster, ios->intercomm); + if (!mpierr && stride_present) + mpierr = MPI_Bcast((PIO_Offset *)stride, ndims, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&xtype, 1, MPI_INT, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&num_elem, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + if (!mpierr) + mpierr = MPI_Bcast(&typelen, 1, MPI_OFFSET, ios->compmaster, ios->intercomm); + LOG((2, "PIOc_put_vars_tc ncid = %d varid = %d ndims = %d start_present = %d " + "count_present = %d stride_present = %d xtype = %d num_elem = %d", ncid, varid, + ndims, start_present, count_present, stride_present, xtype, num_elem)); + + /* Send the data. */ + if (!mpierr) + mpierr = MPI_Bcast((void *)buf, num_elem * typelen, MPI_BYTE, ios->compmaster, + ios->intercomm); + } + + /* Handle MPI errors. */ + if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr2, __FILE__, __LINE__); + if (mpierr) + check_mpi(file, mpierr, __FILE__, __LINE__); + LOG((2, "PIOc_put_vars_tc checked mpierr = %d", mpierr)); + + /* Broadcast values currently only known on computation tasks to IO tasks. */ + LOG((2, "PIOc_put_vars_tc bcast from comproot")); + if ((mpierr = MPI_Bcast(&ndims, 1, MPI_INT, ios->comproot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + LOG((2, "PIOc_put_vars_tc complete bcast from comproot ndims = %d", ndims)); + } + + /* If this is an IO task, then call the netCDF function. */ + if (ios->ioproc) + { +#ifdef _PNETCDF + if (file->iotype == PIO_IOTYPE_PNETCDF) + { + PIO_Offset *fake_stride; + + if (!stride_present) + { + LOG((2, "stride not present")); + if (!(fake_stride = malloc(ndims * sizeof(PIO_Offset)))) + return PIO_ENOMEM; + for (int d = 0; d < ndims; d++) + fake_stride[d] = 1; + } + else + fake_stride = (PIO_Offset *)stride; + + LOG((2, "PIOc_put_vars_tc calling pnetcdf function")); + vdesc = file->varlist + varid; + if (vdesc->nreqs % PIO_REQUEST_ALLOC_CHUNK == 0) + vdesc->request = realloc(vdesc->request, + sizeof(int) * (vdesc->nreqs + PIO_REQUEST_ALLOC_CHUNK)); + request = vdesc->request + vdesc->nreqs; + LOG((2, "PIOc_put_vars_tc request = %d", vdesc->request)); + + /* Only the IO master actually does the call. */ + if (ios->iomaster) + { +/* LOG((2, "PIOc_put_vars_tc ncid = %d varid = %d start[0] = %d count[0] = %d fake_stride[0] = %d", + ncid, varid, start[0], count[0], fake_stride[0]));*/ + /* for (int d = 0; d < ndims; d++) */ + /* LOG((2, "start[%d] = %d count[%d] = %d stride[%d] = %d", d, start[d], d, count[d], d, stride[d])); */ + switch(xtype) + { + case NC_BYTE: + ierr = ncmpi_bput_vars_schar(ncid, varid, start, count, fake_stride, buf, request); + break; + case NC_CHAR: + ierr = ncmpi_bput_vars_text(ncid, varid, start, count, fake_stride, buf, request); + break; + case NC_SHORT: + ierr = ncmpi_bput_vars_short(ncid, varid, start, count, fake_stride, buf, request); + break; + case NC_INT: + LOG((2, "PIOc_put_vars_tc io_rank 0 doing pnetcdf for int")); + ierr = ncmpi_bput_vars_int(ncid, varid, start, count, fake_stride, buf, request); + LOG((2, "PIOc_put_vars_tc io_rank 0 done with pnetcdf call for int ierr = %d", ierr)); + break; + case NC_FLOAT: + ierr = ncmpi_bput_vars_float(ncid, varid, start, count, fake_stride, buf, request); + break; + case NC_DOUBLE: + ierr = ncmpi_bput_vars_double(ncid, varid, start, count, fake_stride, buf, request); + break; + case NC_INT64: + ierr = ncmpi_bput_vars_longlong(ncid, varid, start, count, fake_stride, buf, request); + break; + default: + LOG((0, "Unknown type for pnetcdf file! xtype = %d", xtype)); + } + LOG((2, "PIOc_put_vars_tc io_rank 0 done with pnetcdf call")); + } + else + *request = PIO_REQ_NULL; + + vdesc->nreqs++; + LOG((2, "PIOc_put_vars_tc flushing output buffer")); + flush_output_buffer(file, false, 0); + LOG((2, "PIOc_put_vars_tc flushed output buffer")); + + /* Free malloced resources. */ + if (!stride_present) + free(fake_stride); + } +#endif /* _PNETCDF */ +#ifdef _NETCDF + if (file->iotype != PIO_IOTYPE_PNETCDF && file->do_io) + { + LOG((2, "PIOc_put_vars_tc calling netcdf function file->iotype = %d", + file->iotype)); + switch(xtype) + { + case NC_BYTE: + ierr = nc_put_vars_schar(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_CHAR: + ierr = nc_put_vars_schar(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_SHORT: + ierr = nc_put_vars_short(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_INT: + ierr = nc_put_vars_int(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_FLOAT: + ierr = nc_put_vars_float(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_DOUBLE: + ierr = nc_put_vars_double(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; +#ifdef _NETCDF4 + case NC_UBYTE: + ierr = nc_put_vars_uchar(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_USHORT: + ierr = nc_put_vars_ushort(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_UINT: + ierr = nc_put_vars_uint(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_INT64: + ierr = nc_put_vars_longlong(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + case NC_UINT64: + ierr = nc_put_vars_ulonglong(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); + break; + /* case NC_STRING: */ + /* ierr = nc_put_vars_string(ncid, varid, (size_t *)start, (size_t *)count, */ + /* (ptrdiff_t *)stride, (void *)buf); */ + /* break; */ + default: + ierr = nc_put_vars(ncid, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf); +#endif /* _NETCDF4 */ + } + } +#endif /* _NETCDF */ + } + + /* Broadcast and check the return code. */ + LOG((2, "PIOc_put_vars_tc bcasting netcdf return code %d", ierr)); + if ((mpierr = MPI_Bcast(&ierr, 1, MPI_INT, ios->ioroot, ios->my_comm))) + return check_mpi(file, mpierr, __FILE__, __LINE__); + if (ierr) + return check_netcdf(file, ierr, __FILE__, __LINE__); + LOG((2, "PIOc_put_vars_tc bcast netcdf return code %d complete", ierr)); + + return ierr; +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_text(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const char *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_CHAR, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_uchar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, + const unsigned char *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_UBYTE, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_schar(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const signed char *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_BYTE, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_ushort(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const unsigned short *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_USHORT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_short(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const PIO_Offset *stride, const short *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_SHORT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_uint(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const unsigned int *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_UINT, op); +} + +/** PIO interface to nc_put_vars_int */ +int PIOc_put_vars_int(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const int *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_INT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_long(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const long *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_INT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_float(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const float *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_FLOAT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_longlong(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const long long *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_INT64, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_double(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const double *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_DOUBLE, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vars_ulonglong(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const unsigned long long *op) +{ + return PIOc_put_vars_tc(ncid, varid, start, count, stride, NC_UINT64, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_tc(int ncid, int varid, const PIO_Offset *index, nc_type xtype, + const void *op) +{ + int ndims; + int ierr; + + /* Find the number of dimensions. */ + if ((ierr = PIOc_inq_varndims(ncid, varid, &ndims))) + return ierr; + + /* Set up count array. */ + PIO_Offset count[ndims]; + for (int c = 0; c < ndims; c++) + count[c] = 1; + + return PIOc_put_vars_tc(ncid, varid, index, count, NULL, xtype, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_text(int ncid, int varid, const PIO_Offset *index, const char *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_CHAR, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_uchar(int ncid, int varid, const PIO_Offset *index, + const unsigned char *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_UBYTE, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_schar(int ncid, int varid, const PIO_Offset *index, + const signed char *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_BYTE, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_ushort(int ncid, int varid, const PIO_Offset *index, + const unsigned short *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_USHORT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_short(int ncid, int varid, const PIO_Offset *index, + const short *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_SHORT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_uint(int ncid, int varid, const PIO_Offset *index, + const unsigned int *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_UINT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_int(int ncid, int varid, const PIO_Offset *index, const int *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_INT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_float(int ncid, int varid, const PIO_Offset *index, const float *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_FLOAT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_long(int ncid, int varid, const PIO_Offset *index, const long *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_LONG, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_double(int ncid, int varid, const PIO_Offset *index, + const double *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_DOUBLE, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_ulonglong(int ncid, int varid, const PIO_Offset *index, + const unsigned long long *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_UINT64, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1_longlong(int ncid, int varid, const PIO_Offset *index, + const long long *op) +{ + return PIOc_put_var1_tc(ncid, varid, index, NC_INT64, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_text(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const char *op) +{ + return PIOc_put_vars_text(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_uchar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const unsigned char *op) +{ + return PIOc_put_vars_uchar(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_schar(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const signed char *op) +{ + return PIOc_put_vars_schar(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_ushort(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const unsigned short *op) +{ + return PIOc_put_vars_ushort(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_short(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const short *op) +{ + return PIOc_put_vars_short(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_uint(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const unsigned int *op) +{ + return PIOc_put_vars_uint(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_int(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const int *op) +{ + return PIOc_put_vars_int(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_long(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const long *op) +{ + return PIOc_put_vars_long(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_float(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const float *op) +{ + return PIOc_put_vars_float(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_ulonglong(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const unsigned long long *op) +{ + return PIOc_put_vars_ulonglong(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_longlong(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const long long *op) +{ + return PIOc_put_vars_longlong(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara_double(int ncid, int varid, const PIO_Offset *start, + const PIO_Offset *count, const double *op) +{ + return PIOc_put_vars_double(ncid, varid, start, count, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_text(int ncid, int varid, const char *op) +{ + return PIOc_put_vars_text(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_uchar(int ncid, int varid, const unsigned char *op) +{ + return PIOc_put_vars_uchar(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_schar(int ncid, int varid, const signed char *op) +{ + return PIOc_put_vars_schar(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_ushort(int ncid, int varid, const unsigned short *op) +{ + return PIOc_put_vars_tc(ncid, varid, NULL, NULL, NULL, NC_USHORT, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_short(int ncid, int varid, const short *op) +{ + return PIOc_put_vars_short(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_uint(int ncid, int varid, const unsigned int *op) +{ + return PIOc_put_vars_uint(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_int(int ncid, int varid, const int *op) +{ + return PIOc_put_vars_int(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_long(int ncid, int varid, const long *op) +{ + return PIOc_put_vars_long(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_float(int ncid, int varid, const float *op) +{ + return PIOc_put_vars_float(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_ulonglong(int ncid, int varid, const unsigned long long *op) +{ + return PIOc_put_vars_ulonglong(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_longlong(int ncid, int varid, const long long *op) +{ + return PIOc_put_vars_longlong(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var_double(int ncid, int varid, const double *op) +{ + return PIOc_put_vars_double(ncid, varid, NULL, NULL, NULL, op); +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var(int ncid, int varid, const void *buf, PIO_Offset bufcount, + MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VAR; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_var(file->fh, varid, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_var(file->fh, varid, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_var(file->fh, varid, buf, bufcount, buftype, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/** + * PIO interface to nc_put_vars + * + * This routine is called collectively by all tasks in the + * communicator ios.union_comm. + + * Refer to the + * netcdf documentation. */ +int PIOc_put_vars(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, + const PIO_Offset *stride, const void *buf, PIO_Offset bufcount, + MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARS; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_vars(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_vars(file->fh, varid, (size_t *)start, (size_t *)count, + (ptrdiff_t *)stride, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_vars(file->fh, varid, start, count, stride, buf, + bufcount, buftype, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/** Interface to netCDF data write function. */ +int PIOc_put_var1(int ncid, int varid, const PIO_Offset *index, const void *buf, + PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VAR1; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_var1(file->fh, varid, (size_t *) index, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_var1(file->fh, varid, (size_t *) index, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_var1(file->fh, varid, index, buf, bufcount, buftype, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/** Interface to netCDF data write function. */ +int PIOc_put_vara(int ncid, int varid, const PIO_Offset *start, const PIO_Offset *count, const void *buf, + PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARA; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, ios->compmaster, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_vara(file->fh, varid, (size_t *) start, (size_t *) count, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_vara(file->fh, varid, (size_t *) start, (size_t *) count, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_vara(file->fh, varid, start, count, buf, bufcount, buftype, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} diff --git a/externals/pio2/src/clib/pio_varm.c b/externals/pio2/src/clib/pio_varm.c new file mode 100644 index 000000000000..3110a4333f39 --- /dev/null +++ b/externals/pio2/src/clib/pio_varm.c @@ -0,0 +1,1990 @@ +#include +#include +#include + +/// +/// PIO interface to nc_put_varm +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const void *buf, PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm(file->fh, varid, start, count, stride, imap, buf, bufcount, buftype, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_uchar +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned char *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_UCHAR; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_uchar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_uchar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_uchar(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_short +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const short *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_SHORT; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_short(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_short(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_short(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} +/// +/// PIO interface to nc_put_varm_text +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const char *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_TEXT; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_text(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_text(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_text(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_ushort +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned short *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_USHORT; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_ushort(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_ushort(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_ushort(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_ulonglong +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned long long *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_ULONGLONG; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_ulonglong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_ulonglong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_ulonglong(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} +/// +/// PIO interface to nc_put_varm_int +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const int *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_INT; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_int(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_int(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_int(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_float +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const float *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_FLOAT; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_float(file->fh, varid,(size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_float(file->fh, varid,(size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_float(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} +/// +/// PIO interface to nc_put_varm_long +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const long *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_LONG; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_long(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_long(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_long(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_uint +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const unsigned int *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_UINT; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_uint(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_uint(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_uint(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_double +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const double *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_DOUBLE; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_double(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_double(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_double(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} +/// +/// PIO interface to nc_put_varm_schar +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const signed char *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_SCHAR; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_schar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_schar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_schar(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +/// +/// PIO interface to nc_put_varm_longlong +/// +/// This routine is called collectively by all tasks in the communicator ios.union_comm. +/// +/// Refer to the netcdf documentation. +/// +int PIOc_put_varm_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], const long long *op) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + var_desc_t *vdesc; + PIO_Offset usage; + int *request; + + ierr = PIO_NOERR; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_PUT_VARM_LONGLONG; + + /* Sorry, but varm functions are not supported by the async interface. */ + if(ios->async_interface) + return PIO_EINVAL; + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_var_par_access(file->fh, varid, NC_COLLECTIVE); + ierr = nc_put_varm_longlong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + if(ios->io_rank==0){ + ierr = nc_put_varm_longlong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, op);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: + vdesc = file->varlist + varid; + + if(vdesc->nreqs%PIO_REQUEST_ALLOC_CHUNK == 0 ){ + vdesc->request = realloc(vdesc->request, + sizeof(int)*(vdesc->nreqs+PIO_REQUEST_ALLOC_CHUNK)); + } + request = vdesc->request+vdesc->nreqs; + + if(ios->io_rank==0){ + ierr = ncmpi_bput_varm_longlong(file->fh, varid, start, count, stride, imap, op, request);; + }else{ + *request = PIO_REQ_NULL; + } + vdesc->nreqs++; + flush_output_buffer(file, false, 0); + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + return ierr; +} + +int PIOc_get_varm_uchar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned char *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_UCHAR; + ibuftype = MPI_UNSIGNED_CHAR; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_uchar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_uchar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_uchar(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_uchar_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_schar (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], signed char *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_SCHAR; + ibuftype = MPI_CHAR; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_schar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_schar(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_schar(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_schar_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_double (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], double *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_DOUBLE; + ibuftype = MPI_DOUBLE; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_double(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_double(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_double(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_double_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_text (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], char *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_TEXT; + ibuftype = MPI_CHAR; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_text(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_text(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_text(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_text_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_int (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], int *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_INT; + ibuftype = MPI_INT; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_int(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_int(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_int(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_int_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_uint (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned int *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_UINT; + ibuftype = MPI_UNSIGNED; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_uint(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_uint(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_uint(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_uint_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], void *buf, PIO_Offset bufcount, MPI_Datatype buftype) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM; + ibufcnt = bufcount; + ibuftype = buftype; + ierr = PIO_NOERR; + + if(ios->async_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm(file->fh, varid, start, count, stride, imap, buf, bufcount, buftype);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_all(file->fh, varid, start, count, stride, imap, buf, bufcount, buftype);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_float (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], float *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_FLOAT; + ibuftype = MPI_FLOAT; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_float(file->fh, varid,(size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_float(file->fh, varid,(size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_float(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_float_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_long (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], long *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_LONG; + ibuftype = MPI_LONG; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_long(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_long(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_long(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_long_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_ushort (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned short *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_USHORT; + ibuftype = MPI_UNSIGNED_SHORT; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_ushort(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_ushort(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_ushort(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_ushort_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_longlong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], long long *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_LONGLONG; + ibuftype = MPI_LONG_LONG; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_longlong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_longlong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_longlong(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_longlong_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_short (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], short *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_SHORT; + ibuftype = MPI_SHORT; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_short(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_short(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_short(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_short_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + +int PIOc_get_varm_ulonglong (int ncid, int varid, const PIO_Offset start[], const PIO_Offset count[], const PIO_Offset stride[], const PIO_Offset imap[], unsigned long long *buf) +{ + int ierr; + int msg; + int mpierr; + iosystem_desc_t *ios; + file_desc_t *file; + MPI_Datatype ibuftype; + int ndims; + int ibufcnt; + bool bcast = false; + + file = pio_get_file_from_id(ncid); + if(file == NULL) + return PIO_EBADID; + ios = file->iosystem; + msg = PIO_MSG_GET_VARM_ULONGLONG; + ibuftype = MPI_UNSIGNED_LONG_LONG; + ierr = PIOc_inq_varndims(file->fh, varid, &ndims); + ibufcnt = 1; + for(int i=0;iasync_interface && ! ios->ioproc){ + if(ios->compmaster) + mpierr = MPI_Send(&msg, 1,MPI_INT, ios->ioroot, 1, ios->union_comm); + mpierr = MPI_Bcast(&(file->fh),1, MPI_INT, 0, ios->intercomm); + } + + + if(ios->ioproc){ + switch(file->iotype){ +#ifdef _NETCDF +#ifdef _NETCDF4 + case PIO_IOTYPE_NETCDF4P: + ierr = nc_get_varm_ulonglong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + break; + case PIO_IOTYPE_NETCDF4C: +#endif + case PIO_IOTYPE_NETCDF: + bcast = true; + if(ios->iomaster){ + ierr = nc_get_varm_ulonglong(file->fh, varid, (size_t *) start, (size_t *) count, (ptrdiff_t *) stride, (ptrdiff_t *) imap, buf);; + } + break; +#endif +#ifdef _PNETCDF + case PIO_IOTYPE_PNETCDF: +#ifdef PNET_READ_AND_BCAST + ncmpi_begin_indep_data(file->fh); + if(ios->iomaster){ + ierr = ncmpi_get_varm_ulonglong(file->fh, varid, start, count, stride, imap, buf);; + }; + ncmpi_end_indep_data(file->fh); + bcast=true; +#else + ierr = ncmpi_get_varm_ulonglong_all(file->fh, varid, start, count, stride, imap, buf);; +#endif + break; +#endif + default: + ierr = iotype_error(file->iotype,__FILE__,__LINE__); + } + } + + ierr = check_netcdf(file, ierr, __FILE__,__LINE__); + + if(ios->async_interface || bcast || + (ios->num_iotasks < ios->num_comptasks)){ + MPI_Bcast(buf, ibufcnt, ibuftype, ios->ioroot, ios->my_comm); + } + + return ierr; +} + diff --git a/externals/pio2/src/clib/pioc.c b/externals/pio2/src/clib/pioc.c index 17983d298c7f..97afd9489775 100644 --- a/externals/pio2/src/clib/pioc.c +++ b/externals/pio2/src/clib/pioc.c @@ -1,17 +1,16 @@ /** - * @file + * @file * @author Jim Edwards * @date 2014 - * @brief PIO C interface + * @brief PIO C interface * * @see http://code.google.com/p/parallelio/ */ - +#include #include #include - static int counter=0; /** @@ -23,7 +22,7 @@ int PIOc_iosystem_is_active(const int iosysid, bool *active) ios = pio_get_iosystem_from_id(iosysid); if(ios == NULL) return PIO_EBADID; - + if(ios->comp_comm == MPI_COMM_NULL && ios->io_comm == MPI_COMM_NULL){ *active = false; }else{ @@ -46,7 +45,7 @@ int PIOc_File_is_Open(int ncid) } /** - ** @brief Set the error handling method to be used for subsequent + ** @brief Set the error handling method to be used for subsequent ** pio library calls, returns the previous method setting */ int PIOc_Set_File_Error_Handling(int ncid, int method) @@ -57,7 +56,7 @@ int PIOc_Set_File_Error_Handling(int ncid, int method) oldmethod = file->iosystem->error_handler; file->iosystem->error_handler = method; return(oldmethod); -} +} /** ** @brief Increment the unlimited dimension of the given variable @@ -72,12 +71,12 @@ int PIOc_advanceframe(int ncid, int varid) file->varlist[varid].record++; return(PIO_NOERR); -} +} /** - * @ingroup PIO_setframe + * @ingroup PIO_setframe * @brief Set the unlimited dimension of the given variable - * + * * @param ncid the ncid of the file. * @param varid the varid of the variable * @param frame the value of the unlimited dimension. In c 0 for the @@ -96,7 +95,7 @@ int PIOc_setframe(const int ncid, const int varid, const int frame) file->varlist[varid].record = frame; return(PIO_NOERR); -} +} /** ** @brief Get the number of IO tasks set. @@ -156,11 +155,11 @@ int PIOc_get_local_array_size(int ioid) fprintf(stderr,"%s %d Error setting eh method\n",__FILE__,__LINE__); print_trace(stderr); return PIO_EBADID; - } + } oldmethod = ios->error_handler; ios->error_handler = method; return(oldmethod); -} +} /** ** @ingroup PIO_initdecomp @@ -176,10 +175,8 @@ int PIOc_get_local_array_size(int ioid) ** @param iostart An optional array of start values for block cyclic decompositions (optional input) ** @param iocount An optional array of count values for block cyclic decompositions (optional input) */ - - -int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const int dims[], - const int maplen, const PIO_Offset *compmap, int *ioidp,const int *rearranger, +int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const int dims[], + const int maplen, const PIO_Offset *compmap, int *ioidp,const int *rearranger, const PIO_Offset *iostart,const PIO_Offset *iocount) { iosystem_desc_t *ios; @@ -189,8 +186,6 @@ int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const int iosize; int ndisp; - - for(int i=0;inum_comptasks,ndims,counter); } - PIOc_writemap(filename,ndims,dims,maplen,compmap,ios->comp_comm); + PIOc_writemap(filename,ndims,dims,maplen, (PIO_Offset *)compmap,ios->comp_comm); counter++; } @@ -220,29 +215,29 @@ int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const iodesc->rearranger = ios->default_rearranger; else iodesc->rearranger = *rearranger; - + if(iodesc->rearranger==PIO_REARR_SUBSET){ - if((iostart != NULL) && (iocount != NULL)){ + if((iostart != NULL) && (iocount != NULL)){ fprintf(stderr,"%s %s\n","Iostart and iocount arguments to PIOc_InitDecomp", "are incompatable with subset rearrange method and will be ignored"); } iodesc->num_aiotasks = ios->num_iotasks; ierr = subset_rearrange_create( *ios, maplen, compmap, dims, ndims, iodesc); - }else{ + }else{ if(ios->ioproc){ - // Unless the user specifies the start and count for each IO task compute it. - if((iostart != NULL) && (iocount != NULL)){ + // Unless the user specifies the start and count for each IO task compute it. + if((iostart != NULL) && (iocount != NULL)){ // printf("iocount[0] = %ld %ld\n",iocount[0], iocount); iodesc->maxiobuflen=1; for(int i=0;ifirstregion->start[i] = iostart[i]; iodesc->firstregion->count[i] = iocount[i]; compute_maxIObuffersize(ios->io_comm, iodesc); - + } iodesc->num_aiotasks = ios->num_iotasks; }else{ - iodesc->num_aiotasks = CalcStartandCount(basetype, ndims, dims, + iodesc->num_aiotasks = CalcStartandCount(basetype, ndims, dims, ios->num_iotasks, ios->io_rank, iodesc->firstregion->start, iodesc->firstregion->count); } @@ -253,7 +248,7 @@ int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const CheckMPIReturn(MPI_Bcast(&(iodesc->num_aiotasks), 1, MPI_INT, ios->ioroot, ios->my_comm),__FILE__,__LINE__); // Compute the communications pattern for this decomposition - if(iodesc->rearranger==PIO_REARR_BOX){ + if(iodesc->rearranger==PIO_REARR_BOX){ ierr = box_rearrange_create( *ios, maplen, compmap, dims, ndims, iodesc); } /* @@ -271,21 +266,19 @@ int PIOc_InitDecomp(const int iosysid, const int basetype,const int ndims, const *ioidp = pio_add_to_iodesc_list(iodesc); performance_tune_rearranger(*ios, iodesc); - + return PIO_NOERR; } /** ** @ingroup PIO_initdecomp - ** This is a simplified initdecomp which can be used if the memory order of the data can be + ** This is a simplified initdecomp which can be used if the memory order of the data can be ** expressed in terms of start and count on the file. ** in this case we compute the compdof and use the subset rearranger */ - - -int PIOc_InitDecomp_bc(const int iosysid, const int basetype,const int ndims, const int dims[], +int PIOc_InitDecomp_bc(const int iosysid, const int basetype,const int ndims, const int dims[], const long int start[], const long int count[], int *ioidp) - + { iosystem_desc_t *ios; io_desc_t *iodesc; @@ -294,7 +287,7 @@ int PIOc_InitDecomp_bc(const int iosysid, const int basetype,const int ndims, co int iosize; int ndisp; - + for(int i=0;i=0;n--){ - prod[n]=prod[n+1]*dims[n+1]; + prod[n]=prod[n+1]*dims[n+1]; loc[n]=0; } for(i=0;iunion_comm = comp_comm; - iosys->comp_comm = comp_comm; - iosys->my_comm = comp_comm; - iosys->io_comm = MPI_COMM_NULL; - iosys->intercomm = MPI_COMM_NULL; - iosys->error_handler = PIO_INTERNAL_ERROR; - iosys->async_interface= false; - iosys->compmaster = false; - iosys->iomaster = false; - iosys->ioproc = false; - iosys->default_rearranger = rearr; - iosys->num_iotasks = num_iotasks; - - ustride = stride; - - CheckMPIReturn(MPI_Comm_rank(comp_comm, &(iosys->comp_rank)),__FILE__,__LINE__); - CheckMPIReturn(MPI_Comm_size(comp_comm, &(iosys->num_comptasks)),__FILE__,__LINE__); - if(iosys->comp_rank==0) - iosys->compmaster = true; - -#ifdef BGQxxx - lbase = base; - determineiotasks(comp_comm, &(iosys->num_iotasks), &lbase, &stride, &rearr, &(iosys->ioproc)); - if(iosys->comp_rank==0) - printf("%s %d %d\n",__FILE__,__LINE__,iosys->num_iotasks); - if(iosys->ioproc) - printf("%s %d %d\n",__FILE__,__LINE__,iosys->comp_rank); - -#else - if((iosys->num_comptasks == 1) && (num_iotasks*ustride > 1)) { - // This is a serial run with a bad configuration. Set up a single task. - fprintf(stderr, "PIO_TP PIOc_Init_Intracomm reset stride and tasks.\n"); - iosys->num_iotasks = 1; - ustride = 1; - } - if((iosys->num_iotasks < 1) || ((iosys->num_iotasks*ustride) > iosys->num_comptasks)){ - fprintf(stderr, "PIO_TP PIOc_Init_Intracomm error\n"); - fprintf(stderr, "num_iotasks=%d, ustride=%d, num_comptasks=%d\n", num_iotasks, ustride, iosys->num_comptasks); - return PIO_EBADID; - } - iosys->ioranks = (int *) calloc(sizeof(int), iosys->num_iotasks); - for(int i=0;i< iosys->num_iotasks; i++){ - iosys->ioranks[i] = (base + i*ustride) % iosys->num_comptasks; - if(iosys->ioranks[i] == iosys->comp_rank) - iosys->ioproc = true; + /* Copy the computation communicator into union_comm. */ + mpierr = MPI_Comm_dup(comp_comm, &iosys->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; + + /* Copy the computation communicator into comp_comm. */ + if (!ierr) + { + mpierr = MPI_Comm_dup(comp_comm, &iosys->comp_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); + if (mpierr) + ierr = PIO_EIO; } - iosys->ioroot = iosys->ioranks[0]; -#endif - CheckMPIReturn(MPI_Info_create(&(iosys->info)),__FILE__,__LINE__); - iosys->info = MPI_INFO_NULL; + if (!ierr) + { + iosys->my_comm = iosys->comp_comm; + iosys->io_comm = MPI_COMM_NULL; + iosys->intercomm = MPI_COMM_NULL; + iosys->error_handler = PIO_INTERNAL_ERROR; + iosys->async_interface= false; + iosys->compmaster = 0; + iosys->iomaster = 0; + iosys->ioproc = false; + iosys->default_rearranger = rearr; + iosys->num_iotasks = num_iotasks; + + ustride = stride; + + /* Find MPI rank and number of tasks in comp_comm communicator. */ + CheckMPIReturn(MPI_Comm_rank(iosys->comp_comm, &(iosys->comp_rank)),__FILE__,__LINE__); + CheckMPIReturn(MPI_Comm_size(iosys->comp_comm, &(iosys->num_comptasks)),__FILE__,__LINE__); + if(iosys->comp_rank==0) + iosys->compmaster = MPI_ROOT; + + /* Ensure that settings for number of computation tasks, number + * of IO tasks, and the stride are reasonable. */ + if((iosys->num_comptasks == 1) && (num_iotasks*ustride > 1)) { + // This is a serial run with a bad configuration. Set up a single task. + fprintf(stderr, "PIO_TP PIOc_Init_Intracomm reset stride and tasks.\n"); + iosys->num_iotasks = 1; + ustride = 1; + } + if((iosys->num_iotasks < 1) || ((iosys->num_iotasks*ustride) > iosys->num_comptasks)){ + fprintf(stderr, "PIO_TP PIOc_Init_Intracomm error\n"); + fprintf(stderr, "num_iotasks=%d, ustride=%d, num_comptasks=%d\n", num_iotasks, ustride, iosys->num_comptasks); + return PIO_EBADID; + } - if(iosys->comp_rank == iosys->ioranks[0]) - iosys->iomaster = true; + /* Create an array that holds the ranks of the tasks to be used for IO. */ + iosys->ioranks = (int *) calloc(sizeof(int), iosys->num_iotasks); + for(int i=0;i< iosys->num_iotasks; i++){ + iosys->ioranks[i] = (base + i*ustride) % iosys->num_comptasks; + if(iosys->ioranks[i] == iosys->comp_rank) + iosys->ioproc = true; + } + iosys->ioroot = iosys->ioranks[0]; - CheckMPIReturn(MPI_Comm_group(comp_comm, &(iosys->compgroup)),__FILE__,__LINE__); + /* Create an MPI info object. */ + CheckMPIReturn(MPI_Info_create(&(iosys->info)),__FILE__,__LINE__); + iosys->info = MPI_INFO_NULL; - CheckMPIReturn(MPI_Group_incl(iosys->compgroup, iosys->num_iotasks, iosys->ioranks, - &(iosys->iogroup)),__FILE__,__LINE__); + if(iosys->comp_rank == iosys->ioranks[0]) + iosys->iomaster = MPI_ROOT; - CheckMPIReturn(MPI_Comm_create(comp_comm, iosys->iogroup, &(iosys->io_comm)),__FILE__,__LINE__); - if(iosys->ioproc) - CheckMPIReturn(MPI_Comm_rank(iosys->io_comm, &(iosys->io_rank)),__FILE__,__LINE__); - else - iosys->io_rank = -1; + /* Create a group for the computation tasks. */ + CheckMPIReturn(MPI_Comm_group(iosys->comp_comm, &(iosys->compgroup)),__FILE__,__LINE__); + + /* Create a group for the IO tasks. */ + CheckMPIReturn(MPI_Group_incl(iosys->compgroup, iosys->num_iotasks, iosys->ioranks, + &(iosys->iogroup)),__FILE__,__LINE__); - iosys->union_rank = iosys->comp_rank; + /* Create an MPI communicator for the IO tasks. */ + CheckMPIReturn(MPI_Comm_create(iosys->comp_comm, iosys->iogroup, &(iosys->io_comm)) + ,__FILE__,__LINE__); - *iosysidp = pio_add_to_iosystem_list(iosys); + /* For the tasks that are doing IO, get their rank. */ + if (iosys->ioproc) + CheckMPIReturn(MPI_Comm_rank(iosys->io_comm, &(iosys->io_rank)),__FILE__,__LINE__); + else + iosys->io_rank = -1; - pio_get_env(); + iosys->union_rank = iosys->comp_rank; - /* allocate buffer space for compute nodes */ - compute_buffer_init(*iosys); + /* Add this iosys struct to the list in the PIO library. */ + *iosysidp = pio_add_to_iosystem_list(iosys); - return PIO_NOERR; + pio_get_env(); + + /* allocate buffer space for compute nodes */ + compute_buffer_init(*iosys); + } + + return ierr; } /** - ** @internal + ** @internal ** interface to call from pio_init from fortran ** @endinternal */ -int PIOc_Init_Intracomm_from_F90(int f90_comp_comm, - const int num_iotasks, const int stride, +int PIOc_Init_Intracomm_from_F90(int f90_comp_comm, + const int num_iotasks, const int stride, const int base, const int rearr, int *iosysidp){ return PIOc_Init_Intracomm(MPI_Comm_f2c(f90_comp_comm), num_iotasks, stride,base,rearr, iosysidp); } - + /** - ** @brief Send a hint to the MPI-IO library + ** @brief Send a hint to the MPI-IO library ** */ int PIOc_set_hint(const int iosysid, char hint[], const char hintval[]) @@ -469,8 +497,9 @@ int PIOc_set_hint(const int iosysid, char hint[], const char hintval[]) } -/** @ingroup PIO_finalize - * @brief Clean up data structures and exit the pio library. +/** @ingroup PIO_finalize + * Clean up internal data structures, free MPI resources, and exit the + * pio library. * * @param iosysid: the io system ID provided by PIOc_Init_Intracomm(). * @@ -480,44 +509,57 @@ int PIOc_set_hint(const int iosysid, char hint[], const char hintval[]) int PIOc_finalize(const int iosysid) { iosystem_desc_t *ios, *nios; + int msg; + int mpierr; ios = pio_get_iosystem_from_id(iosysid); if(ios == NULL) return PIO_EBADID; - /* FIXME: The memory for ioranks is allocated in C only for intracomms - * Remove this check once mem allocs for ioranks completely moves to the - * C code - */ - if(ios->intercomm == MPI_COMM_NULL){ - if(ios->ioranks != NULL){ - free(ios->ioranks); - } + + /* If asynch IO is in use, send the PIO_MSG_EXIT message from the + * comp master to the IO processes. */ + if (ios->async_interface && !ios->comp_rank) + { + msg = PIO_MSG_EXIT; + mpierr = MPI_Send(&msg, 1, MPI_INT, ios->ioroot, 1, ios->union_comm); + CheckMPIReturn(mpierr, __FILE__, __LINE__); } + /* Free this memory that was allocated in init_intracomm. */ + if (ios->ioranks) + free(ios->ioranks); + + /* Free the buffer pool. */ free_cn_buffer_pool(*ios); /* Free the MPI groups. */ - MPI_Group_free(&(ios->compgroup)); - MPI_Group_free(&(ios->iogroup)); + if (ios->compgroup != MPI_GROUP_NULL) + MPI_Group_free(&ios->compgroup); - /* Free the MPI communicators. */ + if (ios->iogroup != MPI_GROUP_NULL) + MPI_Group_free(&(ios->iogroup)); + + /* Free the MPI communicators. my_comm is just a copy (but not an + * MPI copy), so does not have to have an MPI_Comm_free() call. */ if(ios->intercomm != MPI_COMM_NULL){ MPI_Comm_free(&(ios->intercomm)); } if(ios->io_comm != MPI_COMM_NULL){ MPI_Comm_free(&(ios->io_comm)); } - /* if(ios->comp_comm != MPI_COMM_NULL){ */ - /* MPI_Comm_free(&(ios->comp_comm)); */ - /* } */ + if(ios->comp_comm != MPI_COMM_NULL){ + MPI_Comm_free(&(ios->comp_comm)); + } + if(ios->union_comm != MPI_COMM_NULL){ + MPI_Comm_free(&(ios->union_comm)); + } + /* Delete the iosystem_desc_t data associated with this id. */ return pio_delete_iosystem_from_list(iosysid); - - } /** - ** @brief return a logical indicating whether this task is an iotask + ** @brief return a logical indicating whether this task is an iotask */ int PIOc_iam_iotask(const int iosysid, bool *ioproc) { @@ -525,7 +567,7 @@ int PIOc_iam_iotask(const int iosysid, bool *ioproc) ios = pio_get_iosystem_from_id(iosysid); if(ios == NULL) return PIO_EBADID; - + *ioproc = ios->ioproc; return PIO_NOERR; } @@ -544,7 +586,7 @@ int PIOc_iotask_rank(const int iosysid, int *iorank) *iorank = ios->io_rank; return PIO_NOERR; - + } /** diff --git a/externals/pio2/src/clib/pioc_support.c b/externals/pio2/src/clib/pioc_support.c index c06c48d62e45..c60f4047a49d 100644 --- a/externals/pio2/src/clib/pioc_support.c +++ b/externals/pio2/src/clib/pioc_support.c @@ -1,12 +1,133 @@ -/** @file +/** @file * Support functions. */ +#include +#if PIO_ENABLE_LOGGING +#include +#include +#endif /* PIO_ENABLE_LOGGING */ #include #include #include #define versno 2001 +#if PIO_ENABLE_LOGGING +int pio_log_level = 0; +int my_rank; +#endif /* PIO_ENABLE_LOGGING */ + +/** Return a string description of an error code. If zero is passed, a + * null is returned. + * + * @param pioerr the error code returned by a PIO function call. + * @param errmsg Pointer that will get the error message. It will be + * PIO_MAX_NAME chars or less. + * + * @return 0 on success + */ +int +PIOc_strerror(int pioerr, char *errmsg) +{ + + /* System error? */ + if(pioerr > 0) + { + const char *cp = (const char *)strerror(pioerr); + if (cp) + strncpy(errmsg, cp, PIO_MAX_NAME); + else + strcpy(errmsg, "Unknown Error"); + } + else if (pioerr == PIO_NOERR) + { + strcpy(errmsg, "No error"); + } + else if (pioerr <= NC2_ERR && pioerr >= NC4_LAST_ERROR) /* NetCDF error? */ + { +#if defined( _PNETCDF) || defined(_NETCDF) + strncpy(errmsg, nc_strerror(pioerr), NC_MAX_NAME); +#else /* defined( _PNETCDF) || defined(_NETCDF) */ + strcpy(errmsg, "NetCDF error code, PIO not built with netCDF."); +#endif /* defined( _PNETCDF) || defined(_NETCDF) */ + } + else + { + /* Handle PIO errors. */ + switch(pioerr) { + case PIO_EBADIOTYPE: + strcpy(errmsg, "Bad IO type"); + break; + default: + strcpy(errmsg, "unknown PIO error"); + } + } + + return PIO_NOERR; +} + +/** Set the logging level. Set to -1 for nothing, 0 for errors only, 1 + * for important logging, and so on. Log levels below 1 are only + * printed on the io/component root. If the library is not built with + * logging, this function does nothing. */ +int PIOc_set_log_level(int level) +{ +#if PIO_ENABLE_LOGGING + printf("setting log level to %d\n", level); + pio_log_level = level; + MPI_Comm_rank(MPI_COMM_WORLD, &my_rank); +#endif /* PIO_ENABLE_LOGGING */ + return PIO_NOERR; +} + +#if PIO_ENABLE_LOGGING +/** This function prints out a message, if the severity of the message + is lower than the global pio_log_level. To use it, do something + like this: + + pio_log(0, "this computer will explode in %d seconds", i); + + After the first arg (the severity), use the rest like a normal + printf statement. Output will appear on stdout. + This function is heavily based on the function in section 15.5 of + the C FAQ. +*/ +void +pio_log(int severity, const char *fmt, ...) +{ + va_list argp; + int t; + + /* If the severity is greater than the log level, we don't print + this message. */ + if (severity > pio_log_level) + return; + + /* If the severity is 0, only print on rank 0. */ + if (severity < 1 && my_rank != 0) + return; + + /* If the severity is zero, this is an error. Otherwise insert that + many tabs before the message. */ + if (!severity) + fprintf(stdout, "ERROR: "); + for (t = 0; t < severity; t++) + fprintf(stdout, "\t"); + + /* Show the rank. */ + fprintf(stdout, "%d ", my_rank); + + /* Print out the variable list of args with vprintf. */ + va_start(argp, fmt); + vfprintf(stdout, fmt, argp); + va_end(argp); + + /* Put on a final linefeed. */ + fprintf(stdout, "\n"); + fflush(stdout); +} +#endif /* PIO_ENABLE_LOGGING */ + static pio_swapm_defaults swapm_defaults; bool PIO_Save_Decomps=false; /** @@ -18,7 +139,7 @@ void pio_get_env(void) char *envptr; extern bufsize PIO_CNBUFFER_LIMIT; envptr = getenv("PIO_Save_Decomps"); - + if(envptr != NULL && (strcmp(envptr,"true")==0)){ PIO_Save_Decomps=true; } @@ -29,7 +150,7 @@ void pio_get_env(void) envptr = getenv("PIO_SWAPM"); if(envptr != NULL){ char *token = strtok(envptr, ":"); - + swapm_defaults.nreqs = atoi(token); token = strtok(NULL, ":"); @@ -38,7 +159,7 @@ void pio_get_env(void) swapm_defaults.handshake = true; } token = strtok(NULL, ":"); - + if((token!=NULL) && strcmp(token,"t")==0){ swapm_defaults.isend = true; } @@ -53,15 +174,15 @@ void pio_get_env(void) mult = 1000; } PIO_CNBUFFER_LIMIT=(bufsize) atoll(envptr)*mult; - + } - + } - + /* Obtain a backtrace and print it to stderr. */ void print_trace (FILE *fp) { @@ -69,18 +190,18 @@ void print_trace (FILE *fp) size_t size; char **strings; size_t i; - + if(fp==NULL) fp = stderr; size = backtrace (array, 10); strings = backtrace_symbols (array, size); - + fprintf (fp,"Obtained %zd stack frames.\n", size); - + for (i = 0; i < size; i++) fprintf (fp,"%s\n", strings[i]); - + free (strings); } @@ -94,7 +215,7 @@ void piomemerror(iosystem_desc_t ios, size_t req, char *fname, const int line){ void piodie(const char *msg,const char *fname, const int line){ fprintf(stderr,"Abort with message %s in file %s at line %d\n",msg,fname,line); - + print_trace(stderr); #ifdef MPI_SERIAL abort(); @@ -110,17 +231,46 @@ void pioassert(_Bool expression, const char *msg, const char *fname, const int l if(! expression){ piodie(msg,fname,line); } -#endif +#endif } -/** Check the result of a netCDF API call. - * +/** Handle MPI errors. An error message is sent to stderr, then the + check_netcdf() function is called with PIO_EIO. + + @param file pointer to the file_desc_t info + @param mpierr the MPI return code to handle + @param filename the name of the code file where error occured. + @param line the line of code where error occured. + @return PIO_NOERR for no error, otherwise PIO_EIO. + */ +int check_mpi(file_desc_t *file, const int mpierr, const char *filename, + const int line) +{ + if (mpierr) + { + char errstring[MPI_MAX_ERROR_STRING]; + int errstrlen; + + /* If we can get an error string from MPI, print it to stderr. */ + if (!MPI_Error_string(mpierr, errstring, &errstrlen)) + fprintf(stderr, "MPI ERROR: %s in file %s at line %d\n", + errstring, filename, line); + + /* Handle all MPI errors as PIO_EIO. */ + check_netcdf(file, PIO_EIO, filename, line); + return PIO_EIO; + } + return PIO_NOERR; +} + +/** Check the result of a netCDF API call. + * * @param file pointer to the PIO structure describing this file. * @param status the return value from the netCDF call. - * @param fname the name of the code file. - * @param line the line number of the netCDF call in the code. - * + * @param fname the name of the code file. + * @param line the line number of the netCDF call in the code. + * * @return the error code */ int check_netcdf(file_desc_t *file, int status, const char *fname, const int line){ @@ -139,11 +289,11 @@ int check_netcdf(file_desc_t *file, int status, const char *fname, const int lin case PIO_IOTYPE_NETCDF: if(ios->iomaster){ if(status != NC_NOERR && (ios->error_handler == PIO_INTERNAL_ERROR)) - piodie(nc_strerror(status),fname,line); + piodie(nc_strerror(status),fname,line); // fprintf(stderr,"NETCDF ERROR: %s %s %d\n",nc_strerror(status),fname,line); } if(ios->error_handler == PIO_INTERNAL_ERROR){ - if(status != NC_NOERR) + if(status != NC_NOERR) MPI_Abort(MPI_COMM_WORLD,status); // abort }else if(ios->error_handler==PIO_BCAST_ERROR){ @@ -164,7 +314,7 @@ int check_netcdf(file_desc_t *file, int status, const char *fname, const int lin #endif default: ierr = iotype_error(file->iotype,__FILE__,__LINE__); - } + } return status; } @@ -199,7 +349,7 @@ io_desc_t *malloc_iodesc(const int piotype, const int ndims) fprintf(stderr,"ERROR: allocation error \n"); switch(piotype){ - case PIO_REAL: + case PIO_REAL: iodesc->basetype=MPI_FLOAT; break; case PIO_DOUBLE: @@ -208,11 +358,11 @@ io_desc_t *malloc_iodesc(const int piotype, const int ndims) case PIO_CHAR: iodesc->basetype=MPI_CHAR; break; - case PIO_INT: + case PIO_INT: default: iodesc->basetype = MPI_INTEGER; break; - } + } iodesc->rearranger = 0; iodesc->maxregions=1; iodesc->rfrom = NULL; @@ -251,7 +401,7 @@ void free_region_list(io_region *top) brel(ptr->count); tptr=ptr; ptr=ptr->next; - brel(tptr); + brel(tptr); } } @@ -314,7 +464,7 @@ int PIOc_freedecomp(int iosysid, int ioid) int PIOc_readmap(const char file[], int *ndims, int *gdims[], PIO_Offset *fmaplen, PIO_Offset *map[], const MPI_Comm comm) { - int npes, myrank; + int npes, myrank; int rnpes, rversno; int j; int *tdims; @@ -324,12 +474,12 @@ int PIOc_readmap(const char file[], int *ndims, int *gdims[], PIO_Offset *fmaple MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &myrank); - + if(myrank == 0) { FILE *fp = fopen(file, "r"); if(fp==NULL) piodie("Failed to open dof file",__FILE__,__LINE__); - + fscanf(fp,"version %d npes %d ndims %d\n",&rversno, &rnpes,ndims); if(rversno != versno) @@ -354,7 +504,7 @@ int PIOc_readmap(const char file[], int *ndims, int *gdims[], PIO_Offset *fmaple tmap = (PIO_Offset *) malloc(maplen*sizeof(PIO_Offset)); for(j=0;j0){ MPI_Send(&maplen, 1, PIO_OFFSET, i, i+npes, comm); MPI_Send(tmap, maplen, PIO_OFFSET, i, i, comm); @@ -381,7 +531,7 @@ int PIOc_readmap(const char file[], int *ndims, int *gdims[], PIO_Offset *fmaple maplen=0; } *fmaplen = maplen; - } + } *gdims = tdims; return PIO_NOERR; } @@ -429,11 +579,11 @@ int PIOc_writemap(const char file[], const int ndims, const int gdims[], PIO_Off for(i=0;i put_att, & PIO_get_att => get_att diff --git a/externals/pio2/src/flib/pio_nf.F90 b/externals/pio2/src/flib/pio_nf.F90 index 5c798f834ec8..4db50a2a51df 100644 --- a/externals/pio2/src/flib/pio_nf.F90 +++ b/externals/pio2/src/flib/pio_nf.F90 @@ -36,7 +36,9 @@ module pio_nf pio_get_chunk_cache , & pio_set_var_chunk_cache , & pio_get_var_chunk_cache , & - pio_redef + pio_redef , & + pio_set_log_level , & + pio_strerror ! pio_copy_att to be done interface pio_def_var @@ -180,13 +182,24 @@ module pio_nf module procedure & enddef_desc , & enddef_id - end interface + end interface pio_enddef + interface pio_redef module procedure & redef_desc , & redef_id end interface + interface pio_set_log_level + module procedure & + set_log_level + end interface pio_set_log_level + + interface pio_strerror + module procedure & + strerror + end interface pio_strerror + interface pio_inquire module procedure & inquire_desc , & @@ -648,18 +661,69 @@ integer function redef_desc(File) result(ierr) type (File_desc_t) , intent(inout) :: File ierr = redef_id(file%fh) end function redef_desc + +!> +!! @defgroup PIO_set_log_level +!< +!> +!! @ingroup PIO_set_log_level +!! Sets the logging level. Only takes effect if PIO was built with +!! PIO_ENABLE_LOGGING=On +!! +!! @param log_level the logging level. +!! @retval ierr @copydoc error_return +!< + integer function set_log_level(log_level) result(ierr) + integer, intent(in) :: log_level + interface + integer(C_INT) function PIOc_set_log_level(log_level) & + bind(C, name="PIOc_set_log_level") + use iso_c_binding + integer(C_INT), value :: log_level + end function PIOc_set_log_level + end interface + ierr = PIOc_set_log_level(log_level) + end function set_log_level + + !> + !! @defgroup PIO_strerror + !< + !> + !! @ingroup PIO_strerror + !! Returns a descriptive string for an error code. + !! + !! @param errcode the error code + !! @retval a description of the error + !< + integer function strerror(errcode, errmsg) result(ierr) + integer, intent(in) :: errcode + character(len=*), intent(out) :: errmsg + interface + integer(C_INT) function PIOc_strerror(errcode, errmsg) & + bind(C, name="PIOc_strerror") + use iso_c_binding + integer(C_INT), value :: errcode + character(C_CHAR) :: errmsg(*) + end function PIOc_strerror + end interface + errmsg = C_NULL_CHAR + ierr = PIOc_strerror(errcode, errmsg) + call replace_c_null(errmsg) + + end function strerror + !> !! @public !! @ingroup PIO_redef !! @brief Wrapper for the C function \ref PIOc_redef . !< integer function redef_id(ncid) result(ierr) - integer ,intent(in) :: ncid + integer, intent(in) :: ncid interface integer(C_INT) function PIOc_redef(ncid) & - bind(C ,name="PIOc_redef") + bind(C, name="PIOc_redef") use iso_c_binding - integer(C_INT) , value :: ncid + integer(C_INT), value :: ncid end function PIOc_redef end interface ierr = PIOc_redef(ncid) @@ -1633,7 +1697,7 @@ end function set_chunk_cache !> !! @public -!! @ingroup PIO_set_chunk_cache +!! @ingroup PIO_get_chunk_cache !! @brief Gets current settings for chunk cache (only relevant for netCDF4/HDF5 files.) !< integer function get_chunk_cache(iosysid, iotype, chunk_cache_size, chunk_cache_nelems, & @@ -1663,7 +1727,7 @@ end function get_chunk_cache !> !! @public -!! @ingroup PIO_set_chunk_cache +!! @ingroup PIO_set_var_chunk_cache !! @brief Changes chunk cache settings for a variable in a netCDF-4/HDF5 file. !< integer function set_var_chunk_cache_id(file, varid, chunk_cache_size, & diff --git a/externals/pio2/src/gptl/perf_mod.F90 b/externals/pio2/src/gptl/perf_mod.F90 index a4e25cc1f4d8..e62059de98ea 100644 --- a/externals/pio2/src/gptl/perf_mod.F90 +++ b/externals/pio2/src/gptl/perf_mod.F90 @@ -1,14 +1,14 @@ module perf_mod -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: This module is responsible for controlling the performance ! timer logic. -! +! ! Author: P. Worley, January 2007 ! ! $Id$ -! +! !----------------------------------------------------------------------- !----------------------------------------------------------------------- @@ -30,7 +30,7 @@ module perf_mod !----------------------------------------------------------------------- implicit none private ! Make the default access private - save + !----------------------------------------------------------------------- ! Public interfaces ---------------------------------------------------- @@ -62,7 +62,7 @@ module perf_mod !----------------------------------------------------------------------- !- include statements -------------------------------------------------- !----------------------------------------------------------------------- -#include +#include #include "gptl.inc" !----------------------------------------------------------------------- @@ -93,7 +93,7 @@ module perf_mod integer, parameter :: def_timer_depth_limit = 99999 ! default integer, private :: timer_depth_limit = def_timer_depth_limit ! integer indicating maximum number of levels of - ! timer nesting + ! timer nesting integer, parameter :: def_timing_detail_limit = 1 ! default integer, private :: timing_detail_limit = def_timing_detail_limit @@ -111,19 +111,19 @@ module perf_mod logical, parameter :: def_perf_single_file = .false. ! default logical, private :: perf_single_file = def_perf_single_file ! flag indicating whether the performance timer - ! output should be written to a single file - ! (per component communicator) or to a + ! output should be written to a single file + ! (per component communicator) or to a ! separate file for each process integer, parameter :: def_perf_outpe_num = 0 ! default integer, private :: perf_outpe_num = def_perf_outpe_num - ! maximum number of processes writing out + ! maximum number of processes writing out ! timing data (for this component communicator) integer, parameter :: def_perf_outpe_stride = 1 ! default integer, private :: perf_outpe_stride = def_perf_outpe_stride ! separation between process ids for processes - ! that are writing out timing data + ! that are writing out timing data ! (for this component communicator) logical, parameter :: def_perf_global_stats = .true. ! default @@ -176,9 +176,9 @@ module perf_mod !======================================================================== ! subroutine t_getLogUnit(LogUnit) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Get log unit number. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! @@ -193,9 +193,9 @@ end subroutine t_getLogUnit !======================================================================== ! subroutine t_setLogUnit(LogUnit) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Set log unit number. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! @@ -222,9 +222,9 @@ subroutine perf_defaultopts(timing_disable_out, & perf_single_file_out, & perf_global_stats_out, & perf_papi_enable_out ) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Return default runtime options -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! timers disable/enable option @@ -296,16 +296,16 @@ subroutine perf_setopts(mastertask, & perf_single_file_in, & perf_global_stats_in, & perf_papi_enable_in ) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Set runtime options -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments---------------------------- ! ! master process? logical, intent(in) :: mastertask ! Print out to log file? - logical, intent(IN) :: LogPrint + logical, intent(IN) :: LogPrint ! timers disable/enable option logical, intent(in), optional :: timing_disable_in ! performance timer option @@ -337,7 +337,7 @@ subroutine perf_setopts(mastertask, & timing_disable = timing_disable_in if (timing_disable) then ierr = GPTLdisable() - else + else ierr = GPTLenable() endif endif @@ -392,17 +392,17 @@ subroutine perf_setopts(mastertask, & endif ! if (mastertask .and. LogPrint) then - write(p_logunit,*) '(t_initf) Using profile_disable=', timing_disable, & + write(p_logunit,*) '(t_initf) Using profile_disable=', timing_disable, & ' profile_timer=', perf_timer - write(p_logunit,*) '(t_initf) profile_depth_limit=', timer_depth_limit, & + write(p_logunit,*) '(t_initf) profile_depth_limit=', timer_depth_limit, & ' profile_detail_limit=', timing_detail_limit write(p_logunit,*) '(t_initf) profile_barrier=', timing_barrier, & ' profile_outpe_num=', perf_outpe_num write(p_logunit,*) '(t_initf) profile_outpe_stride=', perf_outpe_stride , & ' profile_single_file=', perf_single_file write(p_logunit,*) '(t_initf) profile_global_stats=', perf_global_stats , & - ' profile_papi_enable=', perf_papi_enable - endif + ' profile_papi_enable=', perf_papi_enable + endif ! #ifdef DEBUG else @@ -420,9 +420,9 @@ subroutine papi_defaultopts(papi_ctr1_out, & papi_ctr2_out, & papi_ctr3_out, & papi_ctr4_out ) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Return default runtime PAPI counter options -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! PAPI counter option #1 @@ -456,9 +456,9 @@ subroutine papi_setopts(papi_ctr1_in, & papi_ctr2_in, & papi_ctr3_in, & papi_ctr4_in ) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Set runtime PAPI counter options -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments---------------------------- ! @@ -518,12 +518,12 @@ end subroutine papi_setopts !======================================================================== ! logical function t_profile_onf() -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Return flag indicating whether profiling is currently active. ! Part of workaround to implement FVbarrierclock before ! communicators exposed in Pilgrim. Does not check level of ! event nesting. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- if ((.not. timing_initialized) .or. & @@ -539,10 +539,10 @@ end function t_profile_onf !======================================================================== ! logical function t_barrier_onf() -!----------------------------------------------------------------------- -! Purpose: Return timing_barrier. Part of workaround to implement -! FVbarrierclock before communicators exposed in Pilgrim. -! Author: P. Worley +!----------------------------------------------------------------------- +! Purpose: Return timing_barrier. Part of workaround to implement +! FVbarrierclock before communicators exposed in Pilgrim. +! Author: P. Worley !----------------------------------------------------------------------- t_barrier_onf = timing_barrier @@ -552,10 +552,10 @@ end function t_barrier_onf !======================================================================== ! logical function t_single_filef() -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Return perf_single_file. Used to control output of other ! performance data, only spmdstats currently. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- t_single_filef = perf_single_file @@ -565,9 +565,9 @@ end function t_single_filef !======================================================================== ! subroutine t_stampf(wall, usr, sys) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Record wallclock, user, and system times (seconds). -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Output arguments----------------------------- ! @@ -596,14 +596,14 @@ end subroutine t_stampf !======================================================================== ! subroutine t_startf(event, handle) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Start an event timer -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! ! performance timer event name - character(len=*), intent(in) :: event + character(len=*), intent(in) :: event ! !---------------------------Input/Output arguments---------------------- ! @@ -634,14 +634,14 @@ end subroutine t_startf !======================================================================== ! subroutine t_stopf(event, handle) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Stop an event timer -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! ! performance timer event name - character(len=*), intent(in) :: event + character(len=*), intent(in) :: event ! !---------------------------Input/Output arguments---------------------- ! @@ -672,10 +672,10 @@ end subroutine t_stopf !======================================================================== ! subroutine t_enablef() -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Enable t_startf, t_stopf, t_stampf, and t_barrierf. Ignored ! in threaded regions. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Local workspace----------------------------- ! @@ -709,10 +709,10 @@ end subroutine t_enablef !======================================================================== ! subroutine t_disablef() -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Disable t_startf, t_stopf, t_stampf, and t_barrierf. Ignored ! in threaded regions. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Local workspace----------------------------- ! @@ -744,9 +744,9 @@ end subroutine t_disablef !======================================================================== ! subroutine t_adj_detailf(detail_adjustment) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Modify current detail level. Ignored in threaded regions. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! @@ -776,11 +776,11 @@ end subroutine t_adj_detailf !======================================================================== ! subroutine t_barrierf(event, mpicom) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Call (and time) mpi_barrier. Ignored inside OpenMP ! threaded regions. Note that barrier executed even if ! event not recorded because of level of timer event nesting. -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! mpi communicator id @@ -835,9 +835,9 @@ end subroutine t_barrierf ! subroutine t_prf(filename, mpicom, num_outpe, stride_outpe, & single_file, global_stats, output_thispe) -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: Write out performance timer data -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Input arguments----------------------------- ! @@ -847,7 +847,7 @@ subroutine t_prf(filename, mpicom, num_outpe, stride_outpe, & integer, intent(in), optional :: mpicom ! maximum number of processes writing out timing data integer, intent(in), optional :: num_outpe - ! separation between process ids for processes writing out data + ! separation between process ids for processes writing out data integer, intent(in), optional :: stride_outpe ! enable/disable the writing of data to a single file logical, intent(in), optional :: single_file @@ -862,7 +862,7 @@ subroutine t_prf(filename, mpicom, num_outpe, stride_outpe, & ! all data to a single file logical glb_stats ! flag indicting whether to compute ! global statistics - logical pr_write ! flag indicating whether the current + logical pr_write ! flag indicating whether the current ! GPTL output mode is write logical write_data ! flag indicating whether this process ! should output its timing data @@ -916,7 +916,7 @@ subroutine t_prf(filename, mpicom, num_outpe, stride_outpe, & if (GPTLpr_query_write() == 1) then pr_write = .true. ierr = GPTLpr_set_append() - else + else pr_write=.false. endif @@ -1113,8 +1113,8 @@ end subroutine t_prf !======================================================================== ! subroutine t_initf(NLFilename, LogPrint, LogUnit, mpicom, MasterTask) -!----------------------------------------------------------------------- -! Purpose: Set default values of runtime timing options +!----------------------------------------------------------------------- +! Purpose: Set default values of runtime timing options ! before namelists prof_inparm and papi_inparm are read, ! read namelists (and broadcast, if SPMD), ! then initialize timing library. @@ -1224,12 +1224,12 @@ subroutine t_initf(NLFilename, LogPrint, LogUnit, mpicom, MasterTask) open( unitn, file=trim(NLFilename), status='old', iostat=ierr ) if (ierr .eq. 0) then - ! Look for prof_inparm group name in the input file. + ! Look for prof_inparm group name in the input file. ! If found, leave the file positioned at that namelist group. call find_group_name(unitn, 'prof_inparm', status=ierr) if (ierr == 0) then ! found prof_inparm - read(unitn, nml=prof_inparm, iostat=ierr) + read(unitn, nml=prof_inparm, iostat=ierr) if (ierr /= 0) then call shr_sys_abort( subname//':: namelist read returns an'// & ' error condition for prof_inparm' ) @@ -1291,12 +1291,12 @@ subroutine t_initf(NLFilename, LogPrint, LogUnit, mpicom, MasterTask) ierr = 1 open( unitn, file=trim(NLFilename), status='old', iostat=ierr ) if (ierr .eq. 0) then - ! Look for papi_inparm group name in the input file. + ! Look for papi_inparm group name in the input file. ! If found, leave the file positioned at that namelist group. call find_group_name(unitn, 'papi_inparm', status=ierr) if (ierr == 0) then ! found papi_inparm - read(unitn, nml=papi_inparm, iostat=ierr) + read(unitn, nml=papi_inparm, iostat=ierr) if (ierr /= 0) then call shr_sys_abort( subname//':: namelist read returns an'// & ' error condition for papi_inparm' ) @@ -1355,12 +1355,12 @@ subroutine t_initf(NLFilename, LogPrint, LogUnit, mpicom, MasterTask) !$OMP MASTER ! - ! Set options and initialize timing library. - ! + ! Set options and initialize timing library. + ! ! Set timer if (gptlsetutr (perf_timer) < 0) call shr_sys_abort (subname//':: gptlsetutr') ! - ! For logical settings, 2nd arg 0 + ! For logical settings, 2nd arg 0 ! to gptlsetoption means disable, non-zero means enable ! ! Turn off CPU timing (expensive) @@ -1404,9 +1404,9 @@ end subroutine t_initf !======================================================================== ! subroutine t_finalizef() -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: shut down timing library -! Author: P. Worley +! Author: P. Worley !----------------------------------------------------------------------- !---------------------------Local workspace----------------------------- ! diff --git a/externals/pio2/tests/performance/kt.PIO1.perfmakefile b/externals/pio2/tests/performance/kt.PIO1.perfmakefile new file mode 100644 index 000000000000..67f0d3be11f1 --- /dev/null +++ b/externals/pio2/tests/performance/kt.PIO1.perfmakefile @@ -0,0 +1,19 @@ +all: pioperf pioperfp1 + +pioperf: pioperformance.o + mpif90 pioperformance.o -o pioperf ../pio_build_int/src/flib/libpiof.a ../pio_build_int/src/clib/libpioc.a ../pio_build_int/src/gptl/libgptl.a /glade/apps/opt/netcdf-mpi/4.3.3.1/intel/default/lib/libnetcdff.a /glade/apps/opt/netcdf-mpi/4.3.3.1/intel/default/lib/libnetcdf.so /glade/apps/opt/pnetcdf/1.6.1/intel/15.0.3/lib/libpnetcdf.a -lirng -ldecimal -lcilkrts -lstdc++ + +pioperformance.o: pioperformance.F90 + mpif90 -DCPRINTEL -DHAVE_MPI -DINCLUDE_CMAKE_FCI -DLINUX -DTIMING -DUSEMPIIO -DUSE_PNETCDF_VARN -DUSE_PNETCDF_VARN_ON_READ -D_NETCDF -D_NETCDF4 -D_PNETCDF -I/glade/p/work/katec/pio_work/ncar_pio2/src/flib -I/glade/p/work/katec/pio_work/pio_build_int/src/flib -I/glade/apps/opt/netcdf-mpi/4.3.2/intel/default/include -I/glade/apps/opt/pnetcdf/1.6.1/intel/15.0.3/include -I/glade/p/work/katec/pio_work/ncar_pio2/src/clib -I/glade/p/work/katec/pio_work/ncar_pio2/src/gptl -I/glade/p/work/katec/pio_work/pio_build_int/src/gptl -c pioperformance.F90 -o pioperformance.o + +pioperfp1: pioperformancep1.o + mpif90 pioperformancep1.o -o pioperfp1 ../PIO1_bld/pio/libpio.a ../pio_build_int/src/gptl/libgptl.a /glade/apps/opt/netcdf-mpi/4.3.3.1/intel/default/lib/libnetcdff.a /glade/apps/opt/netcdf-mpi/4.3.3.1/intel/default/lib/libnetcdf.so /glade/apps/opt/pnetcdf/1.6.1/intel/15.0.3/lib/libpnetcdf.a -lirng -ldecimal -lcilkrts -lstdc++ -openmp + +pioperformancep1.o: pioperformance.F90 + mpif90 -DPIO_GPFS_HINTS -DUSEMPIIO -D_NETCDF -D_NETCDF4 -D_NOUSEMCT -D_PNETCDF -D_USEBOX -D_PIO1 -no-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -g -xHost -debug minimal -openmp -DLINUX -DMCT_INTERFACE -DHAVE_MPI -DTHREADED_OMP -DFORTRANUNDERSCORE -DNO_R16 -DINTEL_MKL -DHAVE_SSE2 -DLINUX -DCPRINTEL -DHAVE_SLASHPROC -I. -I/glade/p/work/katec/pio_work/PIO1_bld/pio -I/glade/apps/opt/netcdf-mpi/4.3.3.1/intel/default/include -I/glade/apps/opt/pnetcdf/1.6.1/intel/15.0.3/include -I/glade/p/work/katec/pio_work/PIO1/pio -I/glade/p/work/katec/pio_work/PIO1_bld/pio/timing -I/glade/apps/opt/netcdf-mpi/4.3.3.1/intel/default/include -I/glade/apps/opt/pnetcdf/1.6.1/intel/15.0.3/include -c pioperformance.F90 -o pioperformancep1.o + +cleanp1: + rm pioperformancep1.o pioperfp1 + +clean: + rm pioperformance.o pioperf \ No newline at end of file diff --git a/externals/pio2/tests/performance/pioperformance.F90 b/externals/pio2/tests/performance/pioperformance.F90 index 3b295a3d7794..16fe145a193a 100644 --- a/externals/pio2/tests/performance/pioperformance.F90 +++ b/externals/pio2/tests/performance/pioperformance.F90 @@ -1,4 +1,4 @@ -#define VARINT 1 +#define VARINT 1 !#define VARREAL 1 !#define VARDOUBLE 1 @@ -12,7 +12,7 @@ program pioperformance implicit none #ifdef NO_MPIMOD #include -#endif +#endif integer, parameter :: max_io_task_array_size=64, max_decomp_files=64 @@ -31,6 +31,11 @@ program pioperformance nvars, varsize, unlimdimindof #ifdef BGQTRY external :: print_memusage +#endif +#ifdef _PIO1 + integer, parameter :: PIO_FILL_INT = 02147483647 + real, parameter :: PIO_FILL_FLOAT = 9.969209968E+36 + double precision, parameter :: PIO_FILL_DOUBLE = 9.969209968E+36 #endif ! ! Initialize MPI @@ -97,7 +102,7 @@ program pioperformance if(rearrangers(1)==0) then rearrangers(1)=1 rearrangers(2)=2 - endif + endif do i=1,max_decomp_files if(len_trim(decompfile(i))==0) exit @@ -107,7 +112,7 @@ program pioperformance do nv=1,max_nvars if(nvars(nv)>0) then call pioperformancetest(decompfile(i), piotypes(1:niotypes), mype, npe, & - rearrangers, niotasks, nframes, nvars(nv), varsize(vs),unlimdimindof) + rearrangers, niotasks, nframes, nvars(nv), varsize(vs),unlimdimindof) endif enddo endif @@ -128,7 +133,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & integer, intent(in) :: piotypes(:) integer, intent(in) :: rearrangers(:) integer, intent(inout) :: niotasks(:) - integer, intent(in) :: nframes + integer, intent(in) :: nframes integer, intent(in) :: nvars integer, intent(in) :: varsize logical, intent(in) :: unlimdimindof @@ -163,11 +168,18 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & character(len=*), parameter :: rearr_name(2) = (/' BOX','SUBSET'/) nullify(compmap) - if(mype.eq.0) print *,trim(filename) + if(trim(filename) .eq. 'ROUNDROBIN' .or. trim(filename).eq.'BLOCK') then call init_ideal_dof(filename, mype, npe_base, ndims, gdims, compmap, varsize) else + ! Changed to support PIO1 as well +#ifdef _PIO1 + call pio_readdof(filename, compmap, MPI_COMM_WORLD, 81, ndims, gdims) +#else call pio_readdof(filename, ndims, gdims, compmap, MPI_COMM_WORLD) +#endif + +! print *,__FILE__,__LINE__,' gdims=',ndims endif maplen = size(compmap) ! color = 0 @@ -194,7 +206,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & ! if(gmaplen /= product(gdims)) then ! print *,__FILE__,__LINE__,gmaplen,gdims ! endif - + allocate(ifld(maplen,nvars)) allocate(ifld_in(maplen,nvars,nframes)) @@ -243,14 +255,16 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & stride = max(1,npe/ntasks) call pio_init(mype, comm, ntasks, 0, stride, PIO_REARR_SUBSET, iosystem) - + write(fname, '(a,i1,a,i4.4,a,i1,a)') 'pioperf.',rearr,'-',ntasks,'-',iotype,'.nc' - + ierr = PIO_CreateFile(iosystem, File, iotype, trim(fname), mode) call WriteMetadata(File, gdims, vari, varr, vard, unlimdimindof) + call MPI_Barrier(comm,ierr) call t_stampf(wall(1), usr(1), sys(1)) + if(.not. unlimdimindof) then #ifdef VARINT call PIO_InitDecomp(iosystem, PIO_INT, gdims, compmap, iodesc_i4, rearr=rearr) @@ -262,7 +276,8 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & call PIO_InitDecomp(iosystem, PIO_DOUBLE, gdims, compmap, iodesc_r8, rearr=rearr) #endif endif -! print *,__FILE__,__LINE__,minval(dfld),maxval(dfld),minloc(dfld),maxloc(dfld) + + ! print *,__FILE__,__LINE__,minval(dfld),maxval(dfld),minloc(dfld),maxloc(dfld) do frame=1,nframes recnum = frame @@ -282,7 +297,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & endif if(mype==0) print *,__FILE__,__LINE__,'Frame: ',recnum - do nv=1,nvars + do nv=1,nvars if(mype==0) print *,__FILE__,__LINE__,'var: ',nv #ifdef VARINT call PIO_setframe(File, vari(nv), recnum) @@ -298,7 +313,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & #endif enddo if(unlimdimindof) then -#ifdef VARREAL +#ifdef VARREAL call PIO_freedecomp(File, iodesc_r4) #endif #ifdef VARDOUBLE @@ -306,7 +321,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & #endif #ifdef VARINT call PIO_freedecomp(File, iodesc_i4) -#endif +#endif endif enddo call pio_closefile(File) @@ -329,7 +344,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & #ifdef VARDOUBLE nvarmult = nvarmult+2 #endif - write(*,'(a15,a9,i10,i10,i10,f20.10)') & + write(*,'(a15,a9,i10,i10,i10,f20.10)') & 'RESULT: write ',rearr_name(rearr), piotypes(k), ntasks, nvars, & nvarmult*nvars*nframes*gmaplen*4.0/(1048576.0*wall(2)) #ifdef BGQTRY @@ -368,8 +383,8 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & call MPI_Barrier(comm,ierr) call t_stampf(wall(1), usr(1), sys(1)) - - do frame=1,nframes + + do frame=1,nframes do nv=1,nvars #ifdef VARINT call PIO_setframe(File, vari(nv), frame) @@ -385,7 +400,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & #endif enddo enddo - + call pio_closefile(File) call MPI_Barrier(comm,ierr) call t_stampf(wall(2), usr(2), sys(2)) @@ -398,7 +413,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & if(compmap(j)>0) then #ifdef VARINT #ifdef DEBUG - write(*,'(a11,i2,a9,i11,a9,i11,a9,i2)') & + write(*,'(a11,i2,a9,i11,a9,i11,a9,i2)') & ' Int PE=',mype,'ifld=',ifld(j,nv),' ifld_in=',ifld_in(j,nv,frame),' compmap=',compmap(j) #endif if(ifld(j,nv) /= ifld_in(j,nv,frame)) then @@ -406,7 +421,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & ! print *,__LINE__,'Int: ',mype,j,nv,ifld(j,nv),ifld_in(j,nv,frame),compmap(j) !endif write(*,*) '***ERROR:Mismatch!***' - write(*,'(a11,i2,a9,i11,a9,i11,a9,i2)') & + write(*,'(a11,i2,a9,i11,a9,i11,a9,i2)') & ' Int PE=',mype,'ifld=',ifld(j,nv),' ifld_in=',ifld_in(j,nv,frame),' compmap=',compmap(j) errorcnt = errorcnt+1 @@ -417,7 +432,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & write(*,'(a11,i2,a9,f11.2,a9,f11.2,a9,i2)') & ' Real PE=',mype,'rfld=',rfld(j,nv),' rfld_in=',rfld_in(j,nv,frame),' compmap=',compmap(j) #endif - + if(rfld(j,nv) /= rfld_in(j,nv,frame) ) then !if(errorcnt < 10) then ! print *,__LINE__,'Real:', mype,j,nv,rfld(j,nv),rfld_in(j,nv,frame),compmap(j) @@ -426,7 +441,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & write(*,'(a11,i2,a9,f11.2,a9,f11.2,a9,i2)') & ' Real PE=',mype,'rfld=',rfld(j,nv),' rfld_in=',rfld_in(j,nv,frame),' compmap=',compmap(j) - errorcnt = errorcnt+1 + errorcnt = errorcnt+1 endif #endif #ifdef VARDOUBLE @@ -451,7 +466,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & enddo j = errorcnt call MPI_Reduce(j, errorcnt, 1, MPI_INTEGER, MPI_SUM, 0, comm, ierr) - + if(mype==0) then if(errorcnt > 0) then print *,'ERROR: INPUT/OUTPUT data mismatch ',errorcnt @@ -469,11 +484,11 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & write(*,'(a15,a9,i10,i10,i10,f20.10)') & 'RESULT: read ',rearr_name(rearr), piotypes(k), ntasks, nvars, & nvarmult*nvars*nframes*gmaplen*4.0/(1048576.0*wall(2)) -#ifdef BGQTRY +#ifdef BGQTRY call print_memusage() #endif end if -#ifdef VARREAL +#ifdef VARREAL call PIO_freedecomp(iosystem, iodesc_r4) #endif #ifdef VARDOUBLE @@ -481,7 +496,7 @@ subroutine pioperformancetest(filename, piotypes, mype, npe_base, & #endif #ifdef VARINT call PIO_freedecomp(iosystem, iodesc_i4) -#endif +#endif call pio_finalize(iosystem, ierr) enddo enddo @@ -516,7 +531,7 @@ subroutine init_ideal_dof(doftype, mype, npe, ndims, gdims, compmap, varsize) allocate(compmap(varsize)) if(doftype .eq. 'ROUNDROBIN') then do i=1,varsize - compmap(i) = (i-1)*npe+mype+1 + compmap(i) = (i-1)*npe+mype+1 enddo else if(doftype .eq. 'BLOCK') then do i=1,varsize @@ -550,8 +565,10 @@ subroutine WriteMetadata(File, gdims, vari, varr, vard,unlimdimindof) ndims=ndims-1 endif allocate(dimid(ndims+1)) + do i=1,ndims - write(dimname,'(a,i6.6)') 'dim',i + + write(dimname,'(a,i6.6)') 'dim',i iostat = PIO_def_dim(File, trim(dimname), int(gdims(i),pio_offset_kind), dimid(i)) enddo iostat = PIO_def_dim(File, 'time', PIO_UNLIMITED, dimid(ndims+1)) @@ -592,15 +609,15 @@ subroutine CheckMPIreturn(line,errcode) implicit none #ifdef NO_MPIMOD #include -#endif +#endif integer, intent(in) :: errcode integer, intent(in) :: line character(len=MPI_MAX_ERROR_STRING) :: errorstring - + integer :: errorlen - + integer :: ierr - + if (errcode .ne. MPI_SUCCESS) then call MPI_Error_String(errcode,errorstring,errorlen,ierr) write(*,*) errorstring(1:errorlen) diff --git a/externals/pio2/tests/unit/CMakeLists.txt b/externals/pio2/tests/unit/CMakeLists.txt index 66d8995f7af1..12999f2518ee 100644 --- a/externals/pio2/tests/unit/CMakeLists.txt +++ b/externals/pio2/tests/unit/CMakeLists.txt @@ -43,10 +43,20 @@ if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU") PRIVATE -ffree-line-length-none) endif() +if (PIO_ENABLE_ASYNC AND NOT PIO_USE_MPI_SERIAL) + add_executable (test_intercomm EXCLUDE_FROM_ALL test_intercomm.c) + target_link_libraries (test_intercomm pioc) + add_dependencies (tests test_intercomm) + add_executable (test_darray_async EXCLUDE_FROM_ALL test_darray_async.c) + target_link_libraries (test_darray_async pioc) + add_dependencies (tests test_darray_async) +endif () add_executable (test_names EXCLUDE_FROM_ALL test_names.c) target_link_libraries (test_names pioc) add_executable (test_nc4 EXCLUDE_FROM_ALL test_nc4.c) target_link_libraries (test_nc4 pioc) +add_executable (test_darray EXCLUDE_FROM_ALL test_darray.c) +target_link_libraries (test_darray pioc) if (CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") set ( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mismatch_all" ) @@ -55,6 +65,7 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") endif () add_dependencies (tests test_names) +add_dependencies (tests test_darray) add_dependencies (tests test_nc4) add_dependencies (tests pio_unit_test) @@ -71,6 +82,16 @@ if (PIO_USE_MPISERIAL) set_tests_properties(pio_unit_test PROPERTIES TIMEOUT ${DEFAULT_TEST_TIMEOUT}) else () + add_mpi_test(test_darray + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/test_darray + NUMPROCS 4 + TIMEOUT ${DEFAULT_TEST_TIMEOUT}) + if (PIO_ENABLE_ASYNC) + add_mpi_test(test_intercomm + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/test_intercomm + NUMPROCS 4 + TIMEOUT ${DEFAULT_TEST_TIMEOUT}) + endif () add_mpi_test(test_names EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/test_names NUMPROCS 4 diff --git a/externals/pio2/tests/unit/basic_tests.F90 b/externals/pio2/tests/unit/basic_tests.F90 index de41cef69d44..daad01babca8 100644 --- a/externals/pio2/tests/unit/basic_tests.F90 +++ b/externals/pio2/tests/unit/basic_tests.F90 @@ -33,7 +33,7 @@ Subroutine test_create(test_id, err_msg) ! Local Vars character(len=str_len) :: filename - integer :: iotype, ret_val, pio_dim + integer :: iotype, ret_val, ret_val2, pio_dim err_msg = "no_error" @@ -51,7 +51,7 @@ Subroutine test_create(test_id, err_msg) ! Error in PIO_createfile print *,' ret_val = ', ret_val err_msg = "Could not create " // trim(filename) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if call mpi_barrier(mpi_comm_world,ret_val) @@ -62,7 +62,7 @@ Subroutine test_create(test_id, err_msg) ! Error in PIO_enddef err_msg = "Could not end define mode" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if end if call PIO_closefile(pio_file) @@ -73,7 +73,7 @@ Subroutine test_create(test_id, err_msg) if (ret_val .ne. PIO_NOERR) then ! Error in PIO_openfile err_msg = "Could not open " // trim(filename) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Close file @@ -85,7 +85,7 @@ Subroutine test_create(test_id, err_msg) if (ret_val .ne. PIO_NOERR) then ! Error in PIO_createfile err_msg = "Could not clobber " // trim(filename) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Leave define mode @@ -94,7 +94,7 @@ Subroutine test_create(test_id, err_msg) ! Error in PIO_enddef err_msg = "Could not end define mode in clobbered file" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Close file @@ -113,7 +113,7 @@ Subroutine test_create(test_id, err_msg) err_msg = "Was able to clobber file despite PIO_NOCLOBBER" ret_val = PIO_enddef(pio_file) call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if end if @@ -137,7 +137,7 @@ Subroutine test_open(test_id, err_msg) ! Local Vars character(len=str_len) :: filename - integer :: iotype, ret_val + integer :: iotype, ret_val, ret_val2 ! Data used to test writing integer, dimension(3) :: data_buffer, compdof @@ -147,6 +147,12 @@ Subroutine test_open(test_id, err_msg) integer :: unlimdimid type(var_desc_t) :: pio_var + ! These will be used to set chunk cache sizes in netCDF-4/HDF5 + ! files. + integer(kind=PIO_OFFSET_KIND) :: chunk_cache_size + integer(kind=PIO_OFFSET_KIND) :: chunk_cache_nelems + real :: chunk_cache_preemption + err_msg = "no_error" dims(1) = 3*ntasks compdof = 3*my_rank+(/1,2,3/) ! Where in the global array each task writes @@ -166,7 +172,7 @@ Subroutine test_open(test_id, err_msg) ! Error in PIO_openfile err_msg = "Successfully opened file that doesn't exist" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Open existing file, write data to it (for binary file, need to create new file) @@ -178,17 +184,16 @@ Subroutine test_open(test_id, err_msg) if (ret_val .ne. PIO_NOERR) then ! Error in PIO_openfile (or PIO_createfile) err_msg = "Could not open " // trim(filename) // " in write mode" - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Enter define mode for netcdf files if (is_netcdf(iotype)) then ret_val = PIO_redef(pio_file) if (ret_val .ne. PIO_NOERR) then - ! Error in PIO_redef err_msg = "Could not enter redef mode" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Define a new dimension N @@ -197,7 +202,7 @@ Subroutine test_open(test_id, err_msg) ! Error in PIO_def_dim err_msg = "Could not define dimension N" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Define a new variable foo @@ -207,7 +212,7 @@ Subroutine test_open(test_id, err_msg) ! Error in PIO_def_var err_msg = "Could not define variable foo" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Leave define mode @@ -217,7 +222,7 @@ Subroutine test_open(test_id, err_msg) print *,__FILE__,__LINE__,ret_val err_msg = "Could not end define mode" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if end if @@ -229,7 +234,7 @@ Subroutine test_open(test_id, err_msg) ! Error in PIO_write_darray err_msg = "Could not write data" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Close file @@ -242,7 +247,7 @@ Subroutine test_open(test_id, err_msg) if (ret_val .ne. PIO_NOERR) then ! Error opening file err_msg = "Could not open file in NoWrite mode" - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if ! Try to write (should fail) @@ -254,7 +259,7 @@ Subroutine test_open(test_id, err_msg) ! Error in PIO_write_darray err_msg = "Wrote to file opened in NoWrite mode" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if call mpi_barrier(MPI_COMM_WORLD,ret_val) @@ -267,25 +272,25 @@ Subroutine test_open(test_id, err_msg) err_msg = "Error in read_darray" call PIO_closefile(pio_file) print *,__FILE__,__LINE__,err_msg - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if if(any(data_buffer /= my_rank)) then err_msg = "Error reading data" call PIO_closefile(pio_file) print *,__FILE__,__LINE__,iotype, trim(err_msg), data_buffer - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if + ret_val = PIO_set_log_level(3) ret_val = PIO_inq_unlimdim(pio_file, unlimdimid) if(unlimdimid /= -1) then err_msg = "Error in inq_unlimdim" call PIO_closefile(pio_file) print *,__FILE__,__LINE__,iotype, trim(err_msg) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if - + ret_val = PIO_set_log_level(0) - ! Close file call PIO_closefile(pio_file) end if @@ -303,7 +308,7 @@ Subroutine test_open(test_id, err_msg) ! Error in PIO_openfile err_msg = "Opened a non-netcdf file as netcdf" call PIO_closefile(pio_file) - call mpi_abort(MPI_COMM_WORLD,0,ret_val) + call mpi_abort(MPI_COMM_WORLD, 0, ret_val2) end if end if diff --git a/externals/pio2/tests/unit/driver.F90 b/externals/pio2/tests/unit/driver.F90 index 7dbcfada7eda..92af6cec3eb7 100644 --- a/externals/pio2/tests/unit/driver.F90 +++ b/externals/pio2/tests/unit/driver.F90 @@ -26,6 +26,10 @@ Program pio_unit_test_driver #if defined( _NETCDF4) && defined(LOGGING) integer, external :: nc_set_log_level2 #endif + integer ret_val + character(len=80) :: errmsg + character(len=80) :: expected + ! Set up MPI call MPI_Init(ierr) call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierr) @@ -62,7 +66,7 @@ Program pio_unit_test_driver ! Ignore namelist values if PIO not built with correct options ! (i.e. don't test pnetcdf if not built with pnetcdf) - + ret_val = PIO_set_log_level(2) #ifndef _NETCDF if (ltest_netcdf) then write(*,"(A,1x,A)") "WARNING: can not test netcdf files because PIO", & @@ -121,6 +125,16 @@ Program pio_unit_test_driver fail_cnt = 0 test_cnt = 0 + ! Test pio_strerror. + ret_val = PIO_strerror(-33, errmsg); + print *, 'errcode =', -33, ' strerror = ', errmsg + expected = 'NetCDF: Not a valid ID' + if (trim(errmsg) .ne. expected) then + err_msg = 'expected ' // trim(expected) // ' and got ' // trim(errmsg) + print *, err_msg + call parse(err_msg, fail_cnt) + end if + do test_id=1,ntest if (ltest(test_id)) then ! Make sure i is a valid test number @@ -145,6 +159,7 @@ Program pio_unit_test_driver #if defined( _NETCDF4) && defined(LOGGING) if(master_task) ierr = nc_set_log_level2(3) #endif + ! test_create() if (master_task) write(*,"(3x,A,1x)") "testing PIO_createfile..." call test_create(test_id, err_msg) diff --git a/externals/pio2/tests/unit/test_darray.c b/externals/pio2/tests/unit/test_darray.c new file mode 100644 index 000000000000..abc1949633b2 --- /dev/null +++ b/externals/pio2/tests/unit/test_darray.c @@ -0,0 +1,260 @@ +/** + * @file + * Tests for darray functions. + * + */ +#include +#ifdef TIMING +#include +#endif + +#define NUM_NETCDF_FLAVORS 4 +#define NDIM 3 +#define X_DIM_LEN 400 +#define Y_DIM_LEN 400 +#define NUM_TIMESTEPS 6 +#define VAR_NAME "foo" +#define ATT_NAME "bar" +#define START_DATA_VAL 42 +#define ERR_AWFUL 1111 +#define VAR_CACHE_SIZE (1024 * 1024) +#define VAR_CACHE_NELEMS 10 +#define VAR_CACHE_PREEMPTION 0.5 + +/** Handle MPI errors. This should only be used with MPI library + * function calls. */ +#define MPIERR(e) do { \ + MPI_Error_string(e, err_buffer, &resultlen); \ + fprintf(stderr, "MPI error, line %d, file %s: %s\n", __LINE__, __FILE__, err_buffer); \ + MPI_Finalize(); \ + return ERR_AWFUL; \ + } while (0) + +/** Handle non-MPI errors by finalizing the MPI library and exiting + * with an exit code. */ +#define ERR(e) do { \ + fprintf(stderr, "Error %d in %s, line %d\n", e, __FILE__, __LINE__); \ + MPI_Finalize(); \ + return e; \ + } while (0) + +/** Global err buffer for MPI. */ +char err_buffer[MPI_MAX_ERROR_STRING]; +int resultlen; + +/** The dimension names. */ +char dim_name[NDIM][NC_MAX_NAME + 1] = {"timestep", "x", "y"}; + +/** Length of the dimensions in the sample data. */ +int dim_len[NDIM] = {NC_UNLIMITED, X_DIM_LEN, Y_DIM_LEN}; + +/** Run Tests for darray Functions. + * + * @param argc argument count + * @param argv array of arguments + */ +int +main(int argc, char **argv) +{ + int verbose = 1; + + /** Zero-based rank of processor. */ + int my_rank; + + /** Number of processors involved in current execution. */ + int ntasks; + + /** Specifies the flavor of netCDF output format. */ + int iotype; + + /** Different output flavors. */ + int format[NUM_NETCDF_FLAVORS] = {PIO_IOTYPE_PNETCDF, + PIO_IOTYPE_NETCDF, + PIO_IOTYPE_NETCDF4C, + PIO_IOTYPE_NETCDF4P}; + + /** Names for the output files. */ + char filename[NUM_NETCDF_FLAVORS][NC_MAX_NAME + 1] = {"test_darray_pnetcdf.nc", + "test_darray_classic.nc", + "test_darray_serial4.nc", + "test_darray_parallel4.nc"}; + + /** Number of processors that will do IO. In this test we + * will do IO from all processors. */ + int niotasks; + + /** Stride in the mpi rank between io tasks. Always 1 in this + * test. */ + int ioproc_stride = 1; + + /** Number of the aggregator? Always 0 in this test. */ + int numAggregator = 0; + + /** Zero based rank of first processor to be used for I/O. */ + int ioproc_start = 0; + + /** The dimension IDs. */ + int dimids[NDIM]; + + /** Array index per processing unit. */ + PIO_Offset elements_per_pe; + + /** The ID for the parallel I/O system. */ + int iosysid; + + /** The ncid of the netCDF file. */ + int ncid; + + /** The ID of the netCDF varable. */ + int varid; + + /** The I/O description ID. */ + int ioid; + + /** A buffer for sample data. */ + float *buffer; + + /** A buffer for reading data back from the file. */ + int *read_buffer; + + /** The decomposition mapping. */ + PIO_Offset *compdof; + + /** Return code. */ + int ret; + + /** Index for loops. */ + int fmt, d, d1, i; + +#ifdef TIMING + /* Initialize the GPTL timing library. */ + if ((ret = GPTLinitialize ())) + return ret; +#endif + + /* Initialize MPI. */ + if ((ret = MPI_Init(&argc, &argv))) + MPIERR(ret); + + /* Learn my rank and the total number of processors. */ + if ((ret = MPI_Comm_rank(MPI_COMM_WORLD, &my_rank))) + MPIERR(ret); + if ((ret = MPI_Comm_size(MPI_COMM_WORLD, &ntasks))) + MPIERR(ret); + + /* Check that a valid number of processors was specified. */ + if (!(ntasks == 1 || ntasks == 2 || ntasks == 4 || + ntasks == 8 || ntasks == 16)) + fprintf(stderr, "Number of processors must be 1, 2, 4, 8, or 16!\n"); + if (verbose) + printf("%d: ParallelIO Library example1 running on %d processors.\n", + my_rank, ntasks); + + /* keep things simple - 1 iotask per MPI process */ + niotasks = ntasks; + + /* Initialize the PIO IO system. This specifies how + * many and which processors are involved in I/O. */ + if ((ret = PIOc_Init_Intracomm(MPI_COMM_WORLD, niotasks, ioproc_stride, + ioproc_start, PIO_REARR_SUBSET, &iosysid))) + ERR(ret); + + /* Describe the decomposition. This is a 1-based array, so add 1! */ + elements_per_pe = X_DIM_LEN * Y_DIM_LEN / ntasks; + if (!(compdof = malloc(elements_per_pe * sizeof(PIO_Offset)))) + return PIO_ENOMEM; + for (i = 0; i < elements_per_pe; i++) { + compdof[i] = my_rank * elements_per_pe + i + 1; + } + + /* Create the PIO decomposition for this test. */ + if (verbose) + printf("rank: %d Creating decomposition...\n", my_rank); + if ((ret = PIOc_InitDecomp(iosysid, PIO_FLOAT, 2, &dim_len[1], (PIO_Offset)elements_per_pe, + compdof, &ioid, NULL, NULL, NULL))) + ERR(ret); + free(compdof); + + /* How many flavors will we be running for? */ + int num_flavors = 0; + int fmtidx = 0; +#ifdef _PNETCDF + num_flavors++; + format[fmtidx++] = PIO_IOTYPE_PNETCDF; +#endif +#ifdef _NETCDF + num_flavors++; + format[fmtidx++] = PIO_IOTYPE_NETCDF; +#endif +#ifdef _NETCDF4 + num_flavors += 2; + format[fmtidx++] = PIO_IOTYPE_NETCDF4C; + format[fmtidx] = PIO_IOTYPE_NETCDF4P; +#endif + + /* Use PIO to create the example file in each of the four + * available ways. */ + for (fmt = 0; fmt < num_flavors; fmt++) + { + /* Create the netCDF output file. */ + if (verbose) + printf("rank: %d Creating sample file %s with format %d...\n", + my_rank, filename[fmt], format[fmt]); + if ((ret = PIOc_createfile(iosysid, &ncid, &(format[fmt]), filename[fmt], + PIO_CLOBBER))) + ERR(ret); + + /* Define netCDF dimensions and variable. */ + if (verbose) + printf("rank: %d Defining netCDF metadata...\n", my_rank); + for (d = 0; d < NDIM; d++) { + if (verbose) + printf("rank: %d Defining netCDF dimension %s, length %d\n", my_rank, + dim_name[d], dim_len[d]); + if ((ret = PIOc_def_dim(ncid, dim_name[d], (PIO_Offset)dim_len[d], &dimids[d]))) + ERR(ret); + } + + /* Define a variable. */ + if ((ret = PIOc_def_var(ncid, VAR_NAME, PIO_FLOAT, NDIM, dimids, &varid))) + ERR(ret); + + if ((ret = PIOc_enddef(ncid))) + ERR(ret); + + /* Close the netCDF file. */ + if (verbose) + printf("rank: %d Closing the sample data file...\n", my_rank); + if ((ret = PIOc_closefile(ncid))) + ERR(ret); + + /* Put a barrier here to make verbose output look better. */ + if ((ret = MPI_Barrier(MPI_COMM_WORLD))) + MPIERR(ret); + + } + + /* Free the PIO decomposition. */ + if (verbose) + printf("rank: %d Freeing PIO decomposition...\n", my_rank); + if ((ret = PIOc_freedecomp(iosysid, ioid))) + ERR(ret); + + /* Finalize the IO system. */ + if (verbose) + printf("rank: %d Freeing PIO resources...\n", my_rank); + if ((ret = PIOc_finalize(iosysid))) + ERR(ret); + + /* Finalize the MPI library. */ + MPI_Finalize(); + +#ifdef TIMING + /* Finalize the GPTL timing library. */ + if ((ret = GPTLfinalize ())) + return ret; +#endif + + + return 0; +} diff --git a/externals/pio2/tests/unit/test_darray_async.c b/externals/pio2/tests/unit/test_darray_async.c new file mode 100644 index 000000000000..f589f01e3a5e --- /dev/null +++ b/externals/pio2/tests/unit/test_darray_async.c @@ -0,0 +1,261 @@ +/** + * @file + * Tests for darray functions. + * @author Ed Hartnett + * + */ +#include +#ifdef TIMING +#include +#endif + +#define NUM_NETCDF_FLAVORS 4 +#define NDIM 3 +#define X_DIM_LEN 400 +#define Y_DIM_LEN 400 +#define NUM_TIMESTEPS 6 +#define VAR_NAME "foo" +#define ATT_NAME "bar" +#define START_DATA_VAL 42 +#define ERR_AWFUL 1111 +#define VAR_CACHE_SIZE (1024 * 1024) +#define VAR_CACHE_NELEMS 10 +#define VAR_CACHE_PREEMPTION 0.5 + +/** Handle MPI errors. This should only be used with MPI library + * function calls. */ +#define MPIERR(e) do { \ + MPI_Error_string(e, err_buffer, &resultlen); \ + fprintf(stderr, "MPI error, line %d, file %s: %s\n", __LINE__, __FILE__, err_buffer); \ + MPI_Finalize(); \ + return ERR_AWFUL; \ + } while (0) + +/** Handle non-MPI errors by finalizing the MPI library and exiting + * with an exit code. */ +#define ERR(e) do { \ + fprintf(stderr, "Error %d in %s, line %d\n", e, __FILE__, __LINE__); \ + MPI_Finalize(); \ + return e; \ + } while (0) + +/** Global err buffer for MPI. */ +char err_buffer[MPI_MAX_ERROR_STRING]; +int resultlen; + +/** The dimension names. */ +char dim_name[NDIM][NC_MAX_NAME + 1] = {"timestep", "x", "y"}; + +/** Length of the dimensions in the sample data. */ +int dim_len[NDIM] = {NC_UNLIMITED, X_DIM_LEN, Y_DIM_LEN}; + +/** Run Tests for darray Functions. + * + * @param argc argument count + * @param argv array of arguments + */ +int +main(int argc, char **argv) +{ + int verbose = 1; + + /** Zero-based rank of processor. */ + int my_rank; + + /** Number of processors involved in current execution. */ + int ntasks; + + /** Specifies the flavor of netCDF output format. */ + int iotype; + + /** Different output flavors. */ + int format[NUM_NETCDF_FLAVORS] = {PIO_IOTYPE_PNETCDF, + PIO_IOTYPE_NETCDF, + PIO_IOTYPE_NETCDF4C, + PIO_IOTYPE_NETCDF4P}; + + /** Names for the output files. */ + char filename[NUM_NETCDF_FLAVORS][NC_MAX_NAME + 1] = {"test_darray_pnetcdf.nc", + "test_darray_classic.nc", + "test_darray_serial4.nc", + "test_darray_parallel4.nc"}; + + /** Number of processors that will do IO. In this test we + * will do IO from all processors. */ + int niotasks; + + /** Stride in the mpi rank between io tasks. Always 1 in this + * test. */ + int ioproc_stride = 1; + + /** Number of the aggregator? Always 0 in this test. */ + int numAggregator = 0; + + /** Zero based rank of first processor to be used for I/O. */ + int ioproc_start = 0; + + /** The dimension IDs. */ + int dimids[NDIM]; + + /** Array index per processing unit. */ + PIO_Offset elements_per_pe; + + /** The ID for the parallel I/O system. */ + int iosysid; + + /** The ncid of the netCDF file. */ + int ncid; + + /** The ID of the netCDF varable. */ + int varid; + + /** The I/O description ID. */ + int ioid; + + /** A buffer for sample data. */ + float *buffer; + + /** A buffer for reading data back from the file. */ + int *read_buffer; + + /** The decomposition mapping. */ + PIO_Offset *compdof; + + /** Return code. */ + int ret; + + /** Index for loops. */ + int fmt, d, d1, i; + +#ifdef TIMING + /* Initialize the GPTL timing library. */ + if ((ret = GPTLinitialize ())) + return ret; +#endif + + /* Initialize MPI. */ + if ((ret = MPI_Init(&argc, &argv))) + MPIERR(ret); + + /* Learn my rank and the total number of processors. */ + if ((ret = MPI_Comm_rank(MPI_COMM_WORLD, &my_rank))) + MPIERR(ret); + if ((ret = MPI_Comm_size(MPI_COMM_WORLD, &ntasks))) + MPIERR(ret); + + /* Check that a valid number of processors was specified. */ + if (!(ntasks == 1 || ntasks == 2 || ntasks == 4 || + ntasks == 8 || ntasks == 16)) + fprintf(stderr, "Number of processors must be 1, 2, 4, 8, or 16!\n"); + if (verbose) + printf("%d: ParallelIO Library example1 running on %d processors.\n", + my_rank, ntasks); + + /* keep things simple - 1 iotask per MPI process */ + niotasks = ntasks; + + /* Initialize the PIO IO system. This specifies how + * many and which processors are involved in I/O. */ + if ((ret = PIOc_Init_Intracomm(MPI_COMM_WORLD, niotasks, ioproc_stride, + ioproc_start, PIO_REARR_SUBSET, &iosysid))) + ERR(ret); + + /* Describe the decomposition. This is a 1-based array, so add 1! */ + elements_per_pe = X_DIM_LEN * Y_DIM_LEN / ntasks; + if (!(compdof = malloc(elements_per_pe * sizeof(PIO_Offset)))) + return PIO_ENOMEM; + for (i = 0; i < elements_per_pe; i++) { + compdof[i] = my_rank * elements_per_pe + i + 1; + } + + /* Create the PIO decomposition for this test. */ + if (verbose) + printf("rank: %d Creating decomposition...\n", my_rank); + if ((ret = PIOc_InitDecomp(iosysid, PIO_FLOAT, 2, &dim_len[1], (PIO_Offset)elements_per_pe, + compdof, &ioid, NULL, NULL, NULL))) + ERR(ret); + free(compdof); + + /* How many flavors will we be running for? */ + int num_flavors = 0; + int fmtidx = 0; +#ifdef _PNETCDF + num_flavors++; + format[fmtidx++] = PIO_IOTYPE_PNETCDF; +#endif +#ifdef _NETCDF + num_flavors++; + format[fmtidx++] = PIO_IOTYPE_NETCDF; +#endif +#ifdef _NETCDF4 + num_flavors += 2; + format[fmtidx++] = PIO_IOTYPE_NETCDF4C; + format[fmtidx] = PIO_IOTYPE_NETCDF4P; +#endif + + /* Use PIO to create the example file in each of the four + * available ways. */ + for (fmt = 0; fmt < num_flavors; fmt++) + { + /* Create the netCDF output file. */ + if (verbose) + printf("rank: %d Creating sample file %s with format %d...\n", + my_rank, filename[fmt], format[fmt]); + if ((ret = PIOc_createfile(iosysid, &ncid, &(format[fmt]), filename[fmt], + PIO_CLOBBER))) + ERR(ret); + + /* Define netCDF dimensions and variable. */ + if (verbose) + printf("rank: %d Defining netCDF metadata...\n", my_rank); + for (d = 0; d < NDIM; d++) { + if (verbose) + printf("rank: %d Defining netCDF dimension %s, length %d\n", my_rank, + dim_name[d], dim_len[d]); + if ((ret = PIOc_def_dim(ncid, dim_name[d], (PIO_Offset)dim_len[d], &dimids[d]))) + ERR(ret); + } + + /* Define a variable. */ + if ((ret = PIOc_def_var(ncid, VAR_NAME, PIO_FLOAT, NDIM, dimids, &varid))) + ERR(ret); + + if ((ret = PIOc_enddef(ncid))) + ERR(ret); + + /* Close the netCDF file. */ + if (verbose) + printf("rank: %d Closing the sample data file...\n", my_rank); + if ((ret = PIOc_closefile(ncid))) + ERR(ret); + + /* Put a barrier here to make verbose output look better. */ + if ((ret = MPI_Barrier(MPI_COMM_WORLD))) + MPIERR(ret); + + } + + /* Free the PIO decomposition. */ + if (verbose) + printf("rank: %d Freeing PIO decomposition...\n", my_rank); + if ((ret = PIOc_freedecomp(iosysid, ioid))) + ERR(ret); + + /* Finalize the IO system. */ + if (verbose) + printf("rank: %d Freeing PIO resources...\n", my_rank); + if ((ret = PIOc_finalize(iosysid))) + ERR(ret); + + /* Finalize the MPI library. */ + MPI_Finalize(); + +#ifdef TIMING + /* Finalize the GPTL timing library. */ + if ((ret = GPTLfinalize ())) + return ret; +#endif + + + return 0; +} diff --git a/externals/pio2/tests/unit/test_intercomm.c b/externals/pio2/tests/unit/test_intercomm.c new file mode 100644 index 000000000000..36fb2a72ad28 --- /dev/null +++ b/externals/pio2/tests/unit/test_intercomm.c @@ -0,0 +1,575 @@ +/** + * @file Tests for PIOc_Intercomm. This tests the Init_Intercomm() + * function, and basic asynch I/O capability. + * + */ +#include +#include +#ifdef TIMING +#include +#endif + +/** The number of possible output netCDF output flavors available to + * the ParallelIO library. */ +#define NUM_NETCDF_FLAVORS 4 + +/** The number of dimensions in the test data. */ +#define NDIM 1 + +/** The length of our test data. */ +#define DIM_LEN 4 + +/** The name of the dimension in the netCDF output file. */ +#define FIRST_DIM_NAME "jojo" +#define DIM_NAME "dim_test_intercomm" + +/** The name of the variable in the netCDF output file. */ +#define FIRST_VAR_NAME "bill" +#define VAR_NAME "var_test_intercomm" + +/** The name of the global attribute in the netCDF output file. */ +#define FIRST_ATT_NAME "willy_gatt_test_intercomm" +#define ATT_NAME "gatt_test_intercomm" +#define SHORT_ATT_NAME "short_gatt_test_intercomm" +#define FLOAT_ATT_NAME "float_gatt_test_intercomm" +#define DOUBLE_ATT_NAME "double_gatt_test_intercomm" + +/** The value of the global attribute in the netCDF output file. */ +#define ATT_VALUE 42 + +/** Error code for when things go wrong. */ +#define ERR_AWFUL 1111 +#define ERR_WRONG 2222 + +/** Handle MPI errors. This should only be used with MPI library + * function calls. */ +#define MPIERR(e) do { \ + MPI_Error_string(e, err_buffer, &resultlen); \ + fprintf(stderr, "MPI error, line %d, file %s: %s\n", __LINE__, __FILE__, err_buffer); \ + MPI_Finalize(); \ + return ERR_AWFUL; \ + } while (0) + +/** Handle non-MPI errors by finalizing the MPI library and exiting + * with an exit code. */ +#define ERR(e) do { \ + fprintf(stderr, "Error %d in %s, line %d\n", e, __FILE__, __LINE__); \ + MPI_Finalize(); \ + return e; \ + } while (0) + +/** Global err buffer for MPI. When there is an MPI error, this buffer + * is used to store the error message that is associated with the MPI + * error. */ +char err_buffer[MPI_MAX_ERROR_STRING]; + +/** This is the length of the most recent MPI error message, stored + * int the global error string. */ +int resultlen; + +/* Check the file for correctness. */ +int +check_file(int iosysid, int format, char *filename, int my_rank, int verbose) +{ + int ncid; + int ret; + int ndims, nvars, ngatts, unlimdimid; + int ndims2, nvars2, ngatts2, unlimdimid2; + int dimid2; + char dimname[NC_MAX_NAME + 1]; + PIO_Offset dimlen; + char dimname2[NC_MAX_NAME + 1]; + PIO_Offset dimlen2; + char varname[NC_MAX_NAME + 1]; + nc_type vartype; + int varndims, vardimids, varnatts; + char varname2[NC_MAX_NAME + 1]; + nc_type vartype2; + int varndims2, vardimids2, varnatts2; + int varid2; + int att_data; + short short_att_data; + float float_att_data; + double double_att_data; + + /* Re-open the file to check it. */ + if (verbose) + printf("%d test_intercomm opening file %s format %d\n", my_rank, filename, format); + if ((ret = PIOc_openfile(iosysid, &ncid, &format, filename, + NC_NOWRITE))) + ERR(ret); + + /* Try to read the data. */ + PIO_Offset start[NDIM] = {0}, count[NDIM] = {DIM_LEN}; + int data_in[DIM_LEN]; + if ((ret = PIOc_get_vars_tc(ncid, 0, start, count, NULL, NC_INT, data_in))) + ERR(ret); + for (int i = 0; i < DIM_LEN; i++) + { + if (verbose) + printf("%d test_intercomm read data_in[%d] = %d\n", my_rank, i, data_in[i]); + if (data_in[i] != i) + ERR(ERR_AWFUL); + } + + /* Find the number of dimensions, variables, and global attributes.*/ + if ((ret = PIOc_inq(ncid, &ndims, &nvars, &ngatts, &unlimdimid))) + ERR(ret); + if (ndims != 1 || nvars != 1 || ngatts != 4 || unlimdimid != -1) + ERR(ERR_WRONG); + + /* This should return PIO_NOERR. */ + if ((ret = PIOc_inq(ncid, NULL, NULL, NULL, NULL))) + ERR(ret); + + /* Check the other functions that get these values. */ + if ((ret = PIOc_inq_ndims(ncid, &ndims2))) + ERR(ret); + if (ndims2 != 1) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_nvars(ncid, &nvars2))) + ERR(ret); + if (nvars2 != 1) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_natts(ncid, &ngatts2))) + ERR(ret); + if (ngatts2 != 4) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_unlimdim(ncid, &unlimdimid2))) + ERR(ret); + if (unlimdimid != -1) + ERR(ERR_WRONG); + /* Should succeed, do nothing. */ + if ((ret = PIOc_inq_unlimdim(ncid, NULL))) + ERR(ret); + + /* Check out the dimension. */ + if ((ret = PIOc_inq_dim(ncid, 0, dimname, &dimlen))) + ERR(ret); + if (strcmp(dimname, DIM_NAME) || dimlen != DIM_LEN) + ERR(ERR_WRONG); + + /* Check the other functions that get these values. */ + if ((ret = PIOc_inq_dimname(ncid, 0, dimname2))) + ERR(ret); + if (strcmp(dimname2, DIM_NAME)) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_dimlen(ncid, 0, &dimlen2))) + ERR(ret); + if (dimlen2 != DIM_LEN) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_dimid(ncid, DIM_NAME, &dimid2))) + ERR(ret); + if (dimid2 != 0) + ERR(ERR_WRONG); + + /* Check out the variable. */ + if ((ret = PIOc_inq_var(ncid, 0, varname, &vartype, &varndims, &vardimids, &varnatts))) + ERR(ret); + if (strcmp(varname, VAR_NAME) || vartype != NC_INT || varndims != NDIM || + vardimids != 0 || varnatts != 0) + ERR(ERR_WRONG); + + /* Check the other functions that get these values. */ + if ((ret = PIOc_inq_varname(ncid, 0, varname2))) + ERR(ret); + if (strcmp(varname2, VAR_NAME)) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_vartype(ncid, 0, &vartype2))) + ERR(ret); + if (vartype2 != NC_INT) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_varndims(ncid, 0, &varndims2))) + ERR(ret); + if (varndims2 != NDIM) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_vardimid(ncid, 0, &vardimids2))) + ERR(ret); + if (vardimids2 != 0) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_varnatts(ncid, 0, &varnatts2))) + ERR(ret); + if (varnatts2 != 0) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_varid(ncid, VAR_NAME, &varid2))) + ERR(ret); + if (varid2 != 0) + ERR(ERR_WRONG); + + /* Check out the global attributes. */ + nc_type atttype; + PIO_Offset attlen; + char myattname[NC_MAX_NAME + 1]; + int myid; + if ((ret = PIOc_inq_att(ncid, NC_GLOBAL, ATT_NAME, &atttype, &attlen))) + ERR(ret); + if (atttype != NC_INT || attlen != 1) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_attlen(ncid, NC_GLOBAL, ATT_NAME, &attlen))) + ERR(ret); + if (attlen != 1) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_attname(ncid, NC_GLOBAL, 0, myattname))) + ERR(ret); + if (strcmp(ATT_NAME, myattname)) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_attid(ncid, NC_GLOBAL, ATT_NAME, &myid))) + ERR(ret); + if (myid != 0) + ERR(ERR_WRONG); + if ((ret = PIOc_get_att_int(ncid, NC_GLOBAL, ATT_NAME, &att_data))) + ERR(ret); + if (verbose) + printf("%d test_intercomm att_data = %d\n", my_rank, att_data); + if (att_data != ATT_VALUE) + ERR(ERR_WRONG); + if ((ret = PIOc_inq_att(ncid, NC_GLOBAL, SHORT_ATT_NAME, &atttype, &attlen))) + ERR(ret); + if (atttype != NC_SHORT || attlen != 1) + ERR(ERR_WRONG); + if ((ret = PIOc_get_att_short(ncid, NC_GLOBAL, SHORT_ATT_NAME, &short_att_data))) + ERR(ret); + if (short_att_data != ATT_VALUE) + ERR(ERR_WRONG); + if ((ret = PIOc_get_att_float(ncid, NC_GLOBAL, FLOAT_ATT_NAME, &float_att_data))) + ERR(ret); + if (float_att_data != ATT_VALUE) + ERR(ERR_WRONG); + if ((ret = PIOc_get_att_double(ncid, NC_GLOBAL, DOUBLE_ATT_NAME, &double_att_data))) + ERR(ret); + if (double_att_data != ATT_VALUE) + ERR(ERR_WRONG); + + + /* Close the file. */ + if (verbose) + printf("%d test_intercomm closing file (again) ncid = %d\n", my_rank, ncid); + if ((ret = PIOc_closefile(ncid))) + ERR(ret); + + return 0; +} + +/** Run Tests for Init_Intercomm + * + * @param argc argument count + * @param argv array of arguments + */ +int +main(int argc, char **argv) +{ + int verbose = 1; + + /** Zero-based rank of processor. */ + int my_rank; + + /** Number of processors involved in current execution. */ + int ntasks; + + /** Different output flavors. */ + int format[NUM_NETCDF_FLAVORS] = {PIO_IOTYPE_PNETCDF, + PIO_IOTYPE_NETCDF, + PIO_IOTYPE_NETCDF4C, + PIO_IOTYPE_NETCDF4P}; + + /** Names for the output files. */ + char filename[NUM_NETCDF_FLAVORS][NC_MAX_NAME + 1] = {"test_intercomm_pnetcdf.nc", + "test_intercomm_classic.nc", + "test_intercomm_serial4.nc", + "test_intercomm_parallel4.nc"}; + + /** The ID for the parallel I/O system. */ + int iosysid; + + /** The ncid of the netCDF file. */ + int ncid; + + /** The ID of the netCDF varable. */ + int varid; + + /** Return code. */ + int ret; + + /** Index for loops. */ + int fmt, d, d1, i; + +#ifdef TIMING + /* Initialize the GPTL timing library. */ + if ((ret = GPTLinitialize ())) + return ret; +#endif + + /* Initialize MPI. */ + if ((ret = MPI_Init(&argc, &argv))) + MPIERR(ret); + + /* Learn my rank and the total number of processors. */ + if ((ret = MPI_Comm_rank(MPI_COMM_WORLD, &my_rank))) + MPIERR(ret); + if ((ret = MPI_Comm_size(MPI_COMM_WORLD, &ntasks))) + MPIERR(ret); + + /* Check that a valid number of processors was specified. */ + if (ntasks != 4) + { + fprintf(stderr, "test_intercomm Number of processors must be exactly 4!\n"); + ERR(ERR_AWFUL); + } + if (verbose) + printf("%d: test_intercomm ParallelIO Library test_intercomm running on %d processors.\n", + my_rank, ntasks); + + /* For example, if I have 4 processors, and I want to have 2 of them be computational, */ + /* and 2 of them be IO: component count is 1 */ + /* peer_comm = MPI_COMM_WORLD */ + /* comp_comms is an array of comms of size 1 with a comm defined just over tasks (0,1) */ + /* io_comm is a comm over tasks (2,3) */ + + /* Initialize the PIO IO system. This specifies how many and which + * processors are involved in I/O. */ +#define COMPONENT_COUNT 1 + MPI_Comm comp_comms; + MPI_Comm io_comm; + + /* Tasks 0 and 1 will be computational. Tasks 2 and 3 will be I/O + * tasks. */ + int comp_task; + + int color = my_rank < 2 ? 0 : 1; // Determine color based on row + + // Split the communicator based on the color and use the + // original rank for ordering + MPI_Comm row_comm; + MPI_Comm_split(MPI_COMM_WORLD, color, my_rank, &row_comm); + + int row_rank, row_size; + MPI_Comm_rank(row_comm, &row_rank); + MPI_Comm_size(row_comm, &row_size); + + printf("WORLD RANK: %d \t ROW RANK/SIZE: %d/%d\n", + my_rank, row_rank, row_size); + if (my_rank == 0 || my_rank == 1) + { + /* We will define comp_comm. The io_comm will get null. */ + io_comm = MPI_COMM_NULL; + comp_comms = row_comm; + comp_task = 1; + if (verbose) + printf("%d added to the comp_comm\n", my_rank); + } + else + { + /* We will define io_comm. The comp_comms array will get nulls. */ + comp_comms = MPI_COMM_NULL; + io_comm = row_comm; + comp_task = 0; + if (verbose) + printf("%d added to the io_comm\n", my_rank); + } + + /* Turn on logging. */ + if ((ret = PIOc_set_log_level(3))) + ERR(ret); + + /* Initialize the async setup. */ + if ((ret = PIOc_Init_Intercomm(COMPONENT_COUNT, MPI_COMM_WORLD, &comp_comms, + io_comm, &iosysid))) + ERR(ret); + if (verbose) + printf("%d test_intercomm init intercomm returned %d iosysid = %d\n", my_rank, ret, + iosysid); + + /* All the netCDF calls are only executed on the computation + * tasks. The IO tasks have not returned from PIOc_Init_Intercomm, + * and when the do, they should go straight to finalize. */ + if (comp_task) + { + for (int fmt = 0; fmt < NUM_NETCDF_FLAVORS; fmt++) + { + int ncid, varid, dimid; + PIO_Offset start[NDIM], count[NDIM] = {0}; + int data[DIM_LEN]; + + /* Create a netCDF file with one dimension and one variable. */ + if (verbose) + printf("%d test_intercomm creating file %s\n", my_rank, filename[fmt]); + if ((ret = PIOc_createfile(iosysid, &ncid, &format[fmt], filename[fmt], + NC_CLOBBER))) + ERR(ret); + if (verbose) + printf("%d test_intercomm file created ncid = %d\n", my_rank, ncid); + + /* /\* End define mode, then re-enter it. *\/ */ + if ((ret = PIOc_enddef(ncid))) + ERR(ret); + if (verbose) + printf("%d test_intercomm calling redef\n", my_rank); + if ((ret = PIOc_redef(ncid))) + ERR(ret); + + /* Test the inq_format function. */ + int myformat; + if ((ret = PIOc_inq_format(ncid, &myformat))) + ERR(ret); + if ((format[fmt] == PIO_IOTYPE_PNETCDF || format[fmt] == PIO_IOTYPE_NETCDF) && + myformat != 1) + ERR(ERR_AWFUL); + else if ((format[fmt] == PIO_IOTYPE_NETCDF4C || format[fmt] == PIO_IOTYPE_NETCDF4P) && + myformat != 3) + ERR(ERR_AWFUL); + + /* Test the inq_type function for atomic types. */ + char type_name[NC_MAX_NAME + 1]; + PIO_Offset type_size; + #define NUM_TYPES 11 + nc_type xtype[NUM_TYPES] = {NC_CHAR, NC_BYTE, NC_SHORT, NC_INT, NC_FLOAT, NC_DOUBLE, + NC_UBYTE, NC_USHORT, NC_UINT, NC_INT64, NC_UINT64}; + int type_len[NUM_TYPES] = {1, 1, 2, 4, 4, 8, 1, 2, 4, 8, 8}; + int max_type = format[fmt] == PIO_IOTYPE_NETCDF ? NC_DOUBLE : NC_UINT64; + for (int i = 0; i < max_type; i++) + { + if ((ret = PIOc_inq_type(ncid, xtype[i], type_name, &type_size))) + ERR(ret); + if (type_size != type_len[i]) + ERR(ERR_AWFUL); + } + + /* Define a dimension. */ + char dimname2[NC_MAX_NAME + 1]; + if (verbose) + printf("%d test_intercomm defining dimension %s\n", my_rank, DIM_NAME); + if ((ret = PIOc_def_dim(ncid, FIRST_DIM_NAME, DIM_LEN, &dimid))) + ERR(ret); + if ((ret = PIOc_inq_dimname(ncid, 0, dimname2))) + ERR(ret); + if (strcmp(dimname2, FIRST_DIM_NAME)) + ERR(ERR_WRONG); + if ((ret = PIOc_rename_dim(ncid, 0, DIM_NAME))) + ERR(ret); + + /* Define a 1-D variable. */ + char varname2[NC_MAX_NAME + 1]; + if (verbose) + printf("%d test_intercomm defining variable %s\n", my_rank, VAR_NAME); + if ((ret = PIOc_def_var(ncid, FIRST_VAR_NAME, NC_INT, NDIM, &dimid, &varid))) + ERR(ret); + if ((ret = PIOc_inq_varname(ncid, 0, varname2))) + ERR(ret); + if (strcmp(varname2, FIRST_VAR_NAME)) + ERR(ERR_WRONG); + if ((ret = PIOc_rename_var(ncid, 0, VAR_NAME))) + ERR(ret); + + /* Add a global attribute. */ + if (verbose) + printf("%d test_intercomm writing attributes %s\n", my_rank, ATT_NAME); + int att_data = ATT_VALUE; + short short_att_data = ATT_VALUE; + float float_att_data = ATT_VALUE; + double double_att_data = ATT_VALUE; + char attname2[NC_MAX_NAME + 1]; + /* Write an att and rename it. */ + if ((ret = PIOc_put_att_int(ncid, NC_GLOBAL, FIRST_ATT_NAME, NC_INT, 1, &att_data))) + ERR(ret); + if ((ret = PIOc_inq_attname(ncid, NC_GLOBAL, 0, attname2))) + ERR(ret); + if (strcmp(attname2, FIRST_ATT_NAME)) + ERR(ERR_WRONG); + if ((ret = PIOc_rename_att(ncid, NC_GLOBAL, FIRST_ATT_NAME, ATT_NAME))) + ERR(ret); + + /* Write an att and delete it. */ + nc_type myatttype; + if ((ret = PIOc_put_att_int(ncid, NC_GLOBAL, FIRST_ATT_NAME, NC_INT, 1, &att_data))) + ERR(ret); + if ((ret = PIOc_del_att(ncid, NC_GLOBAL, FIRST_ATT_NAME))) + ERR(ret); + /* if ((ret = PIOc_inq_att(ncid, NC_GLOBAL, FIRST_ATT_NAME, NULL, NULL)) != PIO_ENOTATT) */ + /* { */ + /* printf("ret = %d\n", ret); */ + /* ERR(ERR_AWFUL); */ + /* } */ + + /* Write some atts of different types. */ + if ((ret = PIOc_put_att_short(ncid, NC_GLOBAL, SHORT_ATT_NAME, NC_SHORT, 1, &short_att_data))) + ERR(ret); + if ((ret = PIOc_put_att_float(ncid, NC_GLOBAL, FLOAT_ATT_NAME, NC_FLOAT, 1, &float_att_data))) + ERR(ret); + if ((ret = PIOc_put_att_double(ncid, NC_GLOBAL, DOUBLE_ATT_NAME, NC_DOUBLE, 1, &double_att_data))) + ERR(ret); + + /* End define mode. */ + if (verbose) + printf("%d test_intercomm ending define mode ncid = %d\n", my_rank, ncid); + if ((ret = PIOc_enddef(ncid))) + ERR(ret); + + /* Write some data. For the PIOc_put/get functions, all + * data must be on compmaster before the function is + * called. Only compmaster's arguments are passed to the + * async msg handler. All other computation tasks are + * ignored. */ + for (int i = 0; i < DIM_LEN; i++) + data[i] = i; + if (verbose) + printf("%d test_intercomm writing data\n", my_rank); + if (verbose) + printf("%d test_intercomm writing data\n", my_rank); + start[0] = 0; + count[0] = DIM_LEN; + if ((ret = PIOc_put_vars_tc(ncid, varid, start, count, NULL, NC_INT, data))) + ERR(ret); + + /* Close the file. */ + if (verbose) + printf("%d test_intercomm closing file ncid = %d\n", my_rank, ncid); + if ((ret = PIOc_closefile(ncid))) + ERR(ret); + + /* Check the file for correctness. */ + if ((ret = check_file(iosysid, format[fmt], filename[fmt], my_rank, verbose))) + ERR(ret); + + /* Now delete the file. */ + /* if ((ret = PIOc_deletefile(iosysid, filename[fmt]))) */ + /* ERR(ret); */ + /* if ((ret = PIOc_openfile(iosysid, &ncid, &format[fmt], filename[fmt], */ + /* NC_NOWRITE)) != PIO_ENFILE) */ + /* ERR(ERR_AWFUL); */ + + } /* next netcdf format flavor */ + } + + /* Free local MPI resources. */ + if (verbose) + printf("%d test_intercomm Freeing local MPI resources...\n", my_rank); + if (comp_task) + { + MPI_Comm_free(&comp_comms); + } + else + { + MPI_Comm_free(&io_comm); + } + + /* Finalize the IO system. */ + if (verbose) + printf("%d test_intercomm Freeing PIO resources...\n", my_rank); + if ((ret = PIOc_finalize(iosysid))) + ERR(ret); + + /* Finalize the MPI library. */ + MPI_Finalize(); + +#ifdef TIMING + /* Finalize the GPTL timing library. */ + if ((ret = GPTLfinalize())) + return ret; +#endif + + if (verbose) + printf("%d test_intercomm SUCCESS!!\n", my_rank); + + + return 0; +} diff --git a/externals/pio2/tests/unit/test_names.c b/externals/pio2/tests/unit/test_names.c new file mode 100644 index 000000000000..b9684d03628d --- /dev/null +++ b/externals/pio2/tests/unit/test_names.c @@ -0,0 +1,466 @@ +/** + * @file Tests for names of vars, atts, and dims. Also test the + * PIOc_strerror() function. + * + */ +#include +#ifdef TIMING +#include +#endif + +#define NUM_NETCDF_FLAVORS 4 +#define NDIM 3 +#define X_DIM_LEN 400 +#define Y_DIM_LEN 400 +#define NUM_TIMESTEPS 6 +#define VAR_NAME "foo" +#define ATT_NAME "bar" +#define START_DATA_VAL 42 +#define ERR_AWFUL 1111 +#define VAR_CACHE_SIZE (1024 * 1024) +#define VAR_CACHE_NELEMS 10 +#define VAR_CACHE_PREEMPTION 0.5 + +/** Handle MPI errors. This should only be used with MPI library + * function calls. */ +#define MPIERR(e) do { \ + MPI_Error_string(e, err_buffer, &resultlen); \ + fprintf(stderr, "MPI error, line %d, file %s: %s\n", __LINE__, __FILE__, err_buffer); \ + MPI_Finalize(); \ + return ERR_AWFUL; \ + } while (0) + +/** Handle non-MPI errors by finalizing the MPI library and exiting + * with an exit code. */ +#define ERR(e) do { \ + fprintf(stderr, "Error %d in %s, line %d\n", e, __FILE__, __LINE__); \ + MPI_Finalize(); \ + return e; \ + } while (0) + +/** Global err buffer for MPI. */ +char err_buffer[MPI_MAX_ERROR_STRING]; +int resultlen; + +/** The dimension names. */ +char dim_name[NDIM][NC_MAX_NAME + 1] = {"timestep", "x", "y"}; + +/** Length of the dimensions in the sample data. */ +int dim_len[NDIM] = {NC_UNLIMITED, X_DIM_LEN, Y_DIM_LEN}; + +/** Length of chunksizes to use in netCDF-4 files. */ +size_t chunksize[NDIM] = {2, X_DIM_LEN/2, Y_DIM_LEN/2}; + +/** Check the dimension names. + * + * @param my_rank rank of process + * @param ncid ncid of open netCDF file + * + * @returns 0 for success, error code otherwise. */ +int +check_dim_names(int my_rank, int ncid, int verbose) +{ + char dim_name[NC_MAX_NAME + 1]; + char zero_dim_name[NC_MAX_NAME + 1]; + int ret; + + for (int d = 0; d < NDIM; d++) + { + strcpy(dim_name, "11111111111111111111111111111111"); + if ((ret = PIOc_inq_dimname(ncid, d, dim_name))) + return ret; + if (verbose) + printf("my_rank %d dim %d name %s\n", my_rank, d, dim_name); + + /* Did other ranks get the same name? */ + if (!my_rank) + strcpy(zero_dim_name, dim_name); + /* if (verbose) */ + /* printf("rank %d dim_name %s zero_dim_name %s\n", my_rank, dim_name, zero_dim_name); */ + if ((ret = MPI_Bcast(&zero_dim_name, strlen(dim_name) + 1, MPI_CHAR, 0, + MPI_COMM_WORLD))) + MPIERR(ret); + if (strcmp(dim_name, zero_dim_name)) + return ERR_AWFUL; + } + return 0; +} + +/** Check the variable name. + * + * @param my_rank rank of process + * @param ncid ncid of open netCDF file + * + * @returns 0 for success, error code otherwise. */ +int +check_var_name(int my_rank, int ncid, int verbose) +{ + char var_name[NC_MAX_NAME + 1]; + char zero_var_name[NC_MAX_NAME + 1]; + int ret; + + strcpy(var_name, "11111111111111111111111111111111"); + if ((ret = PIOc_inq_varname(ncid, 0, var_name))) + return ret; + if (verbose) + printf("my_rank %d var name %s\n", my_rank, var_name); + + /* Did other ranks get the same name? */ + if (!my_rank) + strcpy(zero_var_name, var_name); + if ((ret = MPI_Bcast(&zero_var_name, strlen(var_name) + 1, MPI_CHAR, 0, + MPI_COMM_WORLD))) + MPIERR(ret); + if (strcmp(var_name, zero_var_name)) + return ERR_AWFUL; + return 0; +} + +/** Check the attribute name. + * + * @param my_rank rank of process + * @param ncid ncid of open netCDF file + * + * @returns 0 for success, error code otherwise. */ +int +check_att_name(int my_rank, int ncid, int verbose) +{ + char att_name[NC_MAX_NAME + 1]; + char zero_att_name[NC_MAX_NAME + 1]; + int ret; + + strcpy(att_name, "11111111111111111111111111111111"); + if ((ret = PIOc_inq_attname(ncid, NC_GLOBAL, 0, att_name))) + return ret; + if (verbose) + printf("my_rank %d att name %s\n", my_rank, att_name); + + /* Did everyone ranks get the same length name? */ +/* if (strlen(att_name) != strlen(ATT_NAME)) + return ERR_AWFUL;*/ + if (!my_rank) + strcpy(zero_att_name, att_name); + if ((ret = MPI_Bcast(&zero_att_name, strlen(att_name) + 1, MPI_CHAR, 0, + MPI_COMM_WORLD))) + MPIERR(ret); + if (strcmp(att_name, zero_att_name)) + return ERR_AWFUL; + return 0; +} + +/** Check the PIOc_strerror() function. + * + * @param my_rank the rank of this process. + * @param verbose true to get printfs on stdout. + * + * @return 0 for success, error code otherwise. + */ +int +check_strerror(int my_rank, int verbose) { + +#define NUM_TRIES 6 + char errstr[PIO_MAX_NAME + 1]; + int errcode[NUM_TRIES] = {PIO_EBADID, + NC_ENOTNC3, NC4_LAST_ERROR - 1, 0, 1, + PIO_EBADIOTYPE}; + const char *expected[NUM_TRIES] = {"NetCDF: Not a valid ID", + "NetCDF: Attempting netcdf-3 operation on netcdf-4 file", + "unknown PIO error", "No error", + nc_strerror(1), "Bad IO type"}; + int ret = PIO_NOERR; + + for (int try = 0; try < NUM_TRIES; try++) + { + char result[PIO_MAX_NAME]; + + /* Get the error string for this errcode. */ + PIOc_strerror(errcode[try], errstr); + + /* Check that it was as expected. */ + if (strcmp(errstr, expected[try])) + ret = ERR_AWFUL; + + /* Print some output to stdout if required. */ + if (verbose) + { + printf("%d: PIO strerror(%d) = %s\n", my_rank, errcode[try], + errstr); + strcpy(errstr, nc_strerror(errcode[try])); + printf("%d: netCDF strerror(%d) = %s\n", my_rank, errcode[try], + errstr); + } + } + + return ret; +} + +/** Run Tests for NetCDF-4 Functions. + * + * @param argc argument count + * @param argv array of arguments + */ +int +main(int argc, char **argv) +{ + int verbose = 1; + + /** Zero-based rank of processor. */ + int my_rank; + + /** Number of processors involved in current execution. */ + int ntasks; + + /** Specifies the flavor of netCDF output format. */ + int iotype; + + /** Different output flavors. */ + int format[NUM_NETCDF_FLAVORS] = {PIO_IOTYPE_PNETCDF, + PIO_IOTYPE_NETCDF, + PIO_IOTYPE_NETCDF4C, + PIO_IOTYPE_NETCDF4P}; + + /** Names for the output files. */ + char filename[NUM_NETCDF_FLAVORS][NC_MAX_NAME + 1] = {"test_names_pnetcdf.nc", + "test_names_classic.nc", + "test_names_serial4.nc", + "test_names_parallel4.nc"}; + + /** Number of processors that will do IO. In this test we + * will do IO from all processors. */ + int niotasks; + + /** Stride in the mpi rank between io tasks. Always 1 in this + * test. */ + int ioproc_stride = 1; + + /** Number of the aggregator? Always 0 in this test. */ + int numAggregator = 0; + + /** Zero based rank of first processor to be used for I/O. */ + int ioproc_start = 0; + + /** The dimension IDs. */ + int dimids[NDIM]; + + /** Array index per processing unit. */ + PIO_Offset elements_per_pe; + + /** The ID for the parallel I/O system. */ + int iosysid; + + /** The ncid of the netCDF file. */ + int ncid = 0; + + /** The ID of the netCDF varable. */ + int varid; + + /** Storage of netCDF-4 files (contiguous vs. chunked). */ + int storage; + + /** Chunksizes set in the file. */ + size_t my_chunksize[NDIM]; + + /** The shuffle filter setting in the netCDF-4 test file. */ + int shuffle; + + /** Non-zero if deflate set for the variable in the netCDF-4 test file. */ + int deflate; + + /** The deflate level set for the variable in the netCDF-4 test file. */ + int deflate_level; + + /** Non-zero if fletcher32 filter is used for variable. */ + int fletcher32; + + /** Endianness of variable. */ + int endianness; + + /* Size of the file chunk cache. */ + size_t chunk_cache_size; + + /* Number of elements in file cache. */ + size_t nelems; + + /* File cache preemption. */ + float preemption; + + /* Size of the var chunk cache. */ + size_t var_cache_size; + + /* Number of elements in var cache. */ + size_t var_cache_nelems; + + /* Var cache preemption. */ + float var_cache_preemption; + + /** The I/O description ID. */ + int ioid; + + /** A buffer for sample data. */ + float *buffer; + + /** A buffer for reading data back from the file. */ + int *read_buffer; + + /** The decomposition mapping. */ + PIO_Offset *compdof; + + /** Return code. */ + int ret; + + /** Index for loops. */ + int fmt, d, d1, i; + +#ifdef TIMING + /* Initialize the GPTL timing library. */ + if ((ret = GPTLinitialize ())) + return ret; +#endif + + /* Initialize MPI. */ + if ((ret = MPI_Init(&argc, &argv))) + MPIERR(ret); + + /* Learn my rank and the total number of processors. */ + if ((ret = MPI_Comm_rank(MPI_COMM_WORLD, &my_rank))) + MPIERR(ret); + if ((ret = MPI_Comm_size(MPI_COMM_WORLD, &ntasks))) + MPIERR(ret); + + /* Check that a valid number of processors was specified. */ + if (!(ntasks == 1 || ntasks == 2 || ntasks == 4 || + ntasks == 8 || ntasks == 16)) + fprintf(stderr, "Number of processors must be 1, 2, 4, 8, or 16!\n"); + if (verbose) + printf("%d: ParallelIO Library example1 running on %d processors.\n", + my_rank, ntasks); + + /* Check the error string function. */ + if ((ret = check_strerror(my_rank, verbose))) + ERR(ret); + + /* keep things simple - 1 iotask per MPI process */ + niotasks = ntasks; + + /* Initialize the PIO IO system. This specifies how + * many and which processors are involved in I/O. */ + if ((ret = PIOc_Init_Intracomm(MPI_COMM_WORLD, niotasks, ioproc_stride, + ioproc_start, PIO_REARR_SUBSET, &iosysid))) + ERR(ret); + + /* Describe the decomposition. This is a 1-based array, so add 1! */ + elements_per_pe = X_DIM_LEN * Y_DIM_LEN / ntasks; + if (!(compdof = malloc(elements_per_pe * sizeof(PIO_Offset)))) + return PIO_ENOMEM; + for (i = 0; i < elements_per_pe; i++) { + compdof[i] = my_rank * elements_per_pe + i + 1; + } + + /* Create the PIO decomposition for this test. */ + if (verbose) + printf("rank: %d Creating decomposition...\n", my_rank); + if ((ret = PIOc_InitDecomp(iosysid, PIO_FLOAT, 2, &dim_len[1], (PIO_Offset)elements_per_pe, + compdof, &ioid, NULL, NULL, NULL))) + ERR(ret); + free(compdof); + + /* How many flavors will we be running for? */ + int num_flavors = 0; + int fmtidx = 0; +#ifdef _PNETCDF + num_flavors++; + format[fmtidx++] = PIO_IOTYPE_PNETCDF; +#endif +#ifdef _NETCDF + num_flavors++; + format[fmtidx++] = PIO_IOTYPE_NETCDF; +#endif +#ifdef _NETCDF4 + num_flavors += 2; + format[fmtidx++] = PIO_IOTYPE_NETCDF4C; + format[fmtidx] = PIO_IOTYPE_NETCDF4P; +#endif + + /* Use PIO to create the example file in each of the four + * available ways. */ + for (fmt = 0; fmt < num_flavors; fmt++) + { + /* Create the netCDF output file. */ + if (verbose) + printf("rank: %d Creating sample file %s with format %d...\n", + my_rank, filename[fmt], format[fmt]); + if ((ret = PIOc_createfile(iosysid, &ncid, &(format[fmt]), filename[fmt], + PIO_CLOBBER))) + ERR(ret); + + /* Define netCDF dimensions and variable. */ + if (verbose) + printf("rank: %d Defining netCDF metadata...\n", my_rank); + for (d = 0; d < NDIM; d++) { + if (verbose) + printf("rank: %d Defining netCDF dimension %s, length %d\n", my_rank, + dim_name[d], dim_len[d]); + if ((ret = PIOc_def_dim(ncid, dim_name[d], (PIO_Offset)dim_len[d], &dimids[d]))) + ERR(ret); + } + + /* Check the dimension names. */ + if ((ret = check_dim_names(my_rank, ncid, verbose))) + ERR(ret); + + /* Define a global attribute. */ + int att_val = 42; + if ((ret = PIOc_put_att_int(ncid, NC_GLOBAL, ATT_NAME, NC_INT, 1, &att_val))) + ERR(ret); + + /* Check the attribute name. */ + if ((ret = check_att_name(my_rank, ncid, verbose))) + ERR(ret); + + /* Define a variable. */ + if ((ret = PIOc_def_var(ncid, VAR_NAME, PIO_FLOAT, NDIM, dimids, &varid))) + ERR(ret); + + /* Check the variable name. */ + if ((ret = check_var_name(my_rank, ncid, verbose))) + ERR(ret); + + if ((ret = PIOc_enddef(ncid))) + ERR(ret); + + /* Close the netCDF file. */ + if (verbose) + printf("rank: %d Closing the sample data file...\n", my_rank); + if ((ret = PIOc_closefile(ncid))) + ERR(ret); + + /* Put a barrier here to make verbose output look better. */ + if ((ret = MPI_Barrier(MPI_COMM_WORLD))) + MPIERR(ret); + + } + + /* Free the PIO decomposition. */ + if (verbose) + printf("rank: %d Freeing PIO decomposition...\n", my_rank); + if ((ret = PIOc_freedecomp(iosysid, ioid))) + ERR(ret); + + /* Finalize the IO system. */ + if (verbose) + printf("rank: %d Freeing PIO resources...\n", my_rank); + if ((ret = PIOc_finalize(iosysid))) + ERR(ret); + + /* Finalize the MPI library. */ + MPI_Finalize(); + +#ifdef TIMING + /* Finalize the GPTL timing library. */ + if ((ret = GPTLfinalize ())) + return ret; +#endif + + + return 0; +} diff --git a/externals/pio2/tests/unit/test_nc4.c b/externals/pio2/tests/unit/test_nc4.c index b748f7a420f5..3d464bb660da 100644 --- a/externals/pio2/tests/unit/test_nc4.c +++ b/externals/pio2/tests/unit/test_nc4.c @@ -81,7 +81,7 @@ char dim_name[NDIM][NC_MAX_NAME + 1] = {"timestep", "x", "y"}; int dim_len[NDIM] = {NC_UNLIMITED, X_DIM_LEN, Y_DIM_LEN}; /** Length of chunksizes to use in netCDF-4 files. */ -size_t chunksize[NDIM] = {2, X_DIM_LEN/2, Y_DIM_LEN/2}; +PIO_Offset chunksize[NDIM] = {2, X_DIM_LEN/2, Y_DIM_LEN/2}; /** Run Tests for NetCDF-4 Functions. * @@ -147,7 +147,7 @@ main(int argc, char **argv) int storage; /** Chunksizes set in the file. */ - size_t my_chunksize[NDIM]; + PIO_Offset my_chunksize[NDIM]; /** The shuffle filter setting in the netCDF-4 test file. */ int shuffle; @@ -189,13 +189,13 @@ main(int argc, char **argv) int fmt, d, d1, i; /** For setting the chunk cache. */ - size_t chunk_cache_size = 1024*1024; - size_t chunk_cache_nelems = 1024; + PIO_Offset chunk_cache_size = 1024*1024; + PIO_Offset chunk_cache_nelems = 1024; float chunk_cache_preemption = 0.5; /* For reading the chunk cache. */ - size_t chunk_cache_size_in; - size_t chunk_cache_nelems_in; + PIO_Offset chunk_cache_size_in; + PIO_Offset chunk_cache_nelems_in; float chunk_cache_preemption_in; char varname[15]; diff --git a/scripts/Testing/Testcases/NOC_script b/scripts/Testing/Testcases/NOC_script index df03281e181a..f7978cbbf1d9 100755 --- a/scripts/Testing/Testcases/NOC_script +++ b/scripts/Testing/Testcases/NOC_script @@ -75,10 +75,10 @@ else endif echo "moving relevant history files to suffix with command " >>& $TESTSTATUS_LOG -echo "$SCRIPTSROOT/Tools/component_compare_move.sh -rundir $RUNDIR -testcase $CASE -suffix base" >>& $TESTSTATUS_LOG +echo "$SCRIPTSROOT/Tools/component_compare_move base" >>& $TESTSTATUS_LOG echo "" >>& $TESTSTATUS_LOG -$SCRIPTSROOT/Tools/component_compare_move.sh -rundir $RUNDIR -testcase $CASE -suffix "base" +$SCRIPTSROOT/Tools/component_compare_move base #====================================================================== # do an initial run test with NINST 2, with the @@ -117,10 +117,10 @@ else endif echo "moving relevant history files to suffix with commands " >>& $TESTSTATUS_LOG -echo "$SCRIPTSROOT/Tools/component_compare_move.sh -rundir $RUNDIR -testcase $CASE -suffix inst2mod" >>& $TESTSTATUS_LOG +echo "$SCRIPTSROOT/Tools/component_compare_move inst2mod" >>& $TESTSTATUS_LOG echo "" >>& $TESTSTATUS_LOG -$SCRIPTSROOT/Tools/component_compare_move.sh -rundir $RUNDIR -testcase $CASE -suffix "inst2mod" +$SCRIPTSROOT/Tools/component_compare_move inst2mod #====================================================================== # Check test status for all relevant component history files @@ -130,10 +130,7 @@ echo "DONE ${CASEBASEID} : (test finished, successful coupler log) " >>& $TESTST echo "" >>& $TESTSTATUS_LOG echo "obtaining test functionality from history files with commands " >>& $TESTSTATUS_LOG -echo "$SCRIPTSROOT/Tools/component_compare_test.sh -rundir $RUNDIR -testcase $CASE -testcase_base $CASEBASEID -suffix1 base -suffix2 multiinst -msg compare .base with .inst2mod" >>& $TESTSTATUS_LOG +echo "$SCRIPTSROOT/Tools/component_compare_test base multiinst" >>& $TESTSTATUS_LOG echo "" >>& $TESTSTATUS_LOG -$SCRIPTSROOT/Tools/component_compare_test.sh -rundir $RUNDIR -testcase $CASE -testcase_base $CASEBASEID -suffix1 "base" -suffix2 "multiinst" -msg "compare .base with .inst2mod" >>& $TESTSTATUS_OUT - - - +$SCRIPTSROOT/Tools/component_compare_test base multiinst >>& $TESTSTATUS_OUT diff --git a/scripts/Testing/testreporter.pl b/scripts/Testing/testreporter.pl index 5bd3c5c9e234..33d7b345b98c 100755 --- a/scripts/Testing/testreporter.pl +++ b/scripts/Testing/testreporter.pl @@ -166,7 +166,7 @@ sub getTestDirs # open the testroot, find the test directories. If no test directories ending in # the testid exist, then abort. opendir(my $DIR, $testd) or die "can't open $testd, error was $!"; - my @testdirs = grep { $_ =~ /($tid)$/ } readdir($DIR); + my @testdirs = grep { $_ =~ /($tid)$/ } grep { !/sharedlibroot/} grep { !/cs.status/} readdir($DIR); closedir $DIR; &Debug("in gettestdirs: test directories: \n"); &Debug( eval { Dumper \@testdirs} ); @@ -210,7 +210,7 @@ sub getTestSuiteInfo # SetupTools needs a case to work, so why not just cd to the # first test directory, and run SetupTools there?? :) - my $firsttestdir = $testroot . "/" . $$testlist[1]; + my $firsttestdir = $testroot . "/" . $$testlist[0]; Debug("first test dir: $firsttestdir"); chdir $firsttestdir; my $cimeroot = `./xmlquery CIMEROOT --value`; @@ -287,46 +287,38 @@ sub getTestStatus # test functionality summary as the teststatus field. # Namelist compare - my @testsummarylines = grep { /nlcomp/ } @statuslines; + my @testsummarylines = grep { /NLCOMP/ } @statuslines; $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - if ($testsummary =~ "NLFAIL") {$testsummary = "FAIL";} $teststatushash{$testcase}{'nlcomp'} = (length($testsummary) > 0) ? $testsummary : "----"; # Memory leak - my @testsummarylines = grep { /memleak/ } grep { !/^COMMENT/} @statuslines; - $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - $teststatushash{$testcase}{'memleak'} = (length($testsummary) > 0) ? $testsummary : "----"; + my @testsummarylines = grep { /MEMLEAK/ } grep { !/insuffiencient/} @statuslines; + my @testsummary_arr = (split(/\s+/, $testsummarylines[0])); + $teststatushash{$testcase}{'memleak'} = ($#testsummarylines > -1) ? @testsummary_arr[0] : "----"; + $teststatushash{$testcase}{'comment'} .= " @testsummary_arr[3..$#testsummary_arr]"; + # Compare memory usage to baseline - my @testsummarylines = grep { /Memory/} grep { /baseline/} @statuslines; - my $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - $teststatushash{$testcase}{'memcomp'} = (length($testsummary) > 0) ? $testsummary : "----"; - if (length($testsummary) == 0){ - my @testsummarylines = grep { /memcomp/} @statuslines; - my $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - $teststatushash{$testcase}{'memcomp'} = (length($testsummary) > 0) ? $testsummary : "----"; - } + my @testsummarylines = grep { /MEMCOMP/} @statuslines; + my @testsummary_arr = (split(/\s+/, $testsummarylines[0])); + $teststatushash{$testcase}{'memcomp'} = ($#testsummarylines > -1) ? @testsummary_arr[0] : "----"; + $teststatushash{$testcase}{'comment'} .= " @testsummary_arr[3..$#testsummary_arr]"; #Compare to baseline - my ( $index ) = grep { $statuslines[$_] =~ /baseline compare summary/ } 0..$#statuslines; - my @testsummarylines = $statuslines[$index-1]; - $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - $teststatushash{$testcase}{'compare'} = (length($index) > 0) ? $testsummary : "----"; + my @testsummarylines = grep { /COMPARE_baseline/} @statuslines; + my @testsummary_arr = (split(/\s+/, $testsummarylines[0])); + $teststatushash{$testcase}{'compare'} = ($#testsummarylines > -1) ? @testsummary_arr[0] : "----"; + $teststatushash{$testcase}{'comment'} .= " @testsummary_arr[3..$#testsummary_arr]"; # Compare through put to baseline - my @testsummarylines = grep { /Throughput/} grep { /baseline/} @statuslines; - my $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - $teststatushash{$testcase}{'tputcomp'} = (length($testsummary) > 0) ? $testsummary : "----"; - if (length($testsummary) == 0){ - my @testsummarylines = grep { /tputcomp/} @statuslines; - my $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - $teststatushash{$testcase}{'tputcomp'} = (length($testsummary) > 0) ? $testsummary : "----"; - if ($testcase =~ "PFS" && $testsummary =~ "FAIL") - { - $teststatushash{$testcase}{'status'} = "FAIL"; - $teststatushash{$testcase}{'comment'} = "Performance failure!"; - next; - } + my @testsummarylines = grep { /TPUTCOMP/} @statuslines; + my @testsummary_arr = (split(/\s+/, $testsummarylines[0])); + $teststatushash{$testcase}{'tputcomp'} = ($#testsummarylines > -1) ? @testsummary_arr[0] : "----"; + $teststatushash{$testcase}{'comment'} .= " @testsummary_arr[3..$#testsummary_arr]"; + if ($testcase =~ "PFS" && @testsummary_arr[0] =~ "FAIL") + { + $teststatushash{$testcase}{'status'} = "FAIL"; + next; } # Check for INIT failure @@ -335,7 +327,7 @@ sub getTestStatus if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "SFAIL"; - $teststatushash{$testcase}{'comment'} = "Failed during INIT!"; + $teststatushash{$testcase}{'comment'} .= "Failed during INIT!"; next; } @@ -345,7 +337,7 @@ sub getTestStatus if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "SFAIL"; - $teststatushash{$testcase}{'comment'} = "Failed in CREATE_NEWCASE!"; + $teststatushash{$testcase}{'comment'} .= "Failed in CREATE_NEWCASE!"; next; } @@ -355,7 +347,7 @@ sub getTestStatus if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "SFAIL"; - $teststatushash{$testcase}{'comment'} = "Failed in XML!"; + $teststatushash{$testcase}{'comment'} .= "Failed in XML!"; next; } @@ -365,7 +357,7 @@ sub getTestStatus if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "SFAIL"; - $teststatushash{$testcase}{'comment'} = "Failed during SETUP!"; + $teststatushash{$testcase}{'comment'} .= "Failed during SETUP!"; next; } @@ -375,7 +367,7 @@ sub getTestStatus if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "CFAIL"; - $teststatushash{$testcase}{'comment'} = "Failed during SHAREDLIB_BUILD!"; + $teststatushash{$testcase}{'comment'} .= "Failed during SHAREDLIB_BUILD!"; next; } @@ -385,7 +377,7 @@ sub getTestStatus if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "CFAIL"; - $teststatushash{$testcase}{'comment'} = "Failed during MODEL_BUILD!"; + $teststatushash{$testcase}{'comment'} .= "Failed during MODEL_BUILD!"; next; } @@ -399,33 +391,21 @@ sub getTestStatus } #Compare for functionality - my ( $index ) = grep { $statuslines[$_] =~ /functionality summary \(Compare base and rest/ } 0..$#statuslines; - my @testsummarylines = $statuslines[$index-1]; + my @testsummarylines = grep { /COMPARE_base_rest/ } @statuslines; $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - if(length($index) > 0 &&defined $testsummary && $testsummary !~ /PASS/) - { - $teststatushash{$testcase}{'status'} = "FAIL"; - $teststatushash{$testcase}{'comment'} = "Functionality failed with restart!"; - next; - } - - my ( $index ) = grep { $statuslines[$_] =~ /unctionality summary \(Compare base and hybrid/ } 0..$#statuslines; - my @testsummarylines = $statuslines[$index-1]; - $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - if(length($index) > 0 && defined $testsummary && $testsummary !~ /PASS/) + if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "FAIL"; - $teststatushash{$testcase}{'comment'} = "Functionality failed with hybrid!"; + $teststatushash{$testcase}{'comment'} .= "Functionality failed with restart!"; next; } - my ( $index ) = grep { $statuslines[$_] =~ /functionality summary/ } 0..$#statuslines; - my @testsummarylines = $statuslines[$index-1]; + my @testsummarylines = grep { /COMPARE_base_hybrid/ } @statuslines; $testsummary = (split(/\s+/, $testsummarylines[0]))[0]; - if(length($index) > 0 && defined $testsummary && $testsummary !~ /PASS/) + if(defined $testsummary && $testsummary !~ /PASS/) { $teststatushash{$testcase}{'status'} = "FAIL"; - $teststatushash{$testcase}{'comment'} = "Functionality failed!"; + $teststatushash{$testcase}{'comment'} .= "Functionality failed with hybrid!"; next; } diff --git a/scripts/Tools/baseline_gen_comp b/scripts/Tools/baseline_gen_comp deleted file mode 100755 index c6cfd4c3d607..000000000000 --- a/scripts/Tools/baseline_gen_comp +++ /dev/null @@ -1,265 +0,0 @@ -#!/bin/bash - -# Bill Sacks -# 4-15-2015 - -#====================================================================== -# Overview -#====================================================================== - -# This script generates baselines and/or compares with previous baselines, for -# all tests that were run in a single test suite. It then outputs the test -# status (PASS/FAIL/etc.) for each comparison / generation. -# -# This is meant to be run after all tests in a given test suite are -# complete. Some typical uses are: (1) re-comparing against baselines if some -# baselines did not yet exist when the test suite was run, (2) comparing against -# a different set of baselines from the ones originally specified when you -# created the test suite, (3) generating baselines after the fact (if you ran -# the test suite without -generate). -# -# In addition to some of the options given to create_test_suite, you also need -# to provide the script with (1) the unique test ID of the test suite, and (2) -# the directory in which the various test run directories can be found. -# -# cprnc should be in your path, but if it isn't, the script tries to -# find cprnc in its yellowstone location -# -# See usage message for details on inputs. - -#====================================================================== -# Limitations -#====================================================================== - -# - Doesn't look at the PASS/FAIL status of a test. This means, for -# example, that a -generate may copy files to the baseline directory -# from a test that failed; these files might not be the correct, -# end-of-run history files, and so could later result in a -# misleading FAIL message from a -compare. -# -# - Only looks for history files in the run directory. This will fail -# to find a history file if things have been moved to the short-term -# archive directory. This could be fixed to look in the short-term -# archive directory if a file can't be found in the run directory, -# as is done in testcase_end. I haven't done this yet, partly -# because it adds an extra directory that the user has to specify -# (because we don't have access to the DOUT_S_ROOT variable), and -# partly because this shouldn't matter for most tests. - -#====================================================================== -# Testing -#====================================================================== - -# There currently is no unit test script for this. Here are the tests -# that should be done on this script: -# -# - Missing arguments -# -# - generate only -# -# - compare only -# -# - compare and generate - -#====================================================================== -# Local functions -#====================================================================== - -function Usage { - echo "SYNOPSIS" - echo " $progname [options]" - echo "" - echo " Generates baselines and/or compares with previous baselines," - echo " for all tests that were run in a single test suite." - echo " It then outputs the test status (PASS/FAIL/etc.) for each comparison / generation." - echo "" - echo " This is meant to be run after all tests in a given test suite are complete." - echo " Some typical uses are:" - echo " (1) re-comparing against baselines if some baselines did not yet exist" - echo " when the test suite was run" - echo " (2) comparing against a different set of baselines from the ones originally" - echo " specified when you created the test suite" - echo " (3) generating baselines after the fact (if you ran the test suite without -generate)" - echo "" - echo " The -baselineroot, -generate and -compare arguments will usually match the arguments" - echo " given to create_test_suite. The -testid argument will match the -testid argument" - echo " given to create_test_suite, if provided; otherwise, it will be the testid created" - echo " on the fly by that script." - echo "" - echo " cprnc should be in your path, but if it isn't, the script tries to find cprnc" - echo " in its yellowstone location" - echo "" - echo "OPTIONS" - echo " -baselineroot Path to directory containing baselines (required)" - echo "" - echo " -generate Tag name to use for generation (optional)" - echo " A directory with this name is created in baselineroot," - echo " if it doesn't already exist." - echo " Either -generate or -compare must be given" - echo "" - echo " -compare Tag name to use for comparison (optional)" - echo " Baselines are found in a directory with the name of this tag" - echo " within baselineroot." - echo " Either -generate or -compare must be given" - echo "" - echo " -testid ID of the test suite on which to run this script (required)" - echo " (e.g., 123456)" - echo "" - echo " -runloc Path to directory containing test run directories (optional)" - echo " A given test's run directory can be found in:" - echo " \$runloc/\$CASE/run" - echo " If not given, defaults to: $runloc_default" - echo "" - echo " -help Print this help message and exit" - echo "" - echo "EXAMPLES" - echo " $progname" - echo " -baselineroot /glade/scratch/\$USER/cesm_baselines" - echo " -generate cesm1_1_beta17" - echo " -compare cesm1_1_beta16" - echo " -testid 123456" - echo " -runloc /glade/scratch/\$USER" - echo " This will find directories in /glade/scratch/\$USER whose name ends with" - echo " the testid, 123456. For each such test (say, SMS.f09_g16.IG.yellowstone_intel.GC.123456)" - echo " it will find the last history files in the run directory of that test," - echo " for each possible component (cpl and clm - including h0, h1, etc.)." - echo " It will then copy those history files to" - echo " /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta17/SMS.f09_g16.IG.yellowstone_intel" - echo " and will compare that history file with the existing baseline in" - echo " /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/SMS.f09_g16.IG.yellowstone_intel" - echo "" -} - -#====================================================================== -# Set parameters -#====================================================================== -# If cprnc isn't in your path, this is where to find it -cprnc_default=/glade/p/cesm/cseg/tools/cprnc/cprnc - -#====================================================================== -# Begin main script -#====================================================================== - -progname=`basename $0` -tools_dir=`dirname $0` - -#---------------------------------------------------------------------- -# Define default values for command-line arguments -#---------------------------------------------------------------------- -baselineroot='' -generate_tag='' -compare_tag='' -testid='' - -runloc_default="/glade/scratch/$USER" -runloc=$runloc_default - -#---------------------------------------------------------------------- -# Process command-line arguments -#---------------------------------------------------------------------- -while [ $# -gt 0 ]; do - case $1 in - -baselineroot ) - baselineroot=$2 - shift - ;; - -generate ) - generate_tag=$2 - shift - ;; - -compare ) - compare_tag=$2 - shift - ;; - -testid ) - testid=$2 - shift - ;; - -runloc ) - runloc=$2 - shift - ;; - -help ) - Usage - exit 0 - ;; - * ) - echo "Unknown argument: $1" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 - ;; - esac - shift -done - -#---------------------------------------------------------------------- -# Exit if required command-line arguments weren't provided -#---------------------------------------------------------------------- -error=0 # no errors yet -if [ -z "$baselineroot" ]; then - echo "$progname: baselineroot must be provided" >&2 - error=1 -fi -# Either -generate or -compare must be provided, but not necessarily both -if [[ -z "$generate_tag" && -z "$compare_tag" ]]; then - echo "$progname: At least one of generate_tag or compare_tag must be provided" >&2 - error=1 -fi -if [ -z "$testid" ]; then - echo "$progname: testid must be provided" >&2 - error=1 -fi -if [ -z "$runloc" ]; then - echo "$progname: runloc must be provided" >&2 - error=1 -fi - -if [ $error -gt 0 ]; then - echo "" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 -fi - -#---------------------------------------------------------------------- -# Determine path to cprnc -#---------------------------------------------------------------------- -cprnc_path=`command -v cprnc` -if [ $? -gt 0 ]; then - # cprnc not found in path; use default - cprnc_path=$cprnc_default -fi - -#---------------------------------------------------------------------- -# Loop over directories with the given testid -#---------------------------------------------------------------------- -tests=`cd $runloc; ls -1d *.${testid}` -for testcase in $tests; do - # testcase will look like: SMS.T31_g37.IG4804.yellowstone_intel.134426 - # optionally with .C or .G or .GC before the testid - # Form testcase_base by stripping off the trailing testid and the optional .C, .G or .GC: - testcase_base=`echo $testcase | perl -p -e "s/(\.G?C?)?\.\Q$testid\E\$//"` - - if [ "$testcase_base" == "sharedlibroot" ]; then - continue - fi - - rundir=${runloc}/${testcase}/run - - # We need to call component_compgen_baseline.sh separately for compare & - # generate, because currently it can only do one at a time (because only one - # baseline_dir can be provided, and the baseline_dir is assumed to contain - # the actual tag, rather than being a directory with all tags' baselines) - - if [ -n "$compare_tag" ]; then - echo "--- Baseline Comparison ---: " - ${tools_dir}/component_compgen_baseline.sh -baseline_dir ${baselineroot}/${compare_tag}/${testcase_base} -test_dir ${rundir} -testcase ${testcase} -testcase_base ${testcase_base} -compare_tag ${compare_tag} -cprnc_exe ${cprnc_path} - fi - - if [ -n "$generate_tag" ]; then - echo "--- Baseline Generation ---: " - ${tools_dir}/component_compgen_baseline.sh -baseline_dir ${baselineroot}/${generate_tag}/${testcase_base} -test_dir ${rundir} -testcase ${testcase} -testcase_base ${testcase_base} -generate_tag ${generate_tag} -cprnc_exe ${cprnc_path} - fi - - echo "" -done - diff --git a/scripts/Tools/bless_test_results b/scripts/Tools/bless_test_results index 8700184c1bb4..eb342ff54c51 100755 --- a/scripts/Tools/bless_test_results +++ b/scripts/Tools/bless_test_results @@ -6,8 +6,7 @@ changes, and updating baselines. Purpose is, instead of re-running tests in generate mode, which is very slow, allow for very fast analsis and blessing of diffs. -Be aware that restart test will overwrite the original namelist files -with versions of the files that you should not bless. +You may need to load modules for cprnc to work. """ from standard_script_setup import * @@ -49,6 +48,7 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter ) default_baseline_name = CIME.utils.get_current_branch(repo=CIME.utils.get_cime_root()) + default_baseline_root = _MACHINE.get_value("CCSM_BASELINE") default_compiler = _MACHINE.get_default_compiler() scratch_root = _MACHINE.get_value("CESMSCRATCHROOT") default_testroot = os.path.join(scratch_root) @@ -64,6 +64,9 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter parser.add_argument("-b", "--baseline-name", default=default_baseline_name, help="Name of baselines to use, corresponds to branch used.") + parser.add_argument("--baseline-root", default=default_baseline_root, + help="Root of baselines.") + parser.add_argument("-c", "--compiler", default=default_compiler, help="Compiler of run you want to bless") @@ -91,7 +94,7 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter expect(not (args.namelists_only and args.hist_only), "Makes no sense to use --namelists-only and --hist-only simultaneously") - return args.baseline_name, args.test_root, args.compiler, args.test_id, args.namelists_only, args.hist_only, args.report_only, args.force, args.bless_tests + return args.baseline_name, args.baseline_root, args.test_root, args.compiler, args.test_id, args.namelists_only, args.hist_only, args.report_only, args.force, args.bless_tests ############################################################################### def _main_func(description): @@ -100,10 +103,11 @@ def _main_func(description): test_results = doctest.testmod(verbose=True) sys.exit(1 if test_results.failed > 0 else 0) - baseline_name, test_root, compiler, test_id, namelists_only, hist_only, report_only, force, bless_tests = \ + baseline_name, baseline_root, test_root, compiler, test_id, namelists_only, hist_only, report_only, force, bless_tests = \ parse_command_line(sys.argv, description) - CIME.bless_test_results.bless_test_results(baseline_name, test_root, compiler, test_id, namelists_only, hist_only, report_only, force, bless_tests) + success = CIME.bless_test_results.bless_test_results(baseline_name, baseline_root, test_root, compiler, test_id, namelists_only, hist_only, report_only, force, bless_tests) + sys.exit(0 if success else 1) ############################################################################### diff --git a/scripts/Tools/case.build b/scripts/Tools/case.build index 1ba15dbc8e81..6c99aa7b4f3c 100755 --- a/scripts/Tools/case.build +++ b/scripts/Tools/case.build @@ -11,6 +11,7 @@ from CIME.case import Case from CIME.utils import expect, append_status, find_system_test from CIME.XML.files import Files from CIME.XML.component import Component +from CIME.test_status import * ############################################################################### def parse_command_line(args, description): @@ -76,6 +77,7 @@ def _main_func(description): caseroot, sharedlib_only, model_only, cleanlist = parse_command_line(sys.argv, description) logging.info("calling build.case_build with caseroot=%s" %caseroot) + success = True with Case(caseroot, read_only=False) as case: testname = case.get_value('TESTCASE') @@ -84,20 +86,34 @@ def _main_func(description): elif(testname is not None): logging.warn("Building test for %s in directory %s" % (testname, caseroot)) - test = find_system_test(testname, case)(case) + try: + # The following line can throw exceptions if the testname is + # not found or the test constructor throws. We need to be + # sure to leave TestStatus in the appropriate state if that + # happens. + test = find_system_test(testname, case)(case) + except: + phase_to_fail = MODEL_BUILD_PHASE if model_only else SHAREDLIB_BUILD_PHASE + with TestStatus(test_dir=caseroot) as ts: + ts.set_status(phase_to_fail, TEST_FAIL_STATUS, comments="failed to initialize") + raise append_status("case.testbuild starting ", caseroot=caseroot,sfile="CaseStatus") - test.build(sharedlib_only=sharedlib_only, model_only=model_only) - append_status("case.testbuild complete", - caseroot=caseroot,sfile="CaseStatus") + success = test.build(sharedlib_only=sharedlib_only, model_only=model_only) + if success: + append_status("case.testbuild complete", + caseroot=caseroot,sfile="CaseStatus") else: append_status("case.build starting", caseroot=caseroot,sfile="CaseStatus") - build.case_build(caseroot, case=case, sharedlib_only=sharedlib_only, + success = build.case_build(caseroot, case=case, sharedlib_only=sharedlib_only, model_only=model_only) - append_status("case.build complete", - caseroot=caseroot,sfile="CaseStatus") + if success: + append_status("case.build complete", + caseroot=caseroot,sfile="CaseStatus") + + sys.exit(0 if success else 1) if __name__ == "__main__": _main_func(__doc__) diff --git a/scripts/Tools/compare_test_results b/scripts/Tools/compare_test_results new file mode 100755 index 000000000000..1e5f721bf9f6 --- /dev/null +++ b/scripts/Tools/compare_test_results @@ -0,0 +1,97 @@ +#!/usr/bin/env python + +""" +Analyze results from a test root area, comparing non-BFB +changes. Purpose is, instead of re-running tests +in compare mode, which is very slow, allow for very fast analsis of diffs. + +You may need to load modules for cprnc to work. +""" + +from standard_script_setup import * + +from CIME.utils import expect +from CIME.XML.machines import Machines +from CIME.compare_test_results import compare_test_results + +import argparse, sys, os, doctest + +_MACHINE = Machines() + +############################################################################### +def parse_command_line(args, description): +############################################################################### + parser = argparse.ArgumentParser( +usage="""\n%s [-r ] [-b -c ] [-t ] [ ...] [--verbose] +OR +%s --help +OR +%s --test + +\033[1mEXAMPLES:\033[0m + \033[1;32m# From most recent run, compare all changes \033[0m + > %s + \033[1;32m# From most recent run, compare only changes for test foo and bar only \033[0m + > %s foo bar + \033[1;32m# For an old run where you know test-id, compare only changes for test foo and bar only \033[0m + > %s foo bar -t mytestid + \033[1;32m# From most recent run of jenkins, compare history changes for next \033[0m + > %s -r /home/jenkins/acme/scratch/jenkins -b next + \033[1;32m# For typical CESM workflow, where baselines are named with tags \033[0m + > %s -t TESTID -b BASELINE_TAG +""" % ((os.path.basename(args[0]), ) * 8), + +description=description, + +formatter_class=argparse.ArgumentDefaultsHelpFormatter +) + + default_baseline_name = CIME.utils.get_current_branch(repo=CIME.utils.get_cime_root()) + default_baseline_root = _MACHINE.get_value("CCSM_BASELINE") + default_compiler = _MACHINE.get_default_compiler() + scratch_root = _MACHINE.get_value("CESMSCRATCHROOT") + default_testroot = os.path.join(scratch_root) + + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("-b", "--baseline-name", default=default_baseline_name, + help="Name of baselines to use, corresponds to branch used.") + + parser.add_argument("--baseline-root", default=default_baseline_root, + help="Root of baselines.") + + parser.add_argument("-c", "--compiler", default=default_compiler, + help="Compiler of run you want to compare") + + parser.add_argument("-r", "--test-root", default=default_testroot, + help="Path to test results that are being compared") + + parser.add_argument("-t", "--test-id", + help="Limit processes to case dirs matching this test-id. Can be useful if mutiple runs dumped into the same dir.") + + parser.add_argument("compare_tests", nargs="*", + help="When comparing, limit the comparison to tests matching these regex") + + args = parser.parse_args(args[1:]) + + CIME.utils.handle_standard_logging_options(args) + + return args.baseline_name, args.baseline_root, args.test_root, args.compiler, args.test_id, args.compare_tests + +############################################################################### +def _main_func(description): +############################################################################### + if ("--test" in sys.argv): + test_results = doctest.testmod(verbose=True) + sys.exit(1 if test_results.failed > 0 else 0) + + baseline_name, baseline_root, test_root, compiler, test_id, compare_tests = \ + parse_command_line(sys.argv, description) + + success = CIME.compare_test_results.compare_test_results(baseline_name, baseline_root, test_root, compiler, test_id, compare_tests) + sys.exit(0 if success else 1) + +############################################################################### + +if (__name__ == "__main__"): + _main_func(__doc__) diff --git a/scripts/Tools/component_compare.sh b/scripts/Tools/component_compare.sh deleted file mode 100755 index 97d4b809de68..000000000000 --- a/scripts/Tools/component_compare.sh +++ /dev/null @@ -1,323 +0,0 @@ -#!/bin/bash - -# Bill Sacks -# 8-23-12 - -#====================================================================== -# Overview -#====================================================================== - -# This script does the '-compare' step for a single test case and a -# single history file. -# -# It is intended to be used by another script, such as -# component_gen_comp. -# -# The definition of the result is similar to the compare_hist status -# in testcase_end, but may differ slightly. Other than possible minor -# differences, though, one use of this script can be: You start -# baseline runs and test runs at the same time (both using -# 'create_test_suite ... -clean off'); test runs finish before -# baseline generation finished (leading to BFAILs); then you can run -# this script with model=cpl to do the comparisons after the baseline -# generation completes (but first you will need to copy the cpl.hi.nc -# files in each baseline directory to cpl.h.nc). -# -# cprnc should be in your path, but if it isn't, the script tries to -# find cprnc in its yellowstone location -# -# See usage message for details on inputs & return value. - -#====================================================================== -# Testing -#====================================================================== - -# There currently is no unit test script for this. Here are the unit -# tests that should be done on this script: -# -# - Missing arguments -# - return status should be "UNDEF" -# -# - test_hist='', no baseline -# - return status should be "BFAIL_NA" -# - example: tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist DOES_NOT_EXIST -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist ''` -# -# - Given test history file doesn't exist, no baseline -# - return status should be "BFAIL_NA" -# - example: tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist DOES_NOT_EXIST -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist DOES_NOT_EXIST` -# -# - test_hist='' (but baseline file exists) -# - return status should be "FAIL" -# - example: tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist ''` -# -# - Given test history file doesn't exist (but baseline file exists) -# - return status should be "FAIL" -# - example: tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist DOES_NOT_EXIST` -# -# - Given test history file exists, but no baseline -# - return status should be "BFAIL" -# - example: component_compare.sh -baseline_dir $baseline_dir -baseline_hist DOES_NOT_EXIST -test_dir $test_dir -test_hist ERS_Ld211_P192x1.f19_g16.I_2000_CNDV_CROP.yellowstone_intel_crop.G.061555.clm2.h0.1998-07-30-00000.nc -# -# - History comparison fails: difference in values (e.g., set up by -# manually modifying values in a file) -# - return status should be "FAIL" -# - example (after running the PASS example from component_generate.sh, then running: ncap2 -s 'vvel[$time,$level,$y0,$x0]=1.7' ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029.cism.h.2046-01-01-00000.nc test.nc): tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist test.nc` -# -# - History comparison fails: different time stamp on file (e.g., from -# a different case from the one used to generate the baseline) -# (this is really testing the behavior of cprnc more than this script -# per se) -# - return status should be "FAIL" -# - example (after running the PASS example from component_generate.sh): tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/SMS_D.f09_g16.TG.bluefire_ibm.C.114029/run -test_hist SMS_D.f09_g16.TG.bluefire_ibm.C.114029.cism.h.0011-01-01-00000.nc` -# -# - History comparison passes -# - return status should be "PASS" -# - example (after running the PASS example from component_generate.sh): tst=`component_compare.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029.cism.h.2046-01-01-00000.nc` - -#====================================================================== -# Local functions -#====================================================================== - -function Usage { - echo "SYNOPSIS" - echo " $progname [options]" - echo "" - echo "RETURN VALUE" - echo " String of the format 'STATUS:Extra info about failure'" - echo " The string before the colon is the test status." - echo " The string after the colon is extra information about a failure" - echo " (this may be blank, but the colon will still be present)" - echo "" - echo " Possible values for STATUS are:" - echo " UNDEF : undefined result; this includes incorrect usage" - echo " BFAIL_NA: no baseline file and no history file for the test case" - echo " (note that BFAIL_NA is only a problem if it occurs for all possible" - echo " history extensions for a given component)" - echo " BFAIL : no baseline file, but there IS a history file for the test case" - echo " FAIL : comparison fails (including: baseline exists but no history file for the test case)" - echo " PASS : success" - echo "" - echo "OPTIONS" - echo " -cprnc_exe Full pathname to cprnc executable " - echo " -baseline_dir Full path to the baseline directory for this test (required)" - echo " -baseline_hist Name used for history file in the baseline directory (required)" - echo " -test_dir Full path to the directory containing history files for this test (required)" - echo " NOTE: You must have write permission in this directory (cprnc.out file is put there)" - echo " -test_hist Name of history file in the test directory (required)" - echo " (it is NOT an error for this to be an empty string, but this may generate a FAIL;" - echo " this will be the case when there are no history files for a component in the test directory)" - echo " -help Print this help message and exit" - echo "" - echo "EXAMPLES" - echo " TEST=SMS.T31_g37.IG4804.bluefire_ibm" - echo " CASE=\$TEST.GC.134426" - echo "" - echo " $progname -baseline_dir /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST" - echo " -baseline_hist clm.h.nc" - echo " -test_dir /glade/scratch/\$USER/\$CASE/run" - echo " -test_hist \$CASE.clm.h0.0001-12.nc" - echo " This will compare /glade/scratch/\$USER/\$CASE/run/\$CASE.clm.h0.0001-12.nc" - echo " with /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST/clm.h.nc" - echo "" - echo " $progname -baseline_dir /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST" - echo " -baseline_hist clm.h.nc" - echo " -test_dir /glade/scratch/\$USER/\$CASE/run" - echo " -test_hist ''" - echo " This will generate a FAIL because there is no history file to compare with the baseline" - echo " (or a BFAIL_NA if /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST/clm.h.nc also doesn't exist)" - echo "" -} - -# Given a relative path, convert to an absolute path -# (from http://www.lancejian.com/2011/04/13/get-absolute-path-of-the-running-bash-script.html) -function absolute_path { - relative_path="$1" - absolute_path=`cd "$relative_path"; pwd` - echo "$absolute_path" -} - -# Prints the test status and an info string, separated by ':' -# Inputs: -# status: test status -# info: optional auxiliary info about test failure -function print_result { - status="$1" - info="$2" - - echo "${status}:COMPCOMPARE${info}" -} - -#====================================================================== -# Begin main script -#====================================================================== - -progname=`basename $0` - -# need absolute path (rather than relative path) because we use this -# path after we have cd'ed to another location -tools_dir=$(absolute_path `dirname $0`) - -#---------------------------------------------------------------------- -# Set default return values -#---------------------------------------------------------------------- -status='UNDEF' -info='' - -#---------------------------------------------------------------------- -# Define default values for command-line arguments -#---------------------------------------------------------------------- -cprnc_exe='' -baseline_dir='' -baseline_hist='' -test_dir='' - -# test_hist will often be the empty string, so we initialize it to -# something else so we can check whether it has been provided -test_hist_init='XXX_NOTGIVEN_XXX' -test_hist=$test_hist_init - -#---------------------------------------------------------------------- -# Process command-line arguments -#---------------------------------------------------------------------- -while [ $# -gt 0 ]; do - case $1 in - -cprnc_exe ) - cprnc_exe=$2 - shift - ;; - -baseline_dir ) - baseline_dir=$2 - shift - ;; - -baseline_hist ) - baseline_hist=$2 - shift - ;; - -test_dir ) - test_dir=$2 - shift - ;; - -test_hist ) - test_hist=$2 - shift - ;; - -help ) - Usage - exit 0 - ;; - * ) - echo "$progname: Unknown argument: $1" >&2 - echo "Run $progname -help for usage" >&2 - # return default values for status & info - print_result $status "$info" - exit 1 - ;; - esac - shift -done - - -#---------------------------------------------------------------------- -# Exit if required command-line arguments weren't provided -#---------------------------------------------------------------------- -error=0 # no errors yet - -if [ -z "$cprnc_exe" ]; then - echo "$progname: cprnc_exe must be provided" >&2 - error=1 -fi -if [ -z "$baseline_dir" ]; then - echo "$progname: baseline_dir must be provided" >&2 - error=1 -fi -if [ -z "$baseline_hist" ]; then - echo "$progname: baseline_hist must be provided" >&2 - error=1 -fi -if [ -z "$test_dir" ]; then - echo "$progname: test_dir must be provided" >&2 - error=1 -fi -if [ "$test_hist" = "$test_hist_init" ]; then - echo "$progname: test_hist must be provided" >&2 - error=1 -fi - -if [ $error -gt 0 ]; then - echo "" >&2 - echo "Run $progname -help for usage" >&2 - # return default values for status & info - print_result $status "$info" - exit 1 -fi - -#---------------------------------------------------------------------- -# Determine whether baseline file exists -#---------------------------------------------------------------------- -if [ -f $baseline_dir/$baseline_hist ]; then - baseline_exists=1 -else - baseline_exists=0 -fi - -#---------------------------------------------------------------------- -# Determine whether test history file exists -#---------------------------------------------------------------------- -# Test history file may be the empty string if there is known to be no -# history file for this component. Another possibility is that the -# given test history file doesn't exist; this is more likely to be an -# error in the usage of the script rather than a real test failure, so -# we may want to rethink the status value in that case. -if [ -z "$test_hist" ]; then - test_exists=0 -elif [ -f $test_dir/$test_hist ]; then - test_exists=1 -else - test_exists=0 -fi - -#---------------------------------------------------------------------- -# If baseline and/or test history file don't exist, return appropriate -# error status -#---------------------------------------------------------------------- - -if [[ $baseline_exists -eq 0 && $test_exists -eq 0 ]]; then - status="BFAIL_NA" - info="neither baseline nor test history file exists" - print_result $status "$info" - exit 2 -elif [[ $baseline_exists -eq 0 && $test_exists -eq 1 ]]; then - status="BFAIL" - info="baseline history file does not exist" - print_result $status "$info" - exit 2 -elif [[ $baseline_exists -eq 1 && $test_exists -eq 0 ]]; then - status="FAIL" - info="no history file in test case" - print_result $status "$info" - exit 2 -fi - -# Note: at this point, we know that there is both a baseline history -# file and a test history file - -#---------------------------------------------------------------------- -# Compare history files, get test status -# Put output in a file named ${test_dir}/${test_hist}.cprnc.out -#---------------------------------------------------------------------- - -# We cd to test_dir so that $testhist.out.out is put there -# (note that this assumes that the user has write permission in test_dir) - -curdir=`pwd` -cd $test_dir - -cprnc_output=$($cprnc_exe $test_dir/$test_hist $baseline_dir/$baseline_hist | tee ${test_hist}.cprnc.out 2> /dev/null ) - -if [[ $cprnc_output == *IDENTICAL* ]]; then - print_result PASS "$info" - exit 0 -else - print_result FAIL "$info" - exit 3 -fi diff --git a/scripts/Tools/component_compare_baseline b/scripts/Tools/component_compare_baseline new file mode 100755 index 000000000000..ea8e43343a7c --- /dev/null +++ b/scripts/Tools/component_compare_baseline @@ -0,0 +1,55 @@ +#!/usr/bin/env python + +""" +Compares current component history files against baselines +""" + +from standard_script_setup import * + +from CIME.case import Case +from CIME.hist_utils import compare_baseline + +############################################################################### +def parse_command_line(args, description): +############################################################################### + parser = argparse.ArgumentParser( + usage="""\n%s [] [--verbose] +OR +%s --help +OR +%s --test + +\033[1mEXAMPLES:\033[0m + \033[1;32m# Compare baselines \033[0m + > %s +""" % ((os.path.basename(args[0]), ) * 4), + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter + ) + + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("caseroot", nargs="?", default=os.getcwd(), + help="Case directory") + + parser.add_argument("-b", "--baseline-dir", + help="Use custom baseline dir") + + args = parser.parse_args(args[1:]) + + CIME.utils.handle_standard_logging_options(args) + + return args.caseroot, args.baseline_dir + +############################################################################### +def _main_func(description): +############################################################################### + caseroot, baseline_dir = parse_command_line(sys.argv, description) + with Case(caseroot) as case: + success, comments = compare_baseline(case, baseline_dir) + print comments + + sys.exit(0 if success else 1) + +if __name__ == "__main__": + _main_func(__doc__) diff --git a/scripts/Tools/component_compare_move b/scripts/Tools/component_compare_move new file mode 100755 index 000000000000..7823e13f06eb --- /dev/null +++ b/scripts/Tools/component_compare_move @@ -0,0 +1,53 @@ +#!/usr/bin/env python + +""" +Change the suffix for the most recent batch of hist files. This allows us +to save these results if we want to run the case again. +""" + +from standard_script_setup import * + +from CIME.case import Case +from CIME.hist_utils import move + +############################################################################### +def parse_command_line(args, description): +############################################################################### + parser = argparse.ArgumentParser( + usage="""\n%s suffix [] [--verbose] +OR +%s --help +OR +%s --test + +\033[1mEXAMPLES:\033[0m + \033[1;32m# Setup case \033[0m + > %s +""" % ((os.path.basename(args[0]), ) * 4), + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter + ) + + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("suffix", + help="Suffix to append to hist files") + + parser.add_argument("caseroot", nargs="?", default=os.getcwd(), + help="Case directory") + + args = parser.parse_args(args[1:]) + + CIME.utils.handle_standard_logging_options(args) + + return args.suffix, args.caseroot + +############################################################################### +def _main_func(description): +############################################################################### + suffix, caseroot = parse_command_line(sys.argv, description) + with Case(caseroot) as case: + move(case, suffix) + +if __name__ == "__main__": + _main_func(__doc__) diff --git a/scripts/Tools/component_compare_move.sh b/scripts/Tools/component_compare_move.sh deleted file mode 100755 index 693b913e6617..000000000000 --- a/scripts/Tools/component_compare_move.sh +++ /dev/null @@ -1,185 +0,0 @@ -#!/bin/bash - -# Mariana Vertenstein -# 11-07-2014 - - -#====================================================================== -# Local functions -#====================================================================== - -function Usage { - echo "SYNOPSIS" - echo " $progname [options]" - echo "" - echo " Moves component history file to new name with suffix in the testcase directory" - echo " If there are multiple history file types for the component (e.g., h0 & h1)," - echo " it uses one of each type (e.g., the latest h0 file and the latest h1 file)." - echo "" - echo "OPTIONS" - echo " -rundir Path to directory containing test run directories (optional)" - echo " A given test's run directory can be found in: \$rundir/\$CASE/run" - echo "" - echo " -testcase case name (identical to $CASE)" - echo "" - echo " -suffix Suffix name to attache to testcase" - echo "" - echo " -help Print this help message and exit" - echo "" - echo "EXAMPLES" - echo " $progname" - echo " -rundir /glade/scratch/\$USER -testcase ERS.f19_g16.FC5.yellowstone_intel -suffix init" - echo "" -} - -#====================================================================== -# Begin main script -#====================================================================== - -tools_dir=`dirname $0` - -#---------------------------------------------------------------------- -# Define default values for command-line arguments -#---------------------------------------------------------------------- -testcase='' -rundir='' -suffix='' -add_iop='' - -#---------------------------------------------------------------------- -# Process command-line arguments -#---------------------------------------------------------------------- -while [ $# -gt 0 ]; do - case $1 in - -rundir ) - rundir=$2 - shift - ;; - -testcase ) - testcase=$2 - shift - ;; - -suffix ) - suffix=$2 - shift - ;; - -add_iop ) - add_iop=$2 - shift - ;; - -help ) - Usage - exit 0 - ;; - * ) - echo "Unknown argument: $1" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 - ;; - esac - shift -done - -#---------------------------------------------------------------------- -# Exit if required command-line arguments weren't provided -#---------------------------------------------------------------------- -error=0 # no errors yet -if [ -z "$rundir" ]; then - echo "$progname: rundir must be provided" >&2 - error=1 -fi -if [ -z "$testcase" ]; then - echo "$progname: testcase must be provided" >&2 - error=1 -fi -if [ -z "$suffix" ]; then - echo "$progname: suffix must be provided" >&2 - error=1 -fi -if [ $error -gt 0 ]; then - echo "" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 -fi - -#------------------------------------------------------------------ -# Loop over models -#------------------------------------------------------------------ - -if [ -n "$add_iop" ]; then - echo " add_iop is set" - suffix="${suffix}_${add_iop}" -fi - -cd $rundir -models=(cam cice clm2 pop cism cpl rtm mosart) -for model in ${models[*]}; do - - if [ "$model" = "cism" ]; then - extensions=(h) - elif [ "$model" = "clm2" ]; then - extensions=(h0 h1 h2 h3 h4 h5) - elif [ "$model" = "cpl" ]; then - extensions=(hi) - elif [ "$model" = "cice" ]; then - extensions=(h) - elif [ "$model" = "cam" ]; then - extensions=(h0 h1 h2 h3 h4 h5 h6 h7) - elif [ "$model" = "pop" ]; then - extensions=(h) - elif [ "$model" = "rtm" ]; then - extensions=(h0 h1 h2) - elif [ "$model" = "mosart" ]; then - extensions=(h0 h1 h2) - fi - - #------------------------------------------------------------------ - # Loop over history file extensions - #------------------------------------------------------------------ - - for extension in ${extensions[*]}; do - - #-------------------------------------------------------------- - # Find last component hist file in this run directory, and - # determine corresponding name of the baseline file (used for - # either generation or comparison) - #-------------------------------------------------------------- - # Note that we find the last alphabetically rather than by time - # stamp, because the last by time stamp can be non-deterministic. - # Note that we need a * after ${model} to capture multi-instance - # output - - if [ "$suffix" = "multiinst" ]; then - instances=(_0001 _0002) - else - instances=(none _0001 _0002) - fi - for inst in ${instances[*]}; do - if [ "$inst" = "none" ]; then - test_hist=`ls -1 ${testcase}.${model}.${extension}.*.nc 2>/dev/null | tail -1` - else - test_hist=`ls -1 ${testcase}.${model}${inst}.${extension}.*.nc 2>/dev/null | tail -1` - fi - - if [[ -f ${test_hist} ]]; then - test_hist_suffix=${test_hist}.${suffix} - cd "$rundir"; - - # remove suffix file if already present - if [[ -f ${test_hist_suffix} ]]; then - rm "$test_hist_suffix" - fi - - # FIXME(bja, 2014-11) temp change to test if cp fixes the - # problem with mfilt in restart tests. If it does, then - # rename this script to component_compare_copy.sh ! - /bin/cp "$test_hist" "$test_hist_suffix" - fi - done - - done - -done # loop over history file extensions - - - diff --git a/scripts/Tools/component_compare_test b/scripts/Tools/component_compare_test new file mode 100755 index 000000000000..aae11911e49c --- /dev/null +++ b/scripts/Tools/component_compare_test @@ -0,0 +1,58 @@ +#!/usr/bin/env python + +""" +Compares two component history files in the testcase directory +""" + +from standard_script_setup import * + +from CIME.case import Case +from CIME.hist_utils import compare_test + +############################################################################### +def parse_command_line(args, description): +############################################################################### + parser = argparse.ArgumentParser( + usage="""\n%s suffix1 suffix2 [] [--verbose] +OR +%s --help +OR +%s --test + +\033[1mEXAMPLES:\033[0m + \033[1;32m# Setup case \033[0m + > %s +""" % ((os.path.basename(args[0]), ) * 4), + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter + ) + + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("suffix1", + help="The suffix of the first set of files") + + parser.add_argument("suffix2", + help="The suffix of the second set of files") + + parser.add_argument("caseroot", nargs="?", default=os.getcwd(), + help="Case directory") + + args = parser.parse_args(args[1:]) + + CIME.utils.handle_standard_logging_options(args) + + return args.suffix1, args.suffix2, args.caseroot + +############################################################################### +def _main_func(description): +############################################################################### + suffix1, suffix2, caseroot = parse_command_line(sys.argv, description) + with Case(caseroot) as case: + success, comments = compare_test(case, suffix1, suffix2) + print comments + + sys.exit(0 if success else 1) + +if __name__ == "__main__": + _main_func(__doc__) diff --git a/scripts/Tools/component_compare_test.sh b/scripts/Tools/component_compare_test.sh deleted file mode 100755 index 1412fc3a49ba..000000000000 --- a/scripts/Tools/component_compare_test.sh +++ /dev/null @@ -1,411 +0,0 @@ -#!/bin/bash - -# Mariana Vertenstein -# 11-07-2014 - - -#====================================================================== -# Local functions -#====================================================================== - -function Usage { - echo "SYNOPSIS" - echo " $progname [options]" - echo "" - echo " Compares two component history files in the testcase directory" - echo " If there are multiple history file types for the component (e.g., h0 & h1)," - echo " it uses one of each type (e.g., the latest h0 file and the latest h1 file)." - echo " It then outputs the test status (PASS/FAIL/etc.) for each comparison / generation." - echo "" - echo "OPTIONS" - echo " -rundir Path to directory containing test run directories (optional)" - echo " A given test's run directory can be found in: \$rundir/\$CASE/run" - echo "" - echo " -testcase Full name of testcase including testid" - echo "" - echo " -testcase_base Full name of testcase without testid" - echo "" - echo " -suffix1 Suffix to attach to first file to compare" - echo "" - echo " -suffix2 Suffix to attach to second file to compare" - echo "" - echo " -help Print this help message and exit" - echo "" -} - -# Given a status_and_info string, return just the status portion -# Inputs: -# - status_and_info: colon-delimited string of the format -# "STATUS:Extra info about failure". The string before the colon -# is the test status. The string after the colon is extra -# information abaout a failure (this may be blank, but the colon -# must be present). (It is okay for the extra info to itself -# contain one or more colons.) -function get_status { - local status_and_info="$1" - echo $status_and_info | cut -d ':' -f 1 -} - -# Given a status_and_info string, return just the info portion -# Inputs: -# - status_and_info: colon-delimited string of the format -# "STATUS:Extra info about failure". The string before the colon -# is the test status. The string after the colon is extra -# information abaout a failure (this may be blank, but the colon -# must be present). (It is okay for the extra info to itself -# contain one or more colons.) -function get_info { - local status_and_info="$1" - echo $status_and_info | cut -d ':' -f 2- -} - -# Prints the status of the test in a standardized format for test results -# Inputs: -# - status -# - info -# - testcase: name of test case -function print_status { - local status="$1" - local info="$2" - local testcase="$3" - - # Enclose info in parentheses - if [ -n "$info" ]; then - info_str="($info)" - else - info_str="" - fi - - # Print formatted test result - printf '%-3s %s compare\n' "$status" "${testcase}" - - echo "COMMENT $info" -} - -function print_comment { - local status="$1" - local info="$2" - local testcase="$3" - - # Enclose info in parentheses - if [ -n "$info" ]; then - info_str="($info)" - else - info_str="" - fi - - echo "COMMENT for $testcase $info" -} - -#====================================================================== -# Begin main script -#====================================================================== - -tools_dir=`dirname $0` - -#---------------------------------------------------------------------- -# Define default values for command-line arguments -#---------------------------------------------------------------------- -rundir='' -testcase='' -testcase_base='' -suffix1='' -suffix2='' -add_iop='' -msg='' - -#---------------------------------------------------------------------- -# Process command-line arguments -#---------------------------------------------------------------------- -while [ $# -gt 0 ]; do - case $1 in - -msg ) - msg=$2 - shift - ;; - -rundir ) - rundir=$2 - shift - ;; - -testcase ) - testcase=$2 - shift - ;; - -testcase_base ) - testcase_base=$2 - shift - ;; - -suffix1 ) - suffix1=$2 - shift - ;; - -suffix2 ) - suffix2=$2 - shift - ;; - -add_iop ) - add_iop=$2 - shift - ;; - -help ) - Usage - exit 0 - ;; - * ) - echo "Unknown argument: $1" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 - ;; - esac - shift -done - -#---------------------------------------------------------------------- -# Exit if required command-line arguments weren't provided -#---------------------------------------------------------------------- -error=0 # no errors yet -if [ -z "$rundir" ]; then - echo "$progname: rundir must be provided" >&2 - error=1 -fi -if [ -z "$testcase" ]; then - echo "$progname: testcase must be provided" >&2 - error=1 -fi -if [ -z "$testcase_base" ]; then - echo "$progname: testcase_base must be provided" >&2 - error=1 -fi -if [ -z "$suffix1" ]; then - echo "$progname: suffix1 must be provided" >&2 - error=1 -fi -if [ -z "$suffix2" ]; then - echo "$progname: suffix2 must be provided" >&2 - error=1 -fi -if [ $error -gt 0 ]; then - echo "" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 -fi - -#------------------------------------------------------------------ -# Determine location of cprnc -#------------------------------------------------------------------ -if [ -z $CASEROOT ]; then - echo " environment variable CASEROOT is not defined " - exit 1 -fi -cd $CASEROOT -cprnc_exe=`./xmlquery CCSM_CPRNC -value` - -#------------------------------------------------------------------ -# Loop over models -#------------------------------------------------------------------ - -cd $rundir -overall_status='PASS' - -models=(cam cice clm2 pop cism cpl rtm mosart) -for model in ${models[*]}; do - - if [ "$model" = "cism" ]; then - extensions=(h) - elif [ "$model" = "clm2" ]; then - extensions=(h0 h1 h2 h3 h4 h5) - elif [ "$model" = "cpl" ]; then - extensions=(hi) - elif [ "$model" = "cice" ]; then - extensions=(h) - elif [ "$model" = "cam" ]; then - extensions=(h0 h1 h2 h3 h4 h5 h6 h7 h8 h9 hs) - elif [ "$model" = "pop" ]; then - extensions=(h) - if [ "$suffix2" = "rest" ]; then - # Skip restart checks for pop! Temporary hack until MPAS goes in! - continue - fi - elif [ "$model" = "rtm" ]; then - extensions=(h0 h1 h2) - elif [ "$model" = "mosart" ]; then - extensions=(h0 h1 h2) - fi - - #------------------------------------------------------------------ - # Loop over history file extensions - #------------------------------------------------------------------ - for extension in ${extensions[*]}; do - - #-------------------------------------------------------------- - # Find last component hist files in this run directory, and - # determine corresponding name of the baseline file (used for - # either generation or comparison) - #-------------------------------------------------------------- - # Note that we find the last alphabetically rather than by time - # stamp, because the last by time stamp can be non-deterministic. - # Note that we need a * after ${model} to capture multi-instance - # output - #------------------------------------------------------------- - # Do comparison - #------------------------------------------------------------- - - if [[ "$testcase" =~ ^NC[KRO]_.* ]]; then - - hist1=`cd $rundir; ls -1 ${testcase}.${model}.${extension}.*.nc.${suffix1} 2>/dev/null | tail -1` - hist2_0001=`cd $rundir; ls -1 ${testcase}.${model}_0001.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - hist2_0002=`cd $rundir; ls -1 ${testcase}.${model}_0002.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - - if [[ -f ${hist1} ]] && [[ -f ${hist2_0001} ]] && [[ -f ${hist2_0002} ]] ; then - - if [ "$model" != "cpl" ]; then - # do all model comparisons except for cpl, since cpl history does not write out all instances - but just instance 1 - - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1" -test_hist "$hist2_0001" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} and .${suffix2} for _0001)" "${testcase_base}" - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1" -test_hist "$hist2_0002" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} and .${suffix2} for _0002)" "${testcase_base}" - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - - fi - fi - - elif [[ "$testcase" =~ .*_N2.* ]]; then - - hist1_0001=`cd $rundir; ls -1 ${testcase}.${model}_0001.${extension}.*.nc.${suffix1} 2>/dev/null | tail -1` - hist2_0001=`cd $rundir; ls -1 ${testcase}.${model}_0001.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - hist1_0002=`cd $rundir; ls -1 ${testcase}.${model}_0002.${extension}.*.nc.${suffix1} 2>/dev/null | tail -1` - hist2_0002=`cd $rundir; ls -1 ${testcase}.${model}_0002.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - - if [[ -f ${hist1_0001} ]] && [[ -f ${hist1_0002} ]] && [[ -f ${hist2_0001} ]] && [[ -f ${hist2_0002} ]] ; then - - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1_0001" -test_hist "$hist1_0002" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} for _0001 and .${suffix2} for _0001)" "${testcase_base}" - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist2_0002" -test_hist "$hist2_0002" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} for _0002 and .${suffix2} for _0002)" "${testcase_base}" - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - - fi - - - elif [[ "$testcase" =~ .*_IOP.* ]]; then - - if [ -z "$add_iop" ]; then - - # determine status of non-IOP test - - hist1=`cd $rundir; ls -1 ${testcase}.${model}.${extension}.*.nc.${suffix1} 2>/dev/null | tail -1` - hist2=`cd $rundir; ls -1 ${testcase}.${model}.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - - if [[ -f ${hist1} ]] && [[ -f ${hist2} ]] ; then - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1" -test_hist "$hist2" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} and .${suffix2} files)" "${testcase_base}" - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - fi - fi - - if [ -n "$add_iop" ]; then - - # determine status of iop test - - hist1=`cd $rundir; ls -1 ${testcase}.${model}*.${extension}.*.nc.${suffix1} 2>/dev/null | tail -1` - hist2=`cd $rundir; ls -1 ${testcase}.${model}*.${extension}.*.nc.${suffix1}_${add_iop} 2>/dev/null | tail -1` - - if [[ -f ${hist1} ]] && [[ -f ${hist2} ]] ; then - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1" -test_hist "$hist2" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} and .${suffix1}_${add_iop} files)" "${testcase_base}" - fi - - hist1=`cd $rundir; ls -1 ${testcase}.${model}*.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - hist2=`cd $rundir; ls -1 ${testcase}.${model}*.${extension}.*.nc.${suffix2}_${add_iop} 2>/dev/null | tail -1` - - if [[ -f ${hist1} ]] && [[ -f ${hist2} ]] ; then - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1" -test_hist "$hist2" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix2} and .${suffix2}_${add_iop} files)" "${testcase_base}" - fi - - fi - - else - - # No _IOP_ or _N2_ attributes or multi-instance NCK_ or NCR_ tests - hist1=`cd $rundir; ls -1 ${testcase}.${model}.${extension}.*.nc.${suffix1} 2>/dev/null | tail -1` - hist2=`cd $rundir; ls -1 ${testcase}.${model}.${extension}.*.nc.${suffix2} 2>/dev/null | tail -1` - - if [[ -f ${hist1} ]] && [[ -f ${hist2} ]] ; then - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$rundir" -test_dir "$rundir" -baseline_hist "$hist1" -test_hist "$hist2" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - print_comment "$compare_status" "$compare_info: ${model}.${extension}.nc : test compare ${model}.${extension} (.${suffix1} and .${suffix2} files)" "${testcase_base}" - if [ "$compare_status" != "PASS" ]; then - overall_status="FAIL" - fi - elif [[ -f ${hist1} ]]; then - overall_status = "FAIL" - print_comment "file status" "File ${hist2} not found" "${testcase_base}" - elif [[ -f ${hist2} ]]; then - overall_status = "FAIL" - print_comment "file status" "File ${hist1} not found" "${testcase_base}" - fi - - fi - - done # loop over history file extensions - -done # loop over models - -if [ -z "$msg" ]; then - print_status "$overall_status" "$compare_info: test functionality summary" "${testcase_base}" -else - print_status "$overall_status" "$compare_info: test functionality summary ($msg)" "${testcase_base}" -fi - -if [[ $overall_status == FAIL ]]; then - exit 1 -else - exit 0 -fi - - - - - - - - - - diff --git a/scripts/Tools/component_compgen_baseline.sh b/scripts/Tools/component_compgen_baseline.sh deleted file mode 100755 index 6b5aa1cd3935..000000000000 --- a/scripts/Tools/component_compgen_baseline.sh +++ /dev/null @@ -1,350 +0,0 @@ -#!/bin/bash - -# Mariana Vertenstein -# 11-07-2014 - - -#====================================================================== -# Local functions -#====================================================================== - -function Usage { - echo "SYNOPSIS" - echo " $progname [options]" - echo "" - echo " Does a baseline comparison of history files or a baseline generation of history files for one test" - echo " If there are multiple history file types for the component (e.g., h0 & h1)," - echo " it uses one of each type (e.g., the latest h0 file and the latest h1 file)." - echo " It then outputs the test status (PASS/BFAIL/GFAIL/etc.) for each comparison / generation." - echo "" - echo " Exactly one of -generate_tag or -compare_tag should be provided." - echo " (They cannot both be provided, because only one -baseline_dir is supplied.)" - echo "" - echo "OPTIONS" - echo " -baseline_dir Path to directory containing baselines for this particular test (required)" - echo " If -compare_tag is given, this gives the path to the" - echo " baselines to compare against." - echo " If -generate_tag is given, this gives the path in which" - echo " the new baselines should be placed." - echo "" - echo " -test_dir Path to the given test's run directory (required)" - echo "" - echo " -testcase Full name of case including testid (required)" - echo "" - echo " -testcase_base Name of test case without testid, used for printing results (required)" - echo "" - echo " -generate_tag Tag to use for baseline generation (optional)" - echo "" - echo " -compare_tag Tag to use for baseline comparison (optional)" - echo "" - echo " -cprnc_exe Full pathname to cprnc executable (optional)" - echo " This is optional, but if not provided, then the environment" - echo " variable CASEROOT must be defined (in which case, CCSM_CPRNC" - echo " will be found from the xml files in CASEROOT)." - echo "" - echo " -help Print this help message and exit" - echo "" - echo "" -} - -# Given a status_and_info string, return just the status portion -# Inputs: -# - status_and_info: colon-delimited string of the format -# "STATUS:Extra info about failure". The string before the colon -# is the test status. The string after the colon is extra -# information abaout a failure (this may be blank, but the colon -# must be present). (It is okay for the extra info to itself -# contain one or more colons.) -function get_status { - local status_and_info="$1" - echo $status_and_info | cut -d ':' -f 1 -} - -# Given a status_and_info string, return just the info portion -# Inputs: -# - status_and_info: colon-delimited string of the format -# "STATUS:Extra info about failure". The string before the colon -# is the test status. The string after the colon is extra -# information abaout a failure (this may be blank, but the colon -# must be present). (It is okay for the extra info to itself -# contain one or more colons.) -function get_info { - local status_and_info="$1" - echo $status_and_info | cut -d ':' -f 2- -} - -# Prints the status of the test in a standardized format for test results -# Inputs: -# - status -# - info -# - testcase: name of test case -function print_status { - local status="$1" - local info="$2" - local testcase="$3" - local action="$4" - - # Enclose info in parentheses - if [ -n "$info" ]; then - info_str="($info)" - else - info_str="" - fi - - # Print formatted test result - printf '%-3s %s %s\n' "$status" "${testcase}" "${action}" - - echo "COMMENT $info" -} - -function print_comment { - local status="$1" - local info="$2" - local testcase="$3" - - # Enclose info in parentheses - if [ -n "$info" ]; then - info_str="($info)" - else - info_str="" - fi - - echo "COMMENT for $testcase $info" -} - -#====================================================================== -# Begin main script -#====================================================================== - -progname=`basename $0` -tools_dir=`dirname $0` - -#---------------------------------------------------------------------- -# Define default values for command-line arguments -#---------------------------------------------------------------------- -cprnc_exe='' -baseline_dir='' -test_dir='' -generate='' -compare_tag='' -msg='' - -#---------------------------------------------------------------------- -# Process command-line arguments -#---------------------------------------------------------------------- -while [ $# -gt 0 ]; do - case $1 in - -msg ) - msg=$2 - shift - ;; - -baseline_dir ) - baseline_dir=$2 - shift - ;; - -test_dir ) - test_dir=$2 - shift - ;; - -testcase ) - testcase=$2 - shift - ;; - -testcase_base ) - testcase_base=$2 - shift - ;; - -generate_tag ) - generate_tag=$2 - shift - ;; - -compare_tag ) - compare_tag=$2 - shift - ;; - -cprnc_exe ) - cprnc_exe=$2 - shift - ;; - - -help ) - Usage - exit 0 - ;; - * ) - echo "Unknown argument: $1" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 - ;; - esac - shift -done - -#---------------------------------------------------------------------- -# Exit if required command-line arguments weren't provided -#---------------------------------------------------------------------- -error=0 # no errors yet -if [ -z "$baseline_dir" ]; then - echo "$progname: baseline_dir must be provided" >&2 - error=1 -fi -if [ -z "$test_dir" ]; then - echo "$progname: test_dir must be provided" >&2 - error=1 -fi -if [ -z "$testcase" ]; then - echo "$progname: testcase must be provided" >&2 - error=1 -fi -if [ -z "$testcase_base" ]; then - echo "$progname: testcase_base must be provided" >&2 - error=1 -fi -if [ -z "$compare_tag" -a -z "$generate_tag" ]; then - echo "$progname: Must provide either -compare_tag or -generate_tag" >&2 - error=1 -fi -if [ -n "$compare_tag" -a -n "$generate_tag" ]; then - echo "$progname: Can only provide -compare_tag OR -generate_tag, not both" >&2 - echo "(this is because only one -baseline_dir is provided to this script)" >&2 - error=1 -fi - -if [ $error -gt 0 ]; then - echo "" >&2 - echo "Run $progname -help for usage" >&2 - exit 1 -fi - -#------------------------------------------------------------------ -# Determine location of cprnc, if not provided -#------------------------------------------------------------------ -if [ -z "$cprnc_exe" ]; then - if [ -z $CASEROOT ]; then - echo " environment variable CASEROOT is not defined " - exit 1 - fi - cd $CASEROOT - cprnc_exe=`./xmlquery CCSM_CPRNC -value` -fi - -#------------------------------------------------------------------ -# Loop over models -#------------------------------------------------------------------ - -overall_compare_status='PASS' -overall_generate_status='PASS' - -models=( cam cice cism clm2 cpl pop rtm mosart) -for model in ${models[*]}; do - if [ "$model" = "cism" ]; then - extensions=(h) - elif [ "$model" = "clm2" ]; then - extensions=(h0 h1 h2 h3 h4 h5) - elif [ "$model" = "cpl" ]; then - extensions=(hi) - elif [ "$model" = "cice" ]; then - extensions=(h) - elif [ "$model" = "cam" ]; then - extensions=(h0 h1 h2 h3 h4 h5 h6 h7) - elif [ "$model" = "pop" ]; then - extensions=(h) - elif [ "$model" = "rtm" ]; then - extensions=(h0 h1 h2) - elif [ "$model" = "mosart" ]; then - extensions=(h0 h1 h2) - fi - - #------------------------------------------------------------------ - # Loop over history file extensions - #------------------------------------------------------------------ - for extension in ${extensions[*]}; do - - # Set baseline history name - # Note that this name drops (1) the timestamp, and (2) the - # instance number for multi-instance runs - baseline_hist=${model}.${extension}.nc - - #-------------------------------------------------------------- - # Find last component hist files in this run directory, and - # determine corresponding name of the baseline file (used for - # either generation or comparison) - #-------------------------------------------------------------- - # Note that we find the last alphabetically rather than by time - # stamp, because the last by time stamp can be non-deterministic. - # Note that we need a * after ${model} to capture multi-instance - # output - - test_hist=`cd $test_dir; ls -1 ${testcase}.${model}*.${extension}.*.nc.base 2>/dev/null | tail -1` - - if [ -n "$test_hist" ]; then - - #------------------------------------------------------------- - # Do comparison, if desired - #------------------------------------------------------------- - if [ -n "$compare_tag" ]; then - compare_result=`${tools_dir}/component_compare.sh -baseline_dir "$baseline_dir" -baseline_hist "$baseline_hist" -test_dir "$test_dir" -test_hist "$test_hist" -cprnc_exe "$cprnc_exe"` - compare_status=`get_status "$compare_result"` - compare_info=`get_info "$compare_result"` - if [ "$compare_status" != "BFAIL_NA" ]; then - if [ -z "$msg" ]; then - print_comment "$compare_status" "$compare_info : $model.${extension}.nc : baseline compare ${model}.${extension} base with ${compare_tag}" "${testcase_base}" - else - print_comment "$compare_status" "$compare_info : $model.${extension}.nc : baseline compare ${model}.${extension} ($msg)" "${testcase_base}" - fi - # if ANY teststatus is FAIL then overall status is FAIL - if [ "$compare_status" = "FAIL" ]; then - overall_compare_status="FAIL" - fi - # if ANY teststatus is BFAIL then overall status is BFAIL - if [ "$overall_compare_status" != "FAIL" ]; then - if [ "$compare_status" = "BFAIL" ]; then - overall_compare_status="BFAIL" - fi - fi - fi - fi - - #-------------------------------------------------------------- - # Do baseline generation, if desired - #-------------------------------------------------------------- - if [ -n "$generate_tag" ]; then - generate_result=`${tools_dir}/component_generate.sh -baseline_dir "$baseline_dir" -baseline_hist "$baseline_hist" -test_dir "$test_dir" -test_hist "$test_hist"` - generate_status=`get_status "$generate_result"` - generate_info=`get_info "$generate_result"` - if [ "$generate_status" != "GFAIL_NA" ]; then - print_comment "$generate_status" "$generate_info : $model.${extension}.nc : baseline generate ${model}.${extension} in baseline dir ${generate_tag}" "${testcase_base}" - fi - # if ANY teststatus is GFAIL then overall status is GFAIL - if [ "$generate_status" = "GFAIL" ]; then - overall_generate_status="GFAIL" - fi - fi - fi - - done # loop over history file extensions - -done # loop over models - -if [ -n "$compare_tag" ]; then - if [ -z "$msg" ]; then - print_status "$overall_compare_status" "$compare_info : baseline compare summary" "${testcase_base}" compare - else - print_status "$overall_compare_status" "$compare_info : baseline compare summary ($msg)" "${testcase_base}" compare - fi - - if [[ $overall_compare_status == PASS ]]; then - exit 0 - else - exit 2 - fi -fi -if [ -n "$generate_tag" ]; then - print_status "$overall_generate_status" "$generate_info : baseline generate summary" "${testcase_base}" generate - - if [[ $overall_generate_status == PASS ]]; then - exit 0 - else - exit 2 - fi -fi diff --git a/scripts/Tools/component_generate.sh b/scripts/Tools/component_generate.sh deleted file mode 100755 index 1dcb0c9547b0..000000000000 --- a/scripts/Tools/component_generate.sh +++ /dev/null @@ -1,238 +0,0 @@ -#!/bin/bash - -# Bill Sacks -# 8-22-12 - -#====================================================================== -# Overview -#====================================================================== - -# This script does the '-generate' step for a single test case and a -# single history file. -# -# It is intended to be used by another script, such as -# component_gen_comp. -# -# The definition of the result is similar to that in testcase_end, but -# differs slightly. For example: In testcase_end, it is a FAIL for -# baselineroot to not exist; here we allow that, and happily generate -# that directory for you if it doesn't already exist. -# -# Exit status will generally be 0 (even for test failure), but will be -# non-zero for incorrect usage. -# -# See usage message for details on inputs & return value. - -#====================================================================== -# Testing -#====================================================================== - -# There currently is no unit test script for this. Here are the unit -# tests that should be done on this script: -# -# - Missing arguments -# - return status should be "UNDEF" -# -# - test_hist='' -# - return status should be "GFAIL" -# - example: tst=`component_generate.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist ''` -# -# - success -# - return status should be "PASS" -# - example: tst=`component_generate.sh -baseline_dir /glade/scratch/sacks/cesm_baselines/test_script/ERI44y.f09_g16.TGRCP85.bluefire_ibm -baseline_hist cism.h.nc -test_dir /ptmp/sacks/ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029/run -test_hist ERI44y.f09_g16.TGRCP85.bluefire_ibm.C.114029.cism.h.2046-01-01-00000.nc` - -#====================================================================== -# Local functions -#====================================================================== - -function Usage { - echo "SYNOPSIS" - echo " $progname [options]" - echo "" - echo "RETURN VALUE" - echo " String of the format 'STATUS:Extra info about failure'" - echo " The string before the colon is the test status." - echo " The string after the colon is extra information about a failure" - echo " (this may be blank, but the colon will still be present)" - echo "" - echo " Possible values for STATUS are:" - echo " UNDEF : undefined result; this includes incorrect usage" - echo " GFAIL_NA: no history file in test case" - echo " (note that GFAIL_NA is only a problem if it occurs for all possible" - echo " history extensions for a given component)" - echo " GFAIL : error creating baseline directory or copying baseline file into place" - echo " PASS : success" - echo "" - echo "OPTIONS" - echo " -baseline_dir Full path to the baseline directory for this test (required)" - echo " -baseline_hist Name used for history file in the baseline directory (required)" - echo " -test_dir Full path to the directory containing history files for this test (required)" - echo " -test_hist Name of history file in the test directory (required)" - echo " (it is NOT an error for this to be an empty string, but this will generate a GFAIL_NA;" - echo " this will be the case when there are no history files for a component in the test directory)" - echo " -help Print this help message and exit" - echo "" - echo "EXAMPLES" - echo " TEST=SMS.T31_g37.IG4804.bluefire_ibm" - echo " CASE=\$TEST.GC.134426" - echo "" - echo " $progname -baseline_dir /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST" - echo " -baseline_hist clm.h.nc" - echo " -test_dir /glade/scratch/\$USER/\$CASE/run" - echo " -test_hist \$CASE.clm.h0.0001-12.nc" - echo " This will copy /glade/scratch/\$USER/\$CASE/run/\$CASE.clm.h0.0001-12.nc" - echo " to /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST/clm.h.nc" - echo "" - echo " $progname -baseline_dir /glade/scratch/\$USER/cesm_baselines/cesm1_1_beta16/\$TEST" - echo " -baseline_hist clm.h.nc" - echo " -test_dir /glade/scratch/\$USER/\$CASE/run" - echo " -test_hist ''" - echo " This will generate a GFAIL_NA because there is no history file to copy to the baseline directory" - echo "" -} - -# Prints the test status and an info string, separated by ':' -# Inputs: -# status: test status -# info: optional auxiliary info about test failure -function print_result { - status="$1" - info="$2" - - echo "${status}:${info}" -} - - -#====================================================================== -# Begin main script -#====================================================================== - -progname=`basename $0` - -#---------------------------------------------------------------------- -# Set default return values -#---------------------------------------------------------------------- -status='UNDEF' -info='' - -#---------------------------------------------------------------------- -# Define default values for command-line arguments -#---------------------------------------------------------------------- -baseline_dir='' -baseline_hist='' -test_dir='' - -# test_hist will often be the empty string, so we initialize it to -# something else so we can check whether it has been provided -test_hist_init='XXX_NOTGIVEN_XXX' -test_hist=$test_hist_init - -#---------------------------------------------------------------------- -# Process command-line arguments -#---------------------------------------------------------------------- -while [ $# -gt 0 ]; do - case $1 in - -baseline_dir ) - baseline_dir=$2 - shift - ;; - -baseline_hist ) - baseline_hist=$2 - shift - ;; - -test_dir ) - test_dir=$2 - shift - ;; - -test_hist ) - test_hist=$2 - shift - ;; - -help ) - Usage - exit 0 - ;; - * ) - echo "$progname: Unknown argument: $1" >&2 - echo "Run $progname -help for usage" >&2 - # return default values for status & info - print_result $status "$info" - exit 1 - ;; - esac - shift -done - - -#---------------------------------------------------------------------- -# Exit if required command-line arguments weren't provided -#---------------------------------------------------------------------- -error=0 # no errors yet - -if [ -z "$baseline_dir" ]; then - echo "$progname: baseline_dir must be provided" >&2 - error=1 -fi -if [ -z "$baseline_hist" ]; then - echo "$progname: baseline_hist must be provided" >&2 - error=1 -fi -if [ -z "$test_dir" ]; then - echo "$progname: test_dir must be provided" >&2 - error=1 -fi -if [ "$test_hist" = "$test_hist_init" ]; then - echo "$progname: test_hist must be provided" >&2 - error=1 -fi - -if [ $error -gt 0 ]; then - echo "" >&2 - echo "Run $progname -help for usage" >&2 - # return default values for status & info - print_result $status "$info" - exit 1 -fi - -#---------------------------------------------------------------------- -# Make sure there is a history file in the test case -#---------------------------------------------------------------------- -if [ -z "$test_hist" ]; then - status="GFAIL_NA" - info="no history file in test case" - print_result $status "$info" - exit 1 -fi - -#---------------------------------------------------------------------- -# Create baseline directory, if necessary -#---------------------------------------------------------------------- -mkdir -p $baseline_dir -if [ $? -ne 0 ]; then - status="GFAIL" - info="error creating baseline directory" - print_result $status "$info" - exit 1 -fi -chmod ug+w,a+rx $baseline_dir -chmod ug+w,a+rx $baseline_dir/.. - -#---------------------------------------------------------------------- -# Copy history file to baseline directory -#---------------------------------------------------------------------- -cp -f $test_dir/$test_hist $baseline_dir/$baseline_hist -if [ $? -ne 0 ]; then - status="GFAIL" - info="error copying history file to baseline directory" - print_result $status "$info" - exit 1 -fi -chmod ug+w,a+r $baseline_dir/$baseline_hist - -#---------------------------------------------------------------------- -# Return final test status -#---------------------------------------------------------------------- -status="PASS" -print_result $status "$info" -exit 0 - diff --git a/scripts/Tools/component_generate_baseline b/scripts/Tools/component_generate_baseline new file mode 100755 index 000000000000..8fbc4bd2a255 --- /dev/null +++ b/scripts/Tools/component_generate_baseline @@ -0,0 +1,55 @@ +#!/usr/bin/env python + +""" +Copies current component history files into baselines +""" + +from standard_script_setup import * + +from CIME.case import Case +from CIME.hist_utils import generate_baseline + +############################################################################### +def parse_command_line(args, description): +############################################################################### + parser = argparse.ArgumentParser( + usage="""\n%s [] [--verbose] +OR +%s --help +OR +%s --test + +\033[1mEXAMPLES:\033[0m + \033[1;32m# Generate baselines \033[0m + > %s +""" % ((os.path.basename(args[0]), ) * 4), + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter + ) + + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("caseroot", nargs="?", default=os.getcwd(), + help="Case directory") + + parser.add_argument("-b", "--baseline-dir", + help="Use custom baseline dir") + + args = parser.parse_args(args[1:]) + + CIME.utils.handle_standard_logging_options(args) + + return args.caseroot, args.baseline_dir + +############################################################################### +def _main_func(description): +############################################################################### + caseroot, baseline_dir = parse_command_line(sys.argv, description) + with Case(caseroot) as case: + success, comments = generate_baseline(case, baseline_dir) + print comments + + sys.exit(0 if success else 1) + +if __name__ == "__main__": + _main_func(__doc__) diff --git a/scripts/Tools/xmlchange b/scripts/Tools/xmlchange index f6ae3c412e25..6a9e2e6b5061 100755 --- a/scripts/Tools/xmlchange +++ b/scripts/Tools/xmlchange @@ -15,7 +15,10 @@ from standard_script_setup import * from CIME.utils import expect, convert_to_type, append_status from CIME.case import Case -import argparse, doctest, shutil, glob, time +import argparse, doctest, shutil, glob, time, re + +# Set logger +logger = logging.getLogger("xmlchange") ############################################################################### def parse_command_line(args, description): @@ -39,7 +42,7 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter CIME.utils.setup_standard_logging_options(parser) - parser.add_argument("listofsettings", nargs="*", + parser.add_argument("listofsettings", nargs="?", default='', help="Comma seperated list of settings in the form: var1=value,var2=value,...") parser.add_argument("--caseroot", default=os.getcwd(), @@ -57,6 +60,12 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter parser.add_argument("-val","--val", help="the value to set") + parser.add_argument("-delimiter","--delimiter", type=str, default="," , + help="set delimiter string, default is ,") + + parser.add_argument("-dryrun","--dryrun", type=bool , default=False, + help="parse settings and print key value pairs only") + parser.add_argument("-noecho", "--noecho", action="store_true", help="do not update CaseStatus with this change") @@ -77,17 +86,26 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter CIME.utils.handle_standard_logging_options(args) listofsettings = [] - if( len(args.listofsettings) == 1 ): - listofsettings = args.listofsettings[0].split(',') + if( len(args.listofsettings )): + delimiter = re.escape(args.delimiter) + listofsettings = re.split(r'(? 0 else 0) - caseroot, listofsettings, xmlfile, xmlid, xmlval, subgroup, append, noecho, warn, force = parse_command_line(sys.argv, description) + caseroot, listofsettings, xmlfile, xmlid, xmlval, subgroup, append, noecho, warn, force , dry = parse_command_line(sys.argv, description) - xmlchange(caseroot, listofsettings, xmlfile, xmlid, xmlval, subgroup, append, noecho, warn, force) + xmlchange(caseroot, listofsettings, xmlfile, xmlid, xmlval, subgroup, append, noecho, warn, force , dry) if (__name__ == "__main__"): _main_func(__doc__) diff --git a/scripts/create_newcase b/scripts/create_newcase index 635c964950da..9913623bf855 100755 --- a/scripts/create_newcase +++ b/scripts/create_newcase @@ -154,9 +154,9 @@ def _main_func(): with Case(caseroot, read_only=False) as case: # Set values for env_case.xml - case.set_value("CASE", os.path.basename(caseroot)) - case.set_value("CASEROOT", caseroot) - case.set_value("SRCROOT", srcroot) + case.set_lookup_value("CASE", os.path.basename(caseroot)) + case.set_lookup_value("CASEROOT", caseroot) + case.set_lookup_value("SRCROOT", srcroot) # Configure the Case case.configure(compset, grid, machine_name=machine, project=project, diff --git a/scripts/create_test b/scripts/create_test index 9f98f7f0f823..39a71856e8af 100755 --- a/scripts/create_test +++ b/scripts/create_test @@ -23,15 +23,31 @@ logger = logging.getLogger(__name__) ############################################################################### def parse_command_line(args, description): ############################################################################### - parser = argparse.ArgumentParser( - usage="""\n%s [ ...] [--verbose] -OR + model = CIME.utils.get_model() + + if model == "cesm": + help_str = \ +""" %s --xml-category [CATEGORY] [--xml-machine ...] [--xml-compiler ...] [ --xml-testlist ...] OR %s --help OR %s --test +\033[1mEXAMPLES:\033[0m + \033[1;32m# Run all tests in the xml prealpha category and yellowstone machine \033[0m + > %s --xml-machine yellowstone --xml-category prealpha +""" % ((os.path.basename(args[0]), ) * 4) + + else: + help_str = \ +""" +%s [ ...] [--verbose] +OR +%s --help +OR +%s --test + \033[1mEXAMPLES:\033[0m \033[1;32m# Run single test \033[0m > %s @@ -50,23 +66,14 @@ OR \033[1;32m# Run all tests in a suite except for tests that are in another suite \033[0m > %s ^ +""" % ((os.path.basename(args[0]), ) * 9) - \033[1;32m# Run all tests in the xml prealpha category and yellowstone machine \033[0m - > %s --xml-machine yellowstone --xml-category prealpha - -""" % ((os.path.basename(args[0]), ) * 11), - - description=description, - - formatter_class=argparse.ArgumentDefaultsHelpFormatter - ) + parser = argparse.ArgumentParser(usage=help_str, + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter) CIME.utils.setup_standard_logging_options(parser) - parser.add_argument("testargs", nargs="*", - help="Tests or test suites to run." - " Testnames expect in form CASE.GRID.COMPSET") - parser.add_argument("--no-run", action="store_true", help="Do not run generated tests") @@ -104,32 +111,62 @@ OR "all object executables, and data files will" " be removed after tests are run") - parser.add_argument("-c", "--compare", const=True, nargs="?", - help="While testing, compare baselines," - " optionally provide a compare directory ") + parser.add_argument("-m", "--machine", + help="The machine for which to build tests, this machine must be defined" + " in the config_machines.xml file for the given model. " + "Default is to match the name of the machine in the test name or " + "the name of the machine this script is run on to the " + "NODENAME_REGEX field in config_machines.xml. This option is highly " + "unsafe and should only be used if you know what you're doing.") + + if model == "cesm": + parser.add_argument("-c", "--compare", + help="While testing, compare baselines" + " against the given compare directory ") + + parser.add_argument("-g", "--generate", + help="While testing, generate baselines" + " to the given generate directory; " + "this can also be done after the fact with bless_test_results") + + parser.add_argument("--xml-machine", + help="Use this machine key in the lookup in testlist.xml, default is all if any --xml- argument is used") + + parser.add_argument("--xml-compiler", + help="Use this compiler key in the lookup in testlist.xml, default is all if any --xml- argument is used") - parser.add_argument("-g", "--generate", const=True, nargs="?", - help="While testing, generate baselines," - " optionally provide a generate directory") + parser.add_argument("--xml-category", + help="Use this category key in the lookup in testlist.xml, default is all if any --xml- argument is used") - parser.add_argument("-b", "--baseline-name", - help="If comparing or generating baselines with default paths," - " use this directory under baseline root. " - "Default will be current branch name. Do NOT add the compiler to" - " this argument that will be done for you. If you provide directories" - " in the generate and or compare argument do not use this option.") + parser.add_argument("--xml-testlist", + help="Use this testlist to lookup tests, default specified in config_files.xml") + + parser.add_argument("testargs", nargs="*", + help="Tests or test suites to run." + " Testnames expect in form CASE.GRID.COMPSET[.MACHINE_COMPILER]") + + else: + + parser.add_argument("testargs", nargs="+", + help="Tests or test suites to run." + " Testnames expect in form CASE.GRID.COMPSET[.MACHINE_COMPILER]") + + parser.add_argument("-b", "--baseline-name", + help="If comparing or generating baselines," + " use this directory under baseline root. " + "Default will be current branch name.") + + parser.add_argument("-c", "--compare", action="store_true", + help="While testing, compare baselines") + + parser.add_argument("-g", "--generate", action="store_true", + help="While testing, generate baselines; " + "this can also be done after the fact with bless_test_results") parser.add_argument("--compiler", help="Compiler to use to build cime. Default will be the name in" " the Testnames or the default defined for the machine.") - parser.add_argument("-m", "--machine", - help="The machine for which to build tests, this machine must be defined" - " in the config_machines.xml file for the given model. " - "Default is to match the name of the machine in the test name or " - "the name of the machine this script is run on to the " - "NODENAME_REGEX field in config_machines.xml") - parser.add_argument("-n", "--namelists-only", action="store_true", help="Only perform namelist actions for tests") @@ -159,27 +196,37 @@ OR parser.add_argument("-q", "--queue", default=None, help="Force batch system to use a certain queue") - parser.add_argument("--xml-machine", - help="Use this machine key in the lookup in testlist.xml, default is all if any --xml- argument is used") - parser.add_argument("--xml-compiler", - help="Use this compiler key in the lookup in testlist.xml, default is all if any --xml- argument is used") - parser.add_argument("--xml-category", - help="Use this category key in the lookup in testlist.xml, default is all if any --xml- argument is used") - parser.add_argument("--xml-testlist", - help="Use this testlist to lookup tests, default specified in config_files.xml") - parser.add_argument("--testfile", + parser.add_argument("-f", "--testfile", help="A file containing an ascii list of tests to run") + parser.add_argument("-o", "--allow-baseline-overwrite", action="store_true", + help="If the --generate option is given, then by default " + "an attempt to overwrite an existing baseline directory " + "will raise an error. Specifying this option allows " + "existing baseline directories to be silently overwritten.") + args = parser.parse_args(args[1:]) CIME.utils.handle_standard_logging_options(args) # generate and compare flags may not point to the same directory - if args.generate is not None: - expect(not (args.generate == args.compare), - "Cannot generate and compare baselines at the same time") - expect(not (args.baseline_name is not None and (not args.compare and not args.generate)), - "Provided baseline name but did not specify compare or generate") + if model == "cesm": + if args.generate is not None: + expect(not (args.generate == args.compare), + "Cannot generate and compare baselines at the same time") + + if args.xml_testlist is not None: + expect(not (args.xml_machine is None and args.xml_compiler + is None and args.xml_category is None), + "If an xml-testlist is present at least one of --xml-machine, " + "--xml-compiler, --xml-category must also be present") + + else: + expect(not (args.baseline_name is not None and (not args.compare and not args.generate)), + "Provided baseline name but did not specify compare or generate") + expect(not (args.compare and args.generate), + "Tried to compare and generate at same time") + expect(not (args.namelists_only and not (args.generate or args.compare)), "Must provide either --compare or --generate with --namelists-only") @@ -187,12 +234,6 @@ OR expect(args.parallel_jobs > 0, "Invalid value for parallel_jobs: %d" % args.parallel_jobs) - if args.xml_testlist is not None: - expect(not (args.xml_machine is None and args.xml_compiler - is None and args.xml_category is None), - "If an xml-testlist is present at least one of --xml-machine, " - "--xml-compiler, --xml-category must also be present") - if args.use_existing: expect(args.test_id is not None, "Must provide test-id of pre-existing cases") @@ -219,16 +260,71 @@ OR args.test_id = CIME.utils.get_utc_timestamp() if args.testfile is not None: - with open(args.testfile[0], "r") as fd: - args.testargs.extend( fd.read().splitlines() ) - # Remove empty items if any - args.testargs = filter(None, args.testargs) - - return args.testargs, args.compiler, args.machine, args.no_run, args.no_build, args.no_setup, args.no_batch,\ - args.test_root, args.baseline_root, args.clean, args.compare, args.generate, \ - args.baseline_name, args.namelists_only, args.project, args.test_id, args.parallel_jobs, \ - args.xml_machine, args.xml_compiler, args.xml_category, args.xml_testlist, args.walltime, \ - args.single_submit, args.proc_pool, args.use_existing, args.save_timing, args.queue + with open(args.testfile, "r") as fd: + args.testargs.extend( [line.strip() for line in fd.read().splitlines() if line.strip()] ) + + # Compute list of fully-resolved test_names + test_extra_data = {} + if model == "cesm": + machine_name = args.xml_machine if args.machine is None else args.machine + + # If it's still unclear what machine to use, look at test names + if machine_name is None: + for test in args.testargs: + testsplit = CIME.utils.parse_test_name(test) + if testsplit[4] is not None: + if machine_name is None: + machine_name = testsplit[4] + else: + expect(machine_name == testsplit[4], + "ambiguity in machine, please use the --machine option") + + mach_obj = Machines(machine=machine_name) + args.compiler = args.xml_compiler if args.compiler is None else args.compiler + args.compiler = mach_obj.get_default_compiler() if args.compiler is None else args.compiler + if args.testargs: + test_names = update_acme_tests.get_full_test_names(args.testargs, + mach_obj.get_machine_name(), args.compiler) + else: + test_data = CIME.test_utils.get_tests_from_xml(args.xml_machine, args.xml_category, + args.xml_compiler, args.xml_testlist, + machine_name, args.compiler) + test_names = [item["name"] for item in test_data] + for test_datum in test_data: + test_extra_data[test_datum["name"]] = test_datum + + logger.info("Testnames: %s" % test_names) + else: + mach_obj = Machines(machine=args.machine) + args.compiler = mach_obj.get_default_compiler() if args.compiler is None else args.compiler + + test_names = update_acme_tests.get_full_test_names(args.testargs, mach_obj.get_machine_name(), args.compiler) + + expect(mach_obj.is_valid_compiler(args.compiler), + "Compiler %s not valid for machine %s" % (args.compiler, mach_obj.get_machine_name())) + + # Normalize compare/generate between the models + baseline_cmp_name = None + baseline_gen_name = None + if args.compare or args.generate: + if model == "cesm": + if args.compare is not None: + baseline_cmp_name = args.compare + if args.generate is not None: + baseline_gen_name = args.generate + else: + baseline_name = args.baseline_name if args.baseline_name else CIME.utils.get_current_branch(repo=CIME.utils.get_cime_root()) + expect(baseline_name is not None, + "Could not determine baseline name from branch, please use -b option") + if args.compare: + baseline_cmp_name = baseline_name + elif args.generate: + baseline_gen_name = baseline_name + + return test_names, test_extra_data, args.compiler, mach_obj.get_machine_name(), args.no_run, args.no_build, args.no_setup, args.no_batch,\ + args.test_root, args.baseline_root, args.clean, baseline_cmp_name, baseline_gen_name, \ + args.namelists_only, args.project, args.test_id, args.parallel_jobs, args.walltime, \ + args.single_submit, args.proc_pool, args.use_existing, args.save_timing, args.queue, args.allow_baseline_overwrite ############################################################################### def single_submit_impl(machine_name, test_id, proc_pool, project, args, job_cost_map, wall_time, test_root): @@ -330,37 +426,24 @@ def single_submit_impl(machine_name, test_id, proc_pool, project, args, job_cost run_cmd_no_fail(submit_cmd, input_str=script, arg_stdout=None, arg_stderr=None, verbose=True) ############################################################################### -def create_test(testargs, compiler, machine_name, no_run, no_build, no_setup, no_batch, test_root, - baseline_root, clean, compare, generate, - baseline_name, namelists_only, project, test_id, parallel_jobs, - xml_machine, xml_compiler, xml_category, xml_testlist, walltime, - single_submit, proc_pool, use_existing, save_timing, queue): +def create_test(test_names, test_data, compiler, machine_name, no_run, no_build, no_setup, no_batch, test_root, + baseline_root, clean, baseline_cmp_name, baseline_gen_name, namelists_only, project, test_id, parallel_jobs, + walltime, single_submit, proc_pool, use_existing, save_timing, queue, allow_baseline_overwrite): ############################################################################### - if testargs and machine_name is None and compiler is None: - for test in testargs: - testsplit = CIME.utils.parse_test_name(test) - if testsplit[4] is not None: - if machine_name is None: - machine_name = testsplit[4] - else: - expect(machine_name == testsplit[4], - "ambiguity in machine, please use the --machine option") - - impl = TestScheduler(testargs, - no_run=no_run, no_build=no_build, no_setup=no_setup, no_batch=no_batch, - test_root=test_root, test_id=test_id, - baseline_root=baseline_root, baseline_name=baseline_name, - clean=clean, machine_name=machine_name, compiler=compiler, - compare=compare, generate=generate, namelists_only=namelists_only, - project=project, parallel_jobs=parallel_jobs, - xml_machine=xml_machine, xml_compiler=xml_compiler, - xml_category=xml_category, xml_testlist=xml_testlist, walltime=walltime, - proc_pool=proc_pool, use_existing=use_existing, save_timing=save_timing, - queue=queue) + impl = TestScheduler(test_names, test_data=test_data, + no_run=no_run, no_build=no_build, no_setup=no_setup, no_batch=no_batch, + test_root=test_root, test_id=test_id, + baseline_root=baseline_root, baseline_cmp_name=baseline_cmp_name, + baseline_gen_name=baseline_gen_name, + clean=clean, machine_name=machine_name, compiler=compiler, + namelists_only=namelists_only, + project=project, parallel_jobs=parallel_jobs, walltime=walltime, + proc_pool=proc_pool, use_existing=use_existing, save_timing=save_timing, + queue=queue, allow_baseline_overwrite=allow_baseline_overwrite) success = impl.run_tests() - if single_submit: + if success and single_submit: # Get real test root test_root = impl._test_root @@ -392,16 +475,15 @@ def _main_func(description): CIME.utils.get_python_libs_root(), arg_stdout=None, arg_stderr=None) return - testargs, compiler, machine_name, no_run, no_build, no_setup, no_batch, test_root, baseline_root, clean, \ - compare, generate, baseline_name, namelists_only, project, test_id, parallel_jobs, \ - xml_machine, xml_compiler, xml_category, xml_testlist, walltime, single_submit, proc_pool, \ - use_existing, save_timing, queue \ + test_names, test_data, compiler, machine_name, no_run, no_build, no_setup, no_batch, test_root, baseline_root, clean, \ + baseline_cmp_name, baseline_gen_name, namelists_only, project, test_id, parallel_jobs, \ + walltime, single_submit, proc_pool, use_existing, save_timing, queue, allow_baseline_overwrite \ = parse_command_line(sys.argv, description) - sys.exit(create_test(testargs, compiler, machine_name, no_run, no_build, no_setup, no_batch, test_root, - baseline_root, clean, compare, generate, baseline_name, namelists_only, - project, test_id, parallel_jobs, xml_machine, xml_compiler, xml_category, - xml_testlist, walltime, single_submit, proc_pool, use_existing, save_timing, queue)) + sys.exit(create_test(test_names, test_data, compiler, machine_name, no_run, no_build, no_setup, no_batch, test_root, + baseline_root, clean, baseline_cmp_name, baseline_gen_name, namelists_only, + project, test_id, parallel_jobs, walltime, single_submit, proc_pool, use_existing, save_timing, + queue, allow_baseline_overwrite)) ############################################################################### diff --git a/scripts/manage_case b/scripts/manage_case index 0ad76df06400..6be079833572 100755 --- a/scripts/manage_case +++ b/scripts/manage_case @@ -34,7 +34,6 @@ def query_machines(): config_file = files.get_value("MACHINES_SPEC_FILE") expect(os.path.isfile(config_file), "Cannot find config_file %s on disk" %config_file) - machines = Machines(config_file,machine="Query") machines.print_values() diff --git a/share/csm_share/shr/shr_pio_mod.F90 b/share/csm_share/shr/shr_pio_mod.F90 index 50540d9b7871..444e3482f87c 100644 --- a/share/csm_share/shr/shr_pio_mod.F90 +++ b/share/csm_share/shr/shr_pio_mod.F90 @@ -67,8 +67,10 @@ module shr_pio_mod contains !> !! @public -!! @brief should be the first routine called after mpi_init. It reads the pio default settings from file drv_in, namelist pio_default_inparm -!! and, if pio_async_interface is true, splits the IO tasks away from the Compute tasks. It then returns the new compute comm in +!! @brief should be the first routine called after mpi_init. +!! It reads the pio default settings from file drv_in, namelist pio_default_inparm +!! and, if pio_async_interface is true, splits the IO tasks away from the +!! Compute tasks. It then returns the new compute comm in !! Global_Comm and sets module variable io_comm. !! !< @@ -375,8 +377,10 @@ subroutine shr_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, character(len=shr_kind_cs) :: pio_typename character(len=shr_kind_cs) :: pio_rearr_comm_type, pio_rearr_comm_fcd - integer :: pio_rearr_comm_max_pend_req - logical :: pio_rearr_comm_enable_hs, pio_rearr_comm_enable_isend + integer :: pio_rearr_comm_max_pend_req_comp2io + logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io + integer :: pio_rearr_comm_max_pend_req_io2comp + logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp character(*),parameter :: subName = '(shr_pio_read_default_namelist) ' integer :: iam, ierr, npes, unitn @@ -386,8 +390,10 @@ subroutine shr_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, pio_typename, pio_async_interface, pio_debug_level, pio_blocksize, & pio_buffer_size_limit, pio_rearranger, & pio_rearr_comm_type, pio_rearr_comm_fcd, & - pio_rearr_comm_max_pend_req, pio_rearr_comm_enable_hs, & - pio_rearr_comm_enable_isend + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp #else namelist /pio_default_inparm/ pio_stride, pio_root, pio_numiotasks, & pio_typename, pio_async_interface, pio_debug_level, pio_blocksize, & @@ -465,8 +471,10 @@ subroutine shr_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, #ifdef PIO1 call shr_pio_rearr_opts_set(Comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & - pio_rearr_comm_max_pend_req, pio_rearr_comm_enable_hs, & - pio_rearr_comm_enable_isend) + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp, pio_numiotasks) #endif end subroutine shr_pio_read_default_namelist @@ -680,15 +688,23 @@ end subroutine shr_pio_namelist_set ! on the root proc of comm ! The rearranger options are passed to PIO_Init() in shr_pio_init2() subroutine shr_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & - pio_rearr_comm_max_pend_req, pio_rearr_comm_enable_hs, & - pio_rearr_comm_enable_isend) + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp, & + pio_numiotasks) integer(SHR_KIND_IN), intent(in) :: comm character(len=shr_kind_cs), intent(in) :: pio_rearr_comm_type, pio_rearr_comm_fcd - integer, intent(in) :: pio_rearr_comm_max_pend_req - logical, intent(in) :: pio_rearr_comm_enable_hs, pio_rearr_comm_enable_isend + integer, intent(in) :: pio_rearr_comm_max_pend_req_comp2io + logical, intent(in) :: pio_rearr_comm_enable_hs_comp2io + logical, intent(in) :: pio_rearr_comm_enable_isend_comp2io + integer, intent(in) :: pio_rearr_comm_max_pend_req_io2comp + logical, intent(in) :: pio_rearr_comm_enable_hs_io2comp + logical, intent(in) :: pio_rearr_comm_enable_isend_io2comp + integer, intent(in) :: pio_numiotasks character(*), parameter :: subname = '(shr_pio_rearr_opts_set) ' - integer, parameter :: NUM_REARR_COMM_OPTS = 5 + integer, parameter :: NUM_REARR_COMM_OPTS = 8 integer, parameter :: PIO_REARR_COMM_DEF_MAX_PEND_REQ = 64 integer(SHR_KIND_IN), dimension(NUM_REARR_COMM_OPTS) :: buf integer :: rank, ierr @@ -699,9 +715,12 @@ subroutine shr_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, buf = 0 ! buf(1) = comm_type ! buf(2) = comm_fcd - ! buf(3) = max_pend_req - ! buf(4) = enable_hs - ! buf(5) = enable_isend + ! buf(3) = max_pend_req_comp2io + ! buf(4) = enable_hs_comp2io + ! buf(5) = enable_isend_comp2io + ! buf(6) = max_pend_req_io2comp + ! buf(7) = enable_hs_io2comp + ! buf(8) = enable_isend_io2comp if(rank == 0) then ! buf(1) = comm_type select case(pio_rearr_comm_type) @@ -733,58 +752,107 @@ subroutine shr_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, buf(2) = pio_rearr_comm_fc_2d_enable end select - ! buf(3) = max_pend_req - if((pio_rearr_comm_max_pend_req < 0) .and. & - (pio_rearr_comm_max_pend_req /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then - write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req, ", pio_rearr_comm_max_pend_req - write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req to ", PIO_REARR_COMM_DEF_MAX_PEND_REQ - buf(3) = PIO_REARR_COMM_DEF_MAX_PEND_REQ + ! buf(3) = max_pend_req_comp2io + if((pio_rearr_comm_max_pend_req_comp2io <= 0) .and. & + (pio_rearr_comm_max_pend_req_comp2io /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then + + ! Small multiple of pio_numiotasks has proven to perform + ! well empirically, and we do not want to allow maximum for + ! very large process count runs. Can improve this by + ! communicating between iotasks first, and then non-iotasks + ! to iotasks (TO DO) + write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (comp2io), ",& + pio_rearr_comm_max_pend_req_comp2io + write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (comp2io) to ", & + max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) + buf(3) = max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) else - buf(3) = pio_rearr_comm_max_pend_req + buf(3) = pio_rearr_comm_max_pend_req_comp2io end if - ! buf(4) = enable_hs - if(pio_rearr_comm_enable_hs) then + ! buf(4) = enable_hs_comp2io + if(pio_rearr_comm_enable_hs_comp2io) then buf(4) = 1 else buf(4) = 0 end if - ! buf(5) = enable_isend - if(pio_rearr_comm_enable_isend) then + ! buf(5) = enable_isend_comp2io + if(pio_rearr_comm_enable_isend_comp2io) then buf(5) = 1 else buf(5) = 0 end if + ! buf(6) = max_pend_req_io2comp + if((pio_rearr_comm_max_pend_req_io2comp <= 0) .and. & + (pio_rearr_comm_max_pend_req_io2comp /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then + write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (io2comp), ", pio_rearr_comm_max_pend_req_io2comp + write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (io2comp) to ", PIO_REARR_COMM_DEF_MAX_PEND_REQ + buf(6) = PIO_REARR_COMM_DEF_MAX_PEND_REQ + else + buf(6) = pio_rearr_comm_max_pend_req_io2comp + end if + + ! buf(7) = enable_hs_io2comp + if(pio_rearr_comm_enable_hs_io2comp) then + buf(7) = 1 + else + buf(7) = 0 + end if + + ! buf(8) = enable_isend_io2comp + if(pio_rearr_comm_enable_isend_io2comp) then + buf(8) = 1 + else + buf(8) = 0 + end if + ! Log the rearranger options write(shr_log_unit, *) "PIO rearranger options:" write(shr_log_unit, *) " comm type =", pio_rearr_comm_type write(shr_log_unit, *) " comm fcd =", pio_rearr_comm_fcd - write(shr_log_unit, *) " max pend req =", pio_rearr_comm_max_pend_req - write(shr_log_unit, *) " enable_hs =", pio_rearr_comm_enable_hs - write(shr_log_unit, *) " enable_isend =", pio_rearr_comm_enable_isend + write(shr_log_unit, *) " max pend req (comp2io) =", pio_rearr_comm_max_pend_req_comp2io + write(shr_log_unit, *) " enable_hs (comp2io) =", pio_rearr_comm_enable_hs_comp2io + write(shr_log_unit, *) " enable_isend (comp2io) =", pio_rearr_comm_enable_isend_comp2io + write(shr_log_unit, *) " max pend req (io2comp) =", pio_rearr_comm_max_pend_req_io2comp + write(shr_log_unit, *) " enable_hs (io2comp) =", pio_rearr_comm_enable_hs_io2comp + write(shr_log_unit, *) " enable_isend (io2comp) =", pio_rearr_comm_enable_isend_io2comp end if call shr_mpi_bcast(buf, comm) ! buf(1) = comm_type ! buf(2) = comm_fcd - ! buf(3) = max_pend_req - ! buf(4) = enable_hs - ! buf(5) = enable_isend + ! buf(3) = max_pend_req_comp2io + ! buf(4) = enable_hs_comp2io + ! buf(5) = enable_isend_comp2io + ! buf(6) = max_pend_req_io2comp + ! buf(7) = enable_hs_io2comp + ! buf(8) = enable_isend_io2comp pio_rearr_opts%comm_type = buf(1) - pio_rearr_opts%comm_fc_opts%fcd = buf(2) - pio_rearr_opts%comm_fc_opts%max_pend_req = buf(3) + pio_rearr_opts%fcd = buf(2) + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = buf(3) if(buf(4) == 0) then - pio_rearr_opts%comm_fc_opts%enable_hs = .false. + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = .false. else - pio_rearr_opts%comm_fc_opts%enable_hs = .true. + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = .true. end if if(buf(5) == 0) then - pio_rearr_opts%comm_fc_opts%enable_isend = .false. + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = .false. + else + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = .true. + end if + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = buf(6) + if(buf(7) == 0) then + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = .false. + else + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = .true. + end if + if(buf(8) == 0) then + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = .false. else - pio_rearr_opts%comm_fc_opts%enable_isend = .true. + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = .true. end if end subroutine #endif diff --git a/tools/configure b/tools/configure index 500434b168dd..0617b95dfbbf 100755 --- a/tools/configure +++ b/tools/configure @@ -1,291 +1,176 @@ -#!/usr/bin/env perl -#----------------------------------------------------------------------------------------------- -# -# configure -# -# This utility allows the CIME utilities user to specify configuration -# options via a commandline interface. -# -#----------------------------------------------------------------------------------------------- - -use strict; -#use warnings; -#use diagnostics; - -use Cwd qw( getcwd abs_path chdir); -use English; -use Getopt::Long; -use IO::File; -use IO::Handle; -use File::Copy; - - -# Check for manditory case input if not just listing valid values -my $model; -my $mach; -my $compiler; -my $mpilib; -my $output_format='make'; -my $cimeroot; -my $machdir; -my $eol="\n"; -my $layout = '%m%n'; - - -#----------------------------------------------------------------------------------------------- -# Set the directory that contains the CCSM configuration scripts. If the create_newcase command was -# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the -# command was issued from the current working directory. - -(my $ProgName = $0) =~ s!(.*)/!!; # name of this script -my $ProgDir = $1; # name of directory containing this script -- may be a - # relative or absolute path, or null if the script is in - # the user's PATH - - -#----------------------------------------------------------------------------------------------- -if ($#ARGV == -1) { - usage(); -} - -#----------------------------------------------------------------------------------------------- - -sub usage { - die <). Any value that contains - white-space must be quoted. Long option names may be supplied with either single - or double leading dashes. A consequence of this is that single letter options may - NOT be bundled. - - -cimeroot Specify the toplevel cime directory. - default: use CIMEROOT environment variable - -model Specify the CIME component model to test. - default: cesm - -mach Specify a machine (required). - -compiler Specify a compiler for the target machine (optional) - default: default compiler for the target machine - -mpilib Specify a mpi library for the target machine (optional) - default: mpi-serial - -mach_dir Specify the locations of the Machines directory (optional). - - -output_dir default: current working directory - -output_format Output format can be make or cmake. - default: make - -help [or -h] Print usage to STDOUT (optional). - -loglevel Set the message level for perl - valid: FATAL ERROR WARN INFO DEBUG - default: INFO - -EXAMPLES - - ./configure -mach bluefire -compiler ibm - ./configure -mach generic_CNL -compiler cray - -EOF -} - -#----------------------------------------------------------------------------------------------- -# Save commandline -my $commandline = "configure @ARGV"; - -#----------------------------------------------------------------------------------------------- -# Parse command-line options. -my %opts = ( - mpilib => "mpi-serial", - model => "cesm", - loglevel => "INFO", - max_tasks_per_node => 1, - ); -GetOptions( - "cimeroot=s" => \$opts{'cimeroot'}, - "compiler=s" => \$opts{'compiler'}, - "model=s" => \$opts{'model'}, - "mpilib=s" => \$opts{'mpilib'}, - "h|help" => \$opts{'help'}, - "list" => \$opts{'list'}, - "mach=s" => \$opts{'mach'}, - "mach_dir=s" => \$opts{'mach_dir'}, - "output_dir=s" => \$opts{'output_dir'}, - "output_format=s" => \$opts{'output_format'}, - "loglevel=s" => \$opts{'loglevel'}, - "scratchroot=s" => \$opts{'scratchroot'}, - "din_loc_root=s" => \$opts{'din_loc_root'}, - "max_tasks_per_node=i" => \$opts{'max_tasks_per_node'}, - ) or usage(); - -# Give usage message. -usage() if $opts{'help'}; - - -# Check for unparsed argumentss -if (@ARGV) { - print "ERROR: unrecognized arguments: @ARGV\n"; - usage(); -} - - -if($opts{'cimeroot'}) { - $cimeroot = $opts{'cimeroot'}; -}else{ - $cimeroot = abs_path($ENV{CIMEROOT}) if(defined $ENV{CIMEROOT}); -} -if(! -d "$cimeroot"){ - #use die here because Log needs cimeroot - die("Cannot find cimeroot directory \"$cimeroot\" \n") ; -} - - -#----------------------------------------------------------------------------------------------- -my @dirs = ("$cimeroot/utils/perl5lib","$cimeroot/utils/perl5lib/Config" ); - -unshift @INC, @dirs; -require SetupTools; -require Module::ModuleLoader; -require ConfigMachine; -require ConfigCase; -require Log::Log4perl; - -my $level = Log::Log4perl::Level::to_priority($opts{loglevel}); -Log::Log4perl->easy_init({level=>$level, - layout=>$layout}); - - -my $logger = Log::Log4perl::get_logger(); - - -if (!$opts{'list'}) { - # Check for manditory machine input - if ($opts{'mach'}) { - $mach = $opts{'mach'}; - } else { - $logger->fatal("ERROR: configure must include the input argument, -mach \n"); - exit(); - } - if ($opts{'compiler'}) { - $compiler = $opts{'compiler'}; - } - if ($opts{'model'}) { - $model = $opts{'model'}; - } - if ($opts{'mpilib'}) { - $mpilib = $opts{'mpilib'}; - } - if($opts{'output_format'}){ - $output_format = $opts{'output_format'}; - } - - if($opts{'mach_dir'}){ - $machdir = $opts{'mach_dir'}; - } else { - $machdir = "$cimeroot/cime_config/${model}/machines" unless defined($machdir); - } - if (! -d "$machdir") { - $logger->fatal(" Cannot find machines directory \"$machdir\" "); - } -} - - -my $output_dir = "."; -$output_dir = $opts{output_dir} if defined( $opts{output_dir} ); -# -# Make sure the output_dir exists or can be created -# -if(! -d "$output_dir") { - unless( mkpath $output_dir, "0755"){ - $logger->fatal("Could not find or create $output_dir"); - } -} - -#----------------------------------------------------------------------------------------------- -# Make sure we can find required perl modules and configuration files. -# Look for them in the directory that contains the configure script. - -# Machines definition file. -my $machine_file = 'config_machines.xml'; -if(! -f "$machdir/$machine_file"){ - $logger->fatal("Cannot find machine parameters file \"$machine_file\" in directory \"$machdir\""); - exit; -} - -# Compiler definition file. -my $compiler_file = 'config_compilers.xml'; -if(! -f "$machdir/$compiler_file"){ - $logger->fatal("Cannot find compiler parameters file \"$compiler_file\" in directory \"$machdir\""); - exit; -} - - -#----------------------------------------------------------------------------------------------- -# If just listing valid values then exit after completion of lists -if ($opts{'list'}) { - #TODO add this correctly - since there is no longer a print_machines in ConfigCase - # ConfigCase::print_machines("$machdir/$machine_file"); - # to do - add print_compilers - $logger->info( "finished listing valid values, now exiting $eol"); - exit; -} - -#----------------------------------------------------------------------------------------------- -# Create new config object if not just listing valid values -my $config = ConfigCase->new(""); -my $files_spec_file = "$cimeroot/cime_config/${model}/config_files.xml"; -# srcroot is not used here -my $srcroot = ""; -$config->add_config_variables($files_spec_file, $srcroot, $cimeroot, $model); -# todo: -#$config->set('MACHDIR', "$machdir"); -my $file = $config->get('CONFIG_DRV_FILE'); - -$config->add_config_variables($file, $srcroot, $cimeroot, $model); - -ConfigMachine::setMachineValues($file, "", $mach, $config); - - -# This will be the compiler argument passed in or the default if not provided -$compiler = $config->get('COMPILER'); - -$logger->info( "Machine specifier: $mach.$eol"); - -# Copy Depends files if they exist -if( -e "$machdir/Depends.$mach" ) { - unless(copy("$machdir/Depends.$mach",$output_dir)){ - $logger->logdie( "ERROR: copy $machdir/Depends.$mach $output_dir failed$eol"); - exit; - } -} -if( -e "$machdir/Depends.$compiler" ) { - unless(copy("$machdir/Depends.$compiler",$output_dir)){ - $logger->logdie( "ERROR: copy $machdir/Depends.$compiler $output_dir failed$eol"); - } -} - -my $dbug = $config->get("DEBUG"); - -my $moduleloader = Module::ModuleLoader->new(machine => $mach, - compiler => $compiler, - mpilib => $mpilib, - caseroot => $output_dir, - debug => $dbug, - cimeroot => $cimeroot, - model => $model); - -$moduleloader->moduleInit(); -$moduleloader->writeXMLFileForCase(); - - - -$moduleloader->writeCshModuleFile(); -$moduleloader->writeShModuleFile(); - - -SetupTools::set_compiler($config->get('OS'),"$machdir/$compiler_file",$compiler, - $mach, $mpilib, "$output_dir/Macros.$output_format", $output_format); - -$logger->info("Successfully created auxilary build files for $mach $eol"); - -exit 0; - - +#!/usr/bin/env python + +"""This script writes CIME build information to a directory. + +The pieces of information that will be written include: + +1. Machine-specific build settings (i.e. the "Macros" file). +2. File-specific build settings (i.e. "Depends" files). +3. Environment variable loads (i.e. the env_mach_specific files). + +The .env_mach_specific.sh and .env_mach_specific.csh files are specific to a +given compiler, MPI library, and DEBUG setting. By default, these will be the +machine's default compiler, the machine's default MPI library, and FALSE, +respectively. These can be changed by setting the environment variables +COMPILER, MPILIB, and DEBUG, respectively. +""" + +import os +import shutil +import sys + +_CIMEROOT = os.environ.get("CIMEROOT") +if _CIMEROOT is None: + raise SystemExit("ERROR: must set CIMEROOT environment variable") + +_LIBDIR = os.path.join(_CIMEROOT, "scripts", "Tools") +sys.path.append(_LIBDIR) + +from standard_script_setup import * +from CIME.utils import expect +from CIME.XML.build import Build +from CIME.XML.env_mach_specific import EnvMachSpecific +from CIME.XML.machines import Machines + +logger = logging.getLogger(__name__) + +def parse_command_line(args): + """Command line argument parser for configure.""" + description = __doc__ + parser = argparse.ArgumentParser(description=description) + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("--machine", + help="The machine to create build information for.") + parser.add_argument("--machines-dir", + help="The machines directory to take build information " + "from. Overrides the CIME_MODEL environment variable, " + "and must be specified if that variable is not set.") + parser.add_argument("--macros-format", action='append', + choices=['Makefile', 'CMake'], + help="The format of Macros file to generate. If " + "'Makefile' is passed in, a file called 'Macros.make' " + "is generated. If 'CMake' is passed in, a file called " + "'Macros.cmake' is generated. This option can be " + "specified multiple times to generate multiple files. " + "If not used at all, Macros generation is skipped. " + "Note that Depends files are currently always in " + "Makefile format, regardless of this option.") + parser.add_argument("--output-dir", default=os.getcwd(), + help="The directory to write files to. If not " + "specified, defaults to the current working directory.") + + args = parser.parse_args() + CIME.utils.handle_standard_logging_options(args) + + opts = {} + if args.machines_dir is not None: + machines_file = os.path.join(args.machines_dir, "config_machines.xml") + machobj = Machines(infile=machines_file, machine=args.machine) + else: + if os.environ.get('CIME_MODEL') is not None: + machobj = Machines(machine=args.machine) + else: + expect(False, "Either --mach-dir or the CIME_MODEL environment " + "variable must be specified!") + + opts['machobj'] = machobj + + if args.macros_format is None: + opts['macros_format'] = [] + else: + opts['macros_format'] = args.macros_format + + expect(os.path.isdir(args.output_dir), + "Output directory '%s' does not exist." % args.output_dir) + + opts['output_dir'] = args.output_dir + + # Set compiler. + if "COMPILER" in os.environ: + compiler = os.environ["COMPILER"] + else: + compiler = machobj.get_default_compiler() + os.environ["COMPILER"] = compiler + expect(opts['machobj'].is_valid_compiler(compiler), + "Invalid compiler vendor given in COMPILER environment variable: %s" + % compiler) + opts['compiler'] = compiler + + # Set MPI library. + if "MPILIB" in os.environ: + mpilib = os.environ["MPILIB"] + else: + mpilib = machobj.get_default_MPIlib() + os.environ["MPILIB"] = mpilib + expect(opts['machobj'].is_valid_MPIlib(mpilib), + "Invalid MPI library name given in MPILIB environment variable: %s" % + mpilib) + opts['mpilib'] = mpilib + + # Set DEBUG flag. + if "DEBUG" in os.environ: + expect(os.environ["DEBUG"].lower() in ('true', 'false'), + "Invalid DEBUG environment variable value (must be 'TRUE' or " + "'FALSE'): %s" % os.environ["DEBUG"]) + debug = os.environ["DEBUG"].lower() == "true" + else: + debug = False + os.environ["DEBUG"] = "FALSE" + opts['debug'] = debug + + return opts + +def configure(machobj, output_dir, macros_format, compiler, mpilib, debug): + """Add Macros, Depends, and env_mach_specific files to a directory. + + Arguments: + machobj - Machines argument for this machine. + output_dir - Directory in which to place output. + macros_format - Container containing the string 'Makefile' to produce + Makefile Macros output, and/or 'CMake' for CMake output. + compiler - String containing the compiler vendor to configure for. + mpilib - String containing the MPI implementation to configure for. + debug - Boolean specifying whether debugging options are enabled. + """ + # Macros generation. + suffixes = {'Makefile': '.make', 'CMake': '.cmake'} + macro_maker = Build(machobj) + build_file_name = os.path.join(machobj.machines_dir, "config_build.xml") + for form in macros_format: + out_file_name = os.path.join(output_dir, + "Macros"+suffixes[form]) + with open(out_file_name, "w") as macros_file: + macro_maker.write_macros(form, build_file_name, macros_file) + + # Depends file copy. + mach_depends = os.path.join(machobj.machines_dir, + "Depends."+machobj.get_machine_name()) + if os.path.isfile(mach_depends): + shutil.copy(mach_depends, output_dir) + compiler_depends = os.path.join(machobj.machines_dir, "Depends."+compiler) + if os.path.isfile(compiler_depends): + shutil.copy(compiler_depends, output_dir) + + # env_mach_specific generation. + ems_path = os.path.join(output_dir, "env_mach_specific.xml") + if os.path.exists(ems_path): + os.remove(ems_path) + ems_file = EnvMachSpecific(output_dir) + ems_file.populate(machobj) + ems_file.write() + for shell in ('sh', 'csh'): + ems_file.make_env_mach_specific_file(compiler, debug, mpilib, shell) + shell_path = os.path.join(output_dir, ".env_mach_specific." + shell) + with open(shell_path, 'a') as shell_file: + shell_file.write("\nexport COMPILER=%s\n" % compiler) + shell_file.write("export MPILIB=%s\n" % mpilib) + shell_file.write("export DEBUG=%s\n" % repr(debug).upper()) + +def _main(): + opts = parse_command_line(sys.argv) + configure(opts['machobj'], opts['output_dir'], opts['macros_format'], + opts['compiler'], opts['mpilib'], opts['debug']) + +if __name__ == "__main__": + _main() diff --git a/tools/cprnc/README b/tools/cprnc/README index 0dc0965d5c10..a93684deee1b 100644 --- a/tools/cprnc/README +++ b/tools/cprnc/README @@ -11,10 +11,19 @@ Quick Start Guide: On cime supported systems you can generate a Macros file using the following (assuming you are running the command from the directory cime/tools/cprnc): -../configure -cimeroot ../../ -mach $machinename -compiler $compilername +CIMEROOT=../.. ../configure --macros-format=Makefile + +To change the compiler or MPI library used, or to enable debugging options, +set the COMPILER, MPILIB, or DEBUG environment variables prior to running +configure. + +Next, run make to build cprnc. For instance, using sh/bash as a login shell: + +CIMEROOT=../.. source .env_mach_specific.sh && make + +Finally, put the resulting executable in CCSM_CPRNC as defined in +config_machines.xml. -Then run make to build cprnc and put the resulting executable in -CCSM_CPRNC as defined in config_machines.xml You can also build cprnc using cmake. Usage: cprnc [-v] [-d dimname:start[:count]] file1 [file2] diff --git a/tools/cprnc/compare_vars_mod.F90.in b/tools/cprnc/compare_vars_mod.F90.in index df873a1e4da0..7c7af7b9ffd4 100644 --- a/tools/cprnc/compare_vars_mod.F90.in +++ b/tools/cprnc/compare_vars_mod.F90.in @@ -270,7 +270,7 @@ contains s2 = vdimsize(file(2)%dim, file(2)%var(vid(2))%dimids) if(s1 /= s2) then - write(6,*), 'WARNING: Variable ',trim(file(1)%var(vid(1))%name),' sizes differ' + write(6,*) 'WARNING: Variable ',trim(file(1)%var(vid(1))%name),' sizes differ' write(6,'(a,a32)') ' DIMSIZEDIFF ', file(1)%var(vid(1))%name ifail = 1 return diff --git a/utils/perl5lib/Streams/TemplateGeneric.pm b/utils/perl5lib/Streams/TemplateGeneric.pm index 0e726177c3a0..5c0d5858dcd1 100644 --- a/utils/perl5lib/Streams/TemplateGeneric.pm +++ b/utils/perl5lib/Streams/TemplateGeneric.pm @@ -425,7 +425,9 @@ sub GetDataFilenames { # # Get path # + my $filepath = $self->GetDataFilepath( $type ); + my $key = "fileNames"; my $info; if ( $type eq "data" ) { @@ -463,8 +465,8 @@ sub GetDataFilepath { if ( ! defined($self->{'template'}) ) { die "${nm}:: a template has NOT been read in yet -- abort.\n"; } - my $defaults_ref = $self->{'defaults'}; - my %defaults = %$defaults_ref; + my %defaults = %{$self->{'defaults'}}; + my $key; if ( $type eq "data" ) { $key = "fieldInfo"; @@ -473,13 +475,14 @@ sub GetDataFilepath { } else { die "${nm}:: bad input type to method: $type should be data or domain\n"; } + my $Info_ref = $defaults{$key}; + if ( ref($Info_ref) ne "HASH" ) { die "${nm}:: $key is NOT a hash -- something must have went wrong in the Read\n"; } - my %Info = %$Info_ref; - my $filepath = $self->__Sub__( $Info_ref, 'filePath'); + my $filepath = $self->__Sub__( $Info_ref, 'filePath'); return( $filepath ); } @@ -490,7 +493,6 @@ sub expandXMLVar { my $value = shift; my $varhash_ref = shift; my $nm = "expandXMLVar"; - if ( ! defined($value) ) { die "${nm}:: a value was NOT input\n"; } @@ -559,6 +561,7 @@ sub __Sub__ { my $lastmonth = $opts{'lastmonth'}; my $value = $$Info_ref{$name}; + $value =~ s/^[ \n]+//; # remove leading spaces $value =~ s/[ \n]+$//; # remove ending spaces diff --git a/utils/python/CIME/SystemTests/README b/utils/python/CIME/SystemTests/README index c2aed89d6948..ae8ca6c056de 100644 --- a/utils/python/CIME/SystemTests/README +++ b/utils/python/CIME/SystemTests/README @@ -1,11 +1,13 @@ The following are the test functionality categories: 1) smoke tests - 2) restart tests - 3) threading/pe-count modification tests - 4) sequencing (layout) modification tests - 5) multi-instance tests - 6) performance tests - 7) spinup tests (TODO) + 2) basic reproducibility tests + 3) restart tests + 4) threading/pe-count modification tests + 5) sequencing (layout) modification tests + 6) multi-instance tests + 7) performance tests + 8) spinup tests (TODO) + 9) other component-specific tests Some tests not yet implemented in python. They can be found in cime/scripts/Testing/Testcases @@ -23,6 +25,12 @@ SMS smoke startup test (default length) if $IOP_ON is set then suffix is base_iop success for non-iop is just a successful coupler +====================================================================== + Basic reproducibility Tests +====================================================================== + +REP reproducibility: do two identical runs give the same results? + ====================================================================== Restart Tests ====================================================================== @@ -138,3 +146,8 @@ SSP smoke CLM spinup test (only valid for CLM compsets with CLM45 and CN or B short term archiving is on do a hybrid non-spinup run run from the restart files generated in the first phase +====================================================================== + Other component-specific tests +====================================================================== + +LII CLM initial condition interpolation test diff --git a/utils/python/CIME/SystemTests/eri.py b/utils/python/CIME/SystemTests/eri.py index 9ae9ec92a9c3..db70db99b569 100644 --- a/utils/python/CIME/SystemTests/eri.py +++ b/utils/python/CIME/SystemTests/eri.py @@ -99,8 +99,7 @@ def run_phase(self): with open("user_nl_cam", "a") as fd: fd.write("inithist = 'ENDOFRUN'\n") - self.run_indv(coupler_log_path=os.path.join(dout_sr1, "logs"), - st_archive=True) + self.run_indv(st_archive=True, suffix=None) # # (2) Test run: @@ -146,9 +145,7 @@ def run_phase(self): # run ref2 case (all component history files will go to short term archiving) - self.run_indv(suffix="hybrid", - coupler_log_path=os.path.join(dout_sr2, "logs"), - st_archive=True) + self.run_indv(suffix="hybrid", st_archive=True) # # (3a) Test run: diff --git a/utils/python/CIME/SystemTests/err.py b/utils/python/CIME/SystemTests/err.py index ffe05f956c16..dfa00ed7aa36 100644 --- a/utils/python/CIME/SystemTests/err.py +++ b/utils/python/CIME/SystemTests/err.py @@ -28,7 +28,7 @@ def run_phase(self): dout_s_root = self._case.get_value("DOUT_S_ROOT") rundir = self._case.get_value("RUNDIR") logger.info("staging files from archive %s" % dout_s_root) - for item in glob.glob(os.path.join(dout_s_root, "rest", "*", "*")): + for item in glob.glob(os.path.join(dout_s_root, "*", "hist", "*base")): shutil.copy(item, rundir) self._ers_second_phase() diff --git a/utils/python/CIME/SystemTests/lii.py b/utils/python/CIME/SystemTests/lii.py index 83731fa370ce..3b18572f221a 100644 --- a/utils/python/CIME/SystemTests/lii.py +++ b/utils/python/CIME/SystemTests/lii.py @@ -1,75 +1,35 @@ """ -Implementation of the CIME LII test. This class inherits from SystemTestsCommon +Implementation of the CIME LII test. This is a CLM specific test: -Verifies that namelist variable 'use_init_interp' works correctly +Verifies that interpolation of initial conditions onto an identical +configuration gives identical results: (1) do a run with use_init_interp false (suffix base) (2) do a run with use_init_interp true (suffix init_interp_on) """ -import shutil, glob +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo from CIME.XML.standard_module_setup import * -from CIME.SystemTests.system_tests_common import SystemTestsCommon +from CIME.SystemTests.test_utils.user_nl_utils import append_to_user_nl_files logger = logging.getLogger(__name__) -class LII(SystemTestsCommon): +class LII(SystemTestsCompareTwo): def __init__(self, case): - """ - initialize a test object - """ - SystemTestsCommon.__init__(self, case) + SystemTestsCompareTwo.__init__(self, case, + separate_builds = False, + run_two_suffix = 'interp', + run_one_description = 'use_init_interp set to false', + run_two_description = 'use_init_interp set to true') + + def _case_one_setup(self): + append_to_user_nl_files(caseroot = self._get_caseroot(), + component = "clm", + contents = "use_init_interp = .false.") + + def _case_two_setup(self): + append_to_user_nl_files(caseroot = self._get_caseroot(), + component = "clm", + contents = "use_init_interp = .true.") - def build_phase(self, sharedlib_only=False, model_only=False): - - # Make copies of the namelist files for each part of the test. Enclose the - # copies in conditionals so that we only do this namelist setup the first time - # the build script is invoked - otherwise, if the build is rerun, the namelist - # files would build up repeated instances of the setting of force_init_intep. - # - # Note the use of shell wildcards to make sure we apply these mods to - # multi-instance versions - - if not os.path.exists("user_nl_nointerp"): - os.makedirs("user_nl_nointerp") - for filename in glob.glob(r'user_nl_clm*'): - shutil.copy(filename, os.path.join("user_nl_nointerp",filename)) - with open(os.path.join("user_nl_nointerp",filename), "a") as newfile: - newfile.write("use_init_interp = .false.") - - if not os.path.exists("user_nl_interp"): - os.makedirs("user_nl_interp") - for filename in glob.glob(r'user_nl_clm*'): - shutil.copy(filename, os.path.join("user_nl_interp",filename)) - with open(os.path.join("user_nl_interp",filename), "a") as newfile: - newfile.write("use_init_interp = .true.") - - self.clean_build() - self.build_indv(sharedlib_only=sharedlib_only, model_only=model_only) - - def run_phase(self): - ''' - Do a run with init_interp false, a run with init_interp true and - compare - ''' - caseroot = self._case.get_value("CASEROOT") - - self._case.set_value("CONTINUE_RUN",False) - self._case.set_value("REST_OPTION","none") - self._case.set_value("HIST_OPTION","$STOP_OPTION") - self._case.set_value("HIST_N","$STOP_N") - self._case.flush() - for user_nl_dir in ("nointerp", "interp"): - for filename in glob.glob(r'user_nl_%s/*'%user_nl_dir): - shutil.copy(filename, - os.path.join(caseroot,os.path.basename(filename))) - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") - logger.info("doing a %d %s initial test with init_interp set to %s, no restarts written" - % (stop_n, stop_option, user_nl_dir == "interp")) - - self.run_indv(suffix=user_nl_dir) - - self._component_compare_test("nointerp", "interp") diff --git a/utils/python/CIME/SystemTests/pea.py b/utils/python/CIME/SystemTests/pea.py index 61e7aa614b3c..c08dd1812fa3 100644 --- a/utils/python/CIME/SystemTests/pea.py +++ b/utils/python/CIME/SystemTests/pea.py @@ -1,98 +1,40 @@ """ -Implementation of the CIME PEA test. This class inherits from SystemTestsCommon +Implementation of the CIME PEA test. + +Builds runs and compares a single processor mpi model to a model built using mpi-serial +(1) do a run with default mpi library (suffix base) +(2) do a run with mpi-serial (suffix mpi-serial) """ -import shutil + +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo from CIME.XML.standard_module_setup import * from CIME.case_setup import case_setup -import CIME.utils -from CIME.SystemTests.system_tests_common import SystemTestsCommon logger = logging.getLogger(__name__) -class PEA(SystemTestsCommon): +class PEA(SystemTestsCompareTwo): def __init__(self, case): - """ - initialize a test object - """ - SystemTestsCommon.__init__(self, case) - - def build_phase(self, sharedlib_only=False, model_only=False): - exeroot = self._case.get_value("EXEROOT") - cime_model = CIME.utils.get_model() - - # first set all component mpi tasks to 1 - for comp in ['ATM','CPL','OCN','WAV','GLC','ICE','ROF','LND']: + SystemTestsCompareTwo.__init__(self, case, + separate_builds = True, + run_two_suffix = 'mpi-serial', + run_one_description = 'default mpi library', + run_two_description = 'mpi-serial') + + def _common_setup(self): + for comp in self._case.get_value("COMP_CLASSES").split(','): + if comp == "DRV": + comp = "CPL" self._case.set_value("NTASKS_%s"%comp, 1) - - build1 = os.path.join("LockedFiles","env_build.PEA1.xml") - if ( os.path.isfile(build1) ): - shutil.copy(build1,"env_build.xml") - - mpilib = self._case.get_value("MPILIB") - for mpilib in [mpilib, "mpi-serial"]: - logging.warn("Starting bld for %s"%mpilib) - self._case.set_value("MPILIB",mpilib) - self._case.flush() - case_setup(self._case, reset=True) - self.clean_build() - self.build_indv(sharedlib_only=sharedlib_only, model_only=model_only) - if (not sharedlib_only): - shutil.move("%s/%s.exe"%(exeroot,cime_model), - "%s/%s.exe.PEA_%s"%(exeroot,cime_model,mpilib)) - shutil.copy("env_build.xml",os.path.join("LockedFiles", - "env_build_PEA_%s.xml"%mpilib)) - - def _pea_first_phase(self): - - exeroot = self._case.get_value("EXEROOT") - cime_model = CIME.utils.get_model() - exefile = "%s/%s.exe"%(exeroot,cime_model) - exefile1 = "%s/%s.exe.PEA1"%(exeroot,cime_model) - if (os.path.isfile(exefile)): - os.remove(exefile) - shutil.copy(exefile1, exefile) - - self._case.set_value("CONTINUE_RUN",False) - self._case.set_value("REST_OPTION","none") - self._case.set_value("HIST_OPTION","$STOP_OPTION") - self._case.set_value("HIST_N","$STOP_N") - self._case.flush() - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") - logger.info("doing an %d %s initial test with 1pe and mpi, no restarts written" - % (stop_n, stop_option)) - - self.run_indv() - - def _pea_second_phase(self): - - expect(os.path.isfile("env_mach_pes.xml.2"), - "ERROR: env_mach_pes.xml.2 does not exist, run case.build" ) - - exeroot = self._case.get_value("EXEROOT") - cime_model = CIME.utils.get_model() - exefile = "%s/%s.exe"%(exeroot,cime_model) - exefile2 = "%s/%s.exe.PEA2"%(exeroot,cime_model) - if (os.path.isfile(exefile)): - os.remove(exefile) - shutil.copy(exefile2, exefile) - - self._case.set_value("CONTINUE_RUN",False) - self._case.set_value("REST_OPTION","none") - self._case.set_value("HIST_OPTION","$STOP_OPTION") - self._case.set_value("HIST_N","$STOP_N") - self._case.flush() - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") - logger.info("doing an %d %s initial test with 1pe and serial mpi, no restarts written" - % (stop_n, stop_option)) - - self.run_indv(suffix="mpiserial") - self._component_compare_test("base", "mpiserial") - - def run_phase(self): - self._pea_first_phase() - self._pea_second_phase() + self._case.set_value("NTHRDS_%s"%comp, 1) + self._case.set_value("ROOTPE_%s"%comp, 0) + + + def _case_one_setup(self): + case_setup(self._case, reset=True, test_mode=True) + + def _case_two_setup(self): + self._case.set_value("MPILIB","mpi-serial") + if os.path.isfile("Macros"): + os.remove("Macros") + case_setup(self._case, reset=True, test_mode=True) diff --git a/utils/python/CIME/SystemTests/pet.py b/utils/python/CIME/SystemTests/pet.py index 4810f72cb381..27d3e6625214 100644 --- a/utils/python/CIME/SystemTests/pet.py +++ b/utils/python/CIME/SystemTests/pet.py @@ -6,63 +6,39 @@ (2) do another initial run with nthrds=1 for all components (suffix: single_thread) """ -import shutil from CIME.XML.standard_module_setup import * from CIME.case_setup import case_setup -from CIME.SystemTests.system_tests_common import SystemTestsCommon +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo logger = logging.getLogger(__name__) -class PET(SystemTestsCommon): +class PET(SystemTestsCompareTwo): + + _COMPONENT_LIST = ('ATM','CPL','OCN','WAV','GLC','ICE','ROF','LND') def __init__(self, case): """ initialize a test object """ - SystemTestsCommon.__init__(self, case) + SystemTestsCompareTwo.__init__(self, case, + separate_builds = False, + run_two_suffix = 'single_thread', + run_one_description = 'default threading', + run_two_description = 'threads set to 1') - def build_phase(self, sharedlib_only=False, model_only=False): + def _case_one_setup(self): # first make sure that all components have threaded settings - for comp in ['ATM','CPL','OCN','WAV','GLC','ICE','ROF','LND']: + for comp in self._COMPONENT_LIST: if self._case.get_value("NTHRDS_%s"%comp) <= 1: self._case.set_value("NTHRDS_%s"%comp, 2) - self._case.flush() + # Need to redo case_setup because we may have changed the number of threads case_setup(self._case, reset=True) - self.clean_build() - self.build_indv(sharedlib_only=sharedlib_only, model_only=model_only) - - def _pet_first_phase(self): - #Do a run with default threading - self._case.set_value("CONTINUE_RUN",False) - self._case.set_value("REST_OPTION","none") - self._case.set_value("HIST_OPTION","$STOP_OPTION") - self._case.set_value("HIST_N","$STOP_N") - self._case.flush() - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") - logger.info("doing a %d %s initial test with default threading, no restarts written" - % (stop_n, stop_option)) - - self.run_indv() - - def _pet_second_phase(self): + def _case_two_setup(self): #Do a run with all threads set to 1 - for comp in ['ATM','CPL','OCN','WAV','GLC','ICE','ROF','LND']: + for comp in self._COMPONENT_LIST: self._case.set_value("NTHRDS_%s"%comp, 1) - self._case.flush() - shutil.copy("env_mach_pes.xml", os.path.join("LockedFiles","env_mach_pes.xml")) - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") - logger.info("doing a %d %s initial test with threads set to 1, no restarts written" - % (stop_n, stop_option)) - self.run_indv(suffix="single_thread") - self._component_compare_test("base", "single_thread") - - def run_phase(self): - self._pet_first_phase() - self._pet_second_phase() + # Need to redo case_setup because we may have changed the number of threads + case_setup(self._case, reset=True) diff --git a/utils/python/CIME/SystemTests/rep.py b/utils/python/CIME/SystemTests/rep.py new file mode 100644 index 000000000000..716d1e5b87af --- /dev/null +++ b/utils/python/CIME/SystemTests/rep.py @@ -0,0 +1,22 @@ +""" +Implementation of the CIME REP test + +This test verifies that two identical runs give bit-for-bit results +""" + +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo + +class REP(SystemTestsCompareTwo): + + def __init__(self, case): + SystemTestsCompareTwo.__init__(self, case, + separate_builds = False, + run_two_suffix = 'rep2') + + def _case_one_setup(self): + pass + + def _case_two_setup(self): + pass + + diff --git a/utils/python/CIME/SystemTests/ssp.py b/utils/python/CIME/SystemTests/ssp.py index e4bebfd2aeb1..b4acf0a42cd5 100644 --- a/utils/python/CIME/SystemTests/ssp.py +++ b/utils/python/CIME/SystemTests/ssp.py @@ -56,9 +56,7 @@ def run_phase(self): clone.flush() dout_sr = clone.get_value("DOUT_S_ROOT") - self.run_indv(suffix="spinup", - coupler_log_path=os.path.join(dout_sr, "logs"), - st_archive=True) + self.run_indv(suffix="spinup", st_archive=True) #------------------------------------------------------------------- # (2) do a hybrid, non-spinup run in orig_case diff --git a/utils/python/CIME/SystemTests/system_tests_common.py b/utils/python/CIME/SystemTests/system_tests_common.py index 79506006bba8..d101daeb220b 100644 --- a/utils/python/CIME/SystemTests/system_tests_common.py +++ b/utils/python/CIME/SystemTests/system_tests_common.py @@ -1,7 +1,6 @@ """ Base class for CIME system tests """ -import shutil, glob, gzip, time from CIME.XML.standard_module_setup import * from CIME.XML.env_run import EnvRun from CIME.utils import append_status @@ -9,9 +8,12 @@ from CIME.case_run import case_run from CIME.case_st_archive import case_st_archive from CIME.test_status import * +from CIME.hist_utils import * import CIME.build as build +import shutil, glob, gzip, time, traceback + logger = logging.getLogger(__name__) class SystemTestsCommon(object): @@ -30,9 +32,23 @@ def __init__(self, case, expected=None): self._casebaseid = self._case.get_value("CASEBASEID") self._test_status = TestStatus(test_dir=caseroot, test_name=self._casebaseid) + self._init_environment(caseroot) + self._init_locked_files(caseroot, expected) + self._init_case_setup() + + def _init_environment(self, caseroot): + """ + Do initializations of environment variables that are needed in __init__ + """ # Needed for sh scripts os.environ["CASEROOT"] = caseroot + def _init_locked_files(self, caseroot, expected): + """ + If the file LockedFiles/env_run.orig.xml does not exist, copy the current + env_run.xml file. If it does exist, restore values changed in a previous + run of the test. + """ if os.path.isfile(os.path.join(caseroot, "LockedFiles", "env_run.orig.xml")): self.compare_env_run(expected=expected) elif os.path.isfile(os.path.join(caseroot, "env_run.xml")): @@ -44,6 +60,10 @@ def __init__(self, case, expected=None): shutil.copy(os.path.join(caseroot,"env_run.xml"), os.path.join(lockedfiles, "env_run.orig.xml")) + def _init_case_setup(self): + """ + Do initial case setup needed in __init__ + """ if self._case.get_value("IS_FIRST_RUN"): self._case.set_initial_test_values() @@ -70,6 +90,9 @@ def build(self, sharedlib_only=False, model_only=False): model_only=(phase_name==MODEL_BUILD_PHASE)) except: success = False + excmsg = "Exception during build:\n%s\n%s" % (sys.exc_info()[1], traceback.format_exc()) + logger.warning(excmsg) + append_status(excmsg, sfile="TestStatus.log") time_taken = time.time() - start_time with self._test_status: @@ -125,7 +148,9 @@ def run(self): except: success = False - logger.warning("Exception during run: %s" % (sys.exc_info()[1])) + excmsg = "Exception during run:\n%s\n%s" % (sys.exc_info()[1], traceback.format_exc()) + logger.warning(excmsg) + append_status(excmsg, sfile="TestStatus.log") # Always try to report, should NOT throw an exception self.report() @@ -148,6 +173,12 @@ def run_phase(self): """ self.run_indv() + def _get_caseroot(self): + """ + Returns the current CASEROOT value + """ + return self._caseroot + def _set_active_case(self, case): """ Use for tests that have multiple cases @@ -155,7 +186,7 @@ def _set_active_case(self, case): self._case = case self._caseroot = case.get_value("CASEROOT") - def run_indv(self, suffix="base", coupler_log_path=None, st_archive=False): + def run_indv(self, suffix="base", st_archive=False): """ Perform an individual run. Raises an EXCEPTION on fail. """ @@ -173,17 +204,18 @@ def run_indv(self, suffix="base", coupler_log_path=None, st_archive=False): logger.info(infostr) case_run(self._case) - if st_archive: - case_st_archive(self._case) - if not self._coupler_log_indicates_run_complete(coupler_log_path): + if not self._coupler_log_indicates_run_complete(): expect(False, "Coupler did not indicate run passed") if suffix is not None: self._component_compare_move(suffix) - def _coupler_log_indicates_run_complete(self, coupler_log_path): - newestcpllogfile = self._get_latest_cpl_log(coupler_log_path) + if st_archive: + case_st_archive(self._case) + + def _coupler_log_indicates_run_complete(self): + newestcpllogfile = self._get_latest_cpl_log() logger.debug("Latest Coupler log file is %s" % newestcpllogfile) # Exception is raised if the file is not compressed try: @@ -200,37 +232,20 @@ def report(self): pass def _component_compare_move(self, suffix): - cmd = os.path.join(self._case.get_value("SCRIPTSROOT"), "Tools", - "component_compare_move.sh") - rc, out, err = run_cmd("%s -rundir %s -testcase %s -suffix %s" % - (cmd, self._case.get_value('RUNDIR'), self._case.get_value('CASE'), suffix)) - if rc == 0: - append_status(out, sfile="TestStatus.log") - else: - append_status("Component_compare_move.sh failed out: %s\n\nerr: %s\n" % (out, err), - sfile="TestStatus.log") + comments = move(self._case, suffix) + append_status(comments, sfile="TestStatus.log") def _component_compare_test(self, suffix1, suffix2): """ Return value is not generally checked, but is provided in case a custom run case needs indirection based on success. """ - cmd = os.path.join(self._case.get_value("SCRIPTSROOT"),"Tools", - "component_compare_test.sh") - rc, out, err = run_cmd("%s -rundir %s -testcase %s -testcase_base %s -suffix1 %s -suffix2 %s -msg 'Compare %s and %s'" - %(cmd, self._case.get_value('RUNDIR'), self._case.get_value('CASE'), - self._case.get_value('CASEBASEID'), suffix1, suffix2, suffix1, suffix2)) - logger.debug("run %s results %d %s %s"%(cmd,rc,out,err)) - status = TEST_PASS_STATUS if rc == 0 else TEST_FAIL_STATUS + success, comments = compare_test(self._case, suffix1, suffix2) + append_status(comments, sfile="TestStatus.log") + status = TEST_PASS_STATUS if success else TEST_FAIL_STATUS with self._test_status: self._test_status.set_status("%s_%s_%s" % (COMPARE_PHASE, suffix1, suffix2), status) - - if rc != 0: - append_status("Component_compare_test.sh failed out: %s\n\nerr: %s\n"%(out,err), - sfile="TestStatus.log") - return False - - return True + return success def _get_mem_usage(self, cpllog): """ @@ -306,11 +321,11 @@ def compare_env_run(self, expected=None): return False return True - def _get_latest_cpl_log(self, coupler_log_path=None): + def _get_latest_cpl_log(self): """ find and return the latest cpl log file in the run directory """ - coupler_log_path = self._case.get_value("RUNDIR") if coupler_log_path is None else coupler_log_path + coupler_log_path = self._case.get_value("RUNDIR") cpllog = None cpllogs = glob.glob(os.path.join(coupler_log_path, 'cpl.log.*')) if cpllogs: @@ -323,27 +338,13 @@ def _compare_baseline(self): compare the current test output to a baseline result """ with self._test_status: - baselineroot = self._case.get_value("BASELINE_ROOT") - basecmp_dir = os.path.join(baselineroot, self._case.get_value("BASECMP_CASE")) - for bdir in (baselineroot, basecmp_dir): - if not os.path.isdir(bdir): - comment = "ERROR %s does not exist" % bdir - self._test_status.set_status("%s_baseline" % COMPARE_PHASE, TEST_FAIL_STATUS, comments=comment) - append_status(comment, sfile="TestStatus.log") - return -1 - - compgen = os.path.join(self._case.get_value("SCRIPTSROOT"),"Tools", - "component_compgen_baseline.sh") - compgen += " -baseline_dir "+basecmp_dir - compgen += " -test_dir "+self._case.get_value("RUNDIR") - compgen += " -compare_tag "+self._case.get_value("BASELINE_NAME_CMP") - compgen += " -testcase "+self._case.get_value("CASE") - compgen += " -testcase_base "+self._case.get_value("CASEBASEID") - rc, out, err = run_cmd(compgen) - - status = TEST_PASS_STATUS if rc == 0 else TEST_FAIL_STATUS - self._test_status.set_status("%s_baseline" % COMPARE_PHASE, status) - append_status("Baseline compare results: %s\n%s"%(out,err), sfile="TestStatus.log") + # compare baseline + success, comments = compare_baseline(self._case) + append_status(comments, sfile="TestStatus.log") + status = TEST_PASS_STATUS if success else TEST_FAIL_STATUS + ts_comments = comments if "\n" not in comments else None + self._test_status.set_status("%s_baseline" % COMPARE_PHASE, status, comments=ts_comments) + basecmp_dir = os.path.join(self._case.get_value("BASELINE_ROOT"), self._case.get_value("BASECMP_CASE")) # compare memory usage to baseline newestcpllogfile = self._get_latest_cpl_log() @@ -381,31 +382,16 @@ def _generate_baseline(self): generate a new baseline case based on the current test """ with self._test_status: - newestcpllogfile = self._get_latest_cpl_log() - baselineroot = self._case.get_value("BASELINE_ROOT") - basegen_dir = os.path.join(baselineroot, self._case.get_value("BASEGEN_CASE")) - for bdir in (baselineroot, basegen_dir): - if not os.path.isdir(bdir): - comment = "ERROR %s does not exist" % bdir - self._test_status.set_status("%s" % GENERATE_PHASE, TEST_FAIL_STATUS, comments=comment) - append_status(comment, sfile="TestStatus.log") - return -1 - - compgen = os.path.join(self._case.get_value("SCRIPTSROOT"),"Tools", - "component_compgen_baseline.sh") - compgen += " -baseline_dir "+basegen_dir - compgen += " -test_dir "+self._case.get_value("RUNDIR") - compgen += " -generate_tag "+self._case.get_value("BASELINE_NAME_GEN") - compgen += " -testcase "+self._case.get_value("CASE") - compgen += " -testcase_base "+self._case.get_value("CASEBASEID") - rc, out, err = run_cmd(compgen) - - status = TEST_PASS_STATUS if rc == 0 else TEST_FAIL_STATUS + # generate baseline + success, comments = generate_baseline(self._case) + append_status(comments, sfile="TestStatus.log") + status = TEST_PASS_STATUS if success else TEST_FAIL_STATUS self._test_status.set_status("%s" % GENERATE_PHASE, status) - append_status("Baseline generate results: %s\n%s"%(out,err), sfile="TestStatus.log") + basegen_dir = os.path.join(self._case.get_value("BASELINE_ROOT"), self._case.get_value("BASEGEN_CASE")) # copy latest cpl log to baseline # drop the date so that the name is generic + newestcpllogfile = self._get_latest_cpl_log() shutil.copyfile(newestcpllogfile, os.path.join(basegen_dir,"cpl.log.gz")) @@ -434,18 +420,18 @@ def build_phase(self, sharedlib_only=False, model_only=False): build.post_build(self._case, []) - def run_phase(self): - self.run_indv(suffix=None) - class TESTRUNPASS(FakeTest): def build_phase(self, sharedlib_only=False, model_only=False): rundir = self._case.get_value("RUNDIR") + cimeroot = self._case.get_value("CIMEROOT") + case = self._case.get_value("CASE") script = \ """ echo Insta pass echo SUCCESSFUL TERMINATION > %s/cpl.log.$LID -""" % rundir +cp %s/utils/python/tests/cpl.hi1.nc.test %s/%s.cpl.hi.0.nc +""" % (rundir, cimeroot, rundir, case) self._set_script(script) FakeTest.build_phase(self, sharedlib_only=sharedlib_only, model_only=model_only) @@ -467,9 +453,9 @@ def build_phase(self, sharedlib_only=False, model_only=False): echo Insta pass echo SUCCESSFUL TERMINATION > %s/cpl.log.$LID if [ -z "$TESTRUNDIFF_ALTERNATE" ]; then - cp %s/utils/python/tests/cpl.hi1.nc.test %s/%s.cpl.hi.0.nc.base + cp %s/utils/python/tests/cpl.hi1.nc.test %s/%s.cpl.hi.0.nc else - cp %s/utils/python/tests/cpl.hi2.nc.test %s/%s.cpl.hi.0.nc.base + cp %s/utils/python/tests/cpl.hi2.nc.test %s/%s.cpl.hi.0.nc fi """ % (rundir, cimeroot, rundir, case, cimeroot, rundir, case) self._set_script(script) @@ -490,22 +476,36 @@ def build_phase(self, sharedlib_only=False, model_only=False): FakeTest.build_phase(self, sharedlib_only=sharedlib_only, model_only=model_only) +class TESTRUNFAILEXC(TESTRUNPASS): + + def run_phase(self): + raise RuntimeError("Exception from run_phase") + class TESTBUILDFAIL(FakeTest): def build_phase(self, sharedlib_only=False, model_only=False): if (not sharedlib_only): - expect(False, "ERROR: Intentional fail for testing infrastructure") + expect(False, "Intentional fail for testing infrastructure") + +class TESTBUILDFAILEXC(FakeTest): + + def __init__(self, case): + FakeTest.__init__(self, case) + raise RuntimeError("Exception from init") class TESTRUNSLOWPASS(FakeTest): def build_phase(self, sharedlib_only=False, model_only=False): rundir = self._case.get_value("RUNDIR") + cimeroot = self._case.get_value("CIMEROOT") + case = self._case.get_value("CASE") script = \ """ sleep 300 echo Slow pass echo SUCCESSFUL TERMINATION > %s/cpl.log.$LID -""" % rundir +cp %s/utils/python/tests/cpl.hi1.nc.test %s/%s.cpl.hi.0.nc +""" % (rundir, cimeroot, rundir, case) self._set_script(script) FakeTest.build_phase(self, sharedlib_only=sharedlib_only, model_only=model_only) @@ -514,12 +514,14 @@ class TESTMEMLEAKFAIL(FakeTest): def build_phase(self, sharedlib_only=False, model_only=False): rundir = self._case.get_value("RUNDIR") cimeroot = self._case.get_value("CIMEROOT") + case = self._case.get_value("CASE") testfile = os.path.join(cimeroot,"utils","python","tests","cpl.log.failmemleak.gz") script = \ """ echo Insta pass gunzip -c %s > %s/cpl.log.$LID -""" % (testfile, rundir) +cp %s/utils/python/tests/cpl.hi1.nc.test %s/%s.cpl.hi.0.nc +""" % (testfile, rundir, cimeroot, rundir, case) self._set_script(script) FakeTest.build_phase(self, sharedlib_only=sharedlib_only, model_only=model_only) @@ -528,12 +530,14 @@ class TESTMEMLEAKPASS(FakeTest): def build_phase(self, sharedlib_only=False, model_only=False): rundir = self._case.get_value("RUNDIR") cimeroot = self._case.get_value("CIMEROOT") + case = self._case.get_value("CASE") testfile = os.path.join(cimeroot,"utils","python","tests","cpl.log.passmemleak.gz") script = \ """ echo Insta pass gunzip -c %s > %s/cpl.log.$LID -""" % (testfile, rundir) +cp %s/utils/python/tests/cpl.hi1.nc.test %s/%s.cpl.hi.0.nc +""" % (testfile, rundir, cimeroot, rundir, case) self._set_script(script) FakeTest.build_phase(self, sharedlib_only=sharedlib_only, model_only=model_only) diff --git a/utils/python/CIME/SystemTests/system_tests_compare_two.py b/utils/python/CIME/SystemTests/system_tests_compare_two.py new file mode 100644 index 000000000000..f51543dd79b9 --- /dev/null +++ b/utils/python/CIME/SystemTests/system_tests_compare_two.py @@ -0,0 +1,356 @@ +""" +Base class for CIME system tests that involve doing two runs and comparing their +output. + +In the __init__ method for your test, you MUST call + SystemTestsCompareTwo.__init__ +See the documentation of that method for details. + +Classes that inherit from this are REQUIRED to implement the following methods: + +(1) _case_one_setup + This method will be called to set up case 1, the "base" case + +(2) _case_two_setup + This method will be called to set up case 2, the "test" case + +In addition, they MAY require the following method: + +(1) _common_setup + This method will be called to set up both cases. It should contain any setup + that's needed in both cases. This is called before _case_one_setup or + _case_two_setup. + +""" + +from CIME.XML.standard_module_setup import * +from CIME.SystemTests.system_tests_common import SystemTestsCommon +from CIME.case import Case + +import shutil, os, glob + +logger = logging.getLogger(__name__) + +class SystemTestsCompareTwo(SystemTestsCommon): + + def __init__(self, + case, + separate_builds, + run_two_suffix = 'test', + run_one_description = '', + run_two_description = ''): + """ + Initialize a SystemTestsCompareTwo object. Individual test cases that + inherit from SystemTestsCompareTwo MUST call this __init__ method. + + Args: + case: case object passsed to __init__ method of individual + test. This is the main case associated with the test. + separate_builds (bool): Whether separate builds are needed for the + two cases. If False, case2 uses the case1 executable. + run_two_suffix (str, optional): Suffix appended to the case name for + the second run. Defaults to 'test'. This can be anything other + than 'base'. + run_one_description (str, optional): Description printed to log file + when starting the first run. Defaults to ''. + run_two_description (str, optional): Description printed to log file + when starting the second run. Defaults to ''. + """ + SystemTestsCommon.__init__(self, case) + + self._separate_builds = separate_builds + + # run_one_suffix is just used as the suffix for the netcdf files + # produced by the first case; we may eventually remove this, but for now + # it is needed by the various component_*.sh scripts. run_two_suffix is + # also used as the suffix for netcdf files, but more importantly is used + # to create the case name for the clone case. + # + # NOTE(wjs, 2016-08-03) It is currently CRITICAL for run_one_suffix to + # be 'base', because this is assumed for baseline comparison and + # generation. Once that assumption is relaxed, then run_one_suffix can + # be set in the call to the constructor just like run_two_suffix + # currently is. Or, if these tools are rewritten to work without any + # suffix, then run_one_suffix can be removed entirely. + self._run_one_suffix = 'base' + self._run_two_suffix = run_two_suffix.rstrip() + expect(self._run_two_suffix != self._run_one_suffix, + "ERROR: Must have different suffixes for run one and run two") + + self._run_one_description = run_one_description + self._run_two_description = run_two_description + + # Save case for first run so we can return to it if we switch self._case + # to point to self._case2 + self._case1 = self._case + self._caseroot1 = self._get_caseroot() + + self._caseroot2 = self._get_caseroot2() + # Initialize self._case2; it will get set to its true value in + # _setup_cases_if_not_yet_done + self._case2 = None + + self._setup_cases_if_not_yet_done() + + # ======================================================================== + # Methods that MUST be implemented by specific tests that inherit from this + # base class + # ======================================================================== + + def _case_one_setup(self): + """ + This method will be called to set up case 1, the "base" case. + + This should be written to refer to self._case: this object will point to + case1 at the point that this is called. + """ + raise NotImplementedError + + def _case_two_setup(self): + """ + This method will be called to set up case 2, the "test" case + + This should be written to refer to self._case: this object will point to + case2 at the point that this is called. + """ + raise NotImplementedError + + # ======================================================================== + # Methods that MAY be implemented by specific tests that inherit from this + # base class, if they have any work to do in these methods + # ======================================================================== + + def _common_setup(self): + """ + This method will be called to set up both cases. It should contain any setup + that's needed in both cases. This is called before _case_one_setup or + _case_two_setup. + + This should be written to refer to self._case: It will be called once with + self._case pointing to case1, and once with self._case pointing to case2. + """ + pass + + # ======================================================================== + # Main public methods + # ======================================================================== + + def build_phase(self, sharedlib_only=False, model_only=False): + if self._separate_builds: + self._activate_case1() + self.build_indv(sharedlib_only=sharedlib_only, model_only=model_only) + self._activate_case2() + self.build_indv(sharedlib_only=sharedlib_only, model_only=model_only) + else: + self._activate_case1() + self.build_indv(sharedlib_only=sharedlib_only, model_only=model_only) + # The following is needed when _case_two_setup has a case_setup call + # despite sharing the build (e.g., to change NTHRDS) + self._case2.set_value("BUILD_COMPLETE",True) + self._case2.flush() + + def run_phase(self): + """ + Runs both phases of the two-phase test and compares their results + """ + + # First run + logger.info('Doing first run: ' + self._run_one_description) + self._activate_case1() + self.run_indv(suffix = self._run_one_suffix) + + # Second run + logger.info('Doing second run: ' + self._run_two_description) + self._activate_case2() + self._force_case2_settings() + self.run_indv(suffix = self._run_two_suffix) + + # Compare results + # Case1 is the "main" case, and we need to do the comparisons from there + self._activate_case1() + self._link_to_case2_output() + + self._component_compare_test(self._run_one_suffix, self._run_two_suffix) + + # ======================================================================== + # Private methods + # ======================================================================== + + def _get_caseroot2(self): + """ + Determines and returns caseroot for case2 + + Assumes that self._case1 is already set to point to the case1 object, + and that self._run_two_suffix is already set. + """ + casename1 = self._case1.get_value("CASE") + caseroot1 = self._case1.get_value("CASEROOT") + + casename2 = "%s.%s"%(casename1, self._run_two_suffix) + + # Nest the case directory for case2 inside the case directory for case1 + caseroot2 = os.path.join(caseroot1, casename2) + + return caseroot2 + + def _setup_cases_if_not_yet_done(self): + """ + Determines if case2 already exists on disk. If it does, this method + creates the self._case2 object pointing to the case directory. If it + doesn't exist, then this method creates case2 as a clone of case1, and + sets the self._case2 object appropriately. + + This also does the setup for both case1 and case2. + + Assumes that the following variables are already set in self: + _caseroot1 + _caseroot2 + _case1 + + Sets self._case2 + """ + + # Use the existence of the case2 directory to signal whether we have + # done the necessary test setup for this test: When we initially create + # the case2 directory, we set up both test cases; then, if we find that + # the case2 directory already exists, we assume that the setup has + # already been done. (In some cases it could be problematic to redo the + # test setup when it's not needed - e.g., by appending things to user_nl + # files multiple times. This is why we want to make sure to just do the + # test setup once.) + + if os.path.exists(self._caseroot2): + self._case2 = self._case_from_existing_caseroot(self._caseroot2) + else: + try: + self._case2 = self._case1.create_clone( + newcase = self._caseroot2, + keepexe = self._separate_builds==False) + self._setup_cases() + except: + # If a problem occurred in setting up the test cases, it's + # important to remove the case2 directory: If it's kept around, + # that would signal that test setup was done successfully, and + # thus doesn't need to be redone - which is not the case. Of + # course, we'll likely be left in an inconsistent state in this + # case, but if we didn't remove the case2 directory, the next + # re-build of the test would think, "okay, setup is done, I can + # move on to the build", which would be wrong. + shutil.rmtree(self._caseroot2) + self._activate_case1() + logger.warning("WARNING: Test case setup failed. Case2 has been removed, " + "but the main case may be in an inconsistent state. " + "If you want to rerun this test, you should create " + "a new test rather than trying to rerun this one.") + raise + + def _case_from_existing_caseroot(self, caseroot): + """ + Returns a Case object from an existing caseroot directory + + Args: + caseroot (str): path to existing caseroot + """ + return Case(case_root=caseroot, read_only=False) + + def _activate_case1(self): + """ + Make case 1 active for upcoming calls + """ + os.chdir(self._caseroot1) + self._set_active_case(self._case1) + + def _activate_case2(self): + """ + Make case 2 active for upcoming calls + """ + os.chdir(self._caseroot2) + self._set_active_case(self._case2) + + def _setup_cases(self): + """ + Does all test-specific set up for the two test cases. + """ + + # Set up case 1 + self._activate_case1() + self._common_setup() + self._case_one_setup() + # Flush the case so that, if errors occur later, then at least case 1 is + # in a correct, post-setup state. This is important because the mere + # existence of a case 2 directory signals that setup is done. So if the + # build fails and the user rebuilds, setup won't be redone - so it's + # important to ensure that the results of setup are flushed to disk. + # + # Note that case 1 will be in its post-setup state even if case 2 setup + # fails. Putting the case1 flush after case 2 setup doesn't seem to help + # with that (presumably some flush is called automatically), and anyway + # wouldn't help with things like appending to user_nl files (which don't + # rely on flush). So we just have to live with that possibility (but + # note that we print a warning to the log file if that happens, in the + # caller of this method). + self._case.flush() + + # Set up case 2 + self._activate_case2() + self._common_setup() + self._case_two_setup() + # Flush the case so that, if errors occur later, then at least case2 is + # in a correct, post-setup state + self._case.flush() + + # Go back to case 1 to ensure that's where we are for any following code + self._activate_case1() + + def _force_case2_settings(self): + """ + Sets some settings in case2 that are normally set automatically. + + This is needed because we aren't running case2 via the normal mechanism + (i.e., via the submit script). + """ + + # RUN_WITH_SUBMIT is normally set when you run the case's submit script. + # Trick the scripts into thinking that we are running via the submit + # script, like we're supposed to + self._case2.set_value("RUN_WITH_SUBMIT",True) + + def _link_to_case2_output(self): + """ + Looks for all files in rundir2 matching the pattern casename2*.nc.run2suffix + + For each file found, makes a link in rundir1 pointing to this file; the + link is renamed so that the original occurrence of casename2 is replaced + with casename1. + + For example: + + /glade/scratch/sacks/somecase/run/somecase.clm2.h0.nc.run2 -> + /glade/scratch/sacks/somecase.run2/run/somecase.run2.clm2.h0.nc.run2 + + If the destination link already exists and points to the correct + location, it is maintained as is. However, an exception will be raised + if the destination link is not exactly as it should be: we avoid + overwriting some existing file or link. + """ + + casename1 = self._case1.get_value("CASE") + casename2 = self._case2.get_value("CASE") + rundir1 = self._case1.get_value("RUNDIR") + rundir2 = self._case2.get_value("RUNDIR") + run2suffix = self._run_two_suffix + + pattern = '%s*.nc.%s'%(casename2, run2suffix) + case2_files = glob.glob(os.path.join(rundir2, pattern)) + for one_file in case2_files: + file_basename = os.path.basename(one_file) + modified_basename = file_basename.replace(casename2, casename1, 1) + one_link = os.path.join(rundir1, modified_basename) + if (os.path.islink(one_link) and + os.readlink(one_link) == one_file): + # Link is already set up correctly: do nothing + # (os.symlink raises an exception if you try to replace an + # existing file) + pass + else: + os.symlink(one_file, one_link) diff --git a/utils/python/CIME/SystemTests/test_utils/__init__.py b/utils/python/CIME/SystemTests/test_utils/__init__.py new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/utils/python/CIME/SystemTests/test_utils/user_nl_utils.py b/utils/python/CIME/SystemTests/test_utils/user_nl_utils.py new file mode 100644 index 000000000000..f91b832b943e --- /dev/null +++ b/utils/python/CIME/SystemTests/test_utils/user_nl_utils.py @@ -0,0 +1,51 @@ +""" +This module contains functions for working with user_nl files in system tests. +""" + +import os +import glob + +def append_to_user_nl_files(caseroot, component, contents): + """ + Append the string given by 'contents' to the end of each user_nl file for + the given component (there may be multiple such user_nl files in the case of + a multi-instance test). + + Also puts new lines before and after the appended text - so 'contents' + does not need to contain a trailing new line (but it's also okay if it + does). + + Args: + caseroot (str): Full path to the case directory + + component (str): Name of component (e.g., 'clm'). This is used to + determine which user_nl files are appended to. For example, for + component='clm', this function will operate on all user_nl files + matching the pattern 'user_nl_clm*'. (We do a wildcard match to + handle multi-instance tests.) + + contents (str): Contents to append to the end of each user_nl file + """ + + files = _get_list_of_user_nl_files(caseroot, component) + + if len(files) == 0: + raise RuntimeError('No user_nl files found for component ' + component) + + for one_file in files: + with open(one_file, 'a') as user_nl_file: + user_nl_file.write('\n' + contents + '\n') + +def _get_list_of_user_nl_files(path, component): + """Get a list of all user_nl files in the current path for the component + of interest. For a component 'foo', we match all files of the form + user_nl_foo* - with a wildcard match at the end in order to match files + in a multi-instance case. + + The list of returned files gives their full path. + """ + + file_pattern = 'user_nl_' + component + '*' + file_list = glob.glob(os.path.join(path, file_pattern)) + + return file_list diff --git a/utils/python/CIME/XML/batch.py b/utils/python/CIME/XML/batch.py index 18ea2b989d2b..6826a2954541 100644 --- a/utils/python/CIME/XML/batch.py +++ b/utils/python/CIME/XML/batch.py @@ -26,6 +26,12 @@ def __init__(self, batch_system=None, machine=None, infile=None): self.batch_system = batch_system self.machine = machine + #Append the contents of $HOME/.cime/config_batch.xml if it exists + #This could cause problems if node matchs are repeated when only one is expected + infile = os.path.join(os.environ.get("HOME"),".cime","config_batch.xml") + if os.path.exists(infile): + GenericXML.read(self, infile) + if self.batch_system is not None: self.set_batch_system(self.batch_system, machine=machine) diff --git a/utils/python/CIME/macros.py b/utils/python/CIME/XML/build.py similarity index 95% rename from utils/python/CIME/macros.py rename to utils/python/CIME/XML/build.py index eab030f62bf7..438440ef364f 100644 --- a/utils/python/CIME/macros.py +++ b/utils/python/CIME/XML/build.py @@ -1,9 +1,9 @@ """ Classes used to build the CIME Macros file. -The main "public" class here is MacroMaker. It is initialized with machine- -specific information, and its write_macros method is the driver for translating -the config_build.xml file into a Makefile or CMake-format Macros file. +The main "public" class here is Build. It is initialized with machine-specific +information, and its write_macros method is the driver for translating the +config_build.xml file into a Makefile or CMake-format Macros file. For developers, here's the role of the other classes in the process: @@ -20,14 +20,14 @@ In more detail: -- MacroMaker.write_macros immediately creates a MakeMacroWriter or - CMakeMacroWriter to translate strings for the build system. +- Build.write_macros immediately creates a MakeMacroWriter or CMakeMacroWriter + to translate strings for the build system. - It also creates value_lists, a dictionary of PossibleValues objects, with variable names as the keys. Each variable has a single PossibleValues object associated with it. -- For each element, MacroMaker.write_macros creates a CompilerBlock +- For each element, Build.write_macros creates a CompilerBlock instance. This object is responsible for translating the XML in its block, in order to populate the PossibleValues instances. This includes handling the // tags, and keeping track of dependencies induced by one @@ -47,11 +47,11 @@ translated to. The lists in the PossibleValues class contain these objects. - Once the XML has all been read in and the PossibleValues objects are - populated, the dependencies among variables are checked in - MacroMaker.write_macros. For each variable, if all its dependencies have been - handled, it is converted to a MacroConditionTree merged with all other trees - for variables that are ready, and written out. Then we loop through the - variable list again to check for variables whose dependencies are all handled. + populated, the dependencies among variables are checked in Build.write_macros. + For each variable, if all its dependencies have been handled, it is converted + to a MacroConditionTree merged with all other trees for variables that are + ready, and written out. Then we loop through the variable list again to check + for variables whose dependencies are all handled. - The MacroConditionTree acts as a primitive syntax tree. Its __init__ method reorganizes the data into conditional blocks, and its write_out method writes @@ -68,7 +68,7 @@ from CIME.XML.machines import Machines # pylint: disable=unused-import from CIME.XML.standard_module_setup import * -__all__ = ["MacroMaker"] +__all__ = ["Build"] logger = logging.getLogger(__name__) @@ -623,14 +623,11 @@ def add_settings_to_lists(self, flag_vars, value_lists): else: self._add_elem_to_lists(elem.tag, elem, value_lists) - def matches_machine(self, os_): + def matches_machine(self): """Check whether this block matches a machine/os. This also sets the specificity of the block, so this must be called before add_settings_to_lists if machine-specific output is needed. - - Arguments: - os_ - Operating system to match. """ self._specificity = 0 if "MACH" in self._compiler_elem.keys(): @@ -640,7 +637,7 @@ def matches_machine(self, os_): else: return False if "OS" in self._compiler_elem.keys(): - if os_ == self._compiler_elem.get("OS"): + if self._machobj.get_value("OS") == self._compiler_elem.get("OS"): self._specificity += 1 else: return False @@ -651,7 +648,7 @@ def matches_machine(self, os_): return True -class MacroMaker(object): +class Build(object): """Class to convert config_build.xml input into a macros file. @@ -665,23 +662,21 @@ class MacroMaker(object): write_macros """ - def __init__(self, os_, machobj, schema_path=None): - """Construct a MacroMaker given machine-specific information. + def __init__(self, machobj, schema_path=None): + """Construct a Build given machine-specific information. In the process some information about possible variables is read in from the schema file. Arguments: - os_ - Name of a machine's operating system. machobj - A Machines object for this machine. schema_path (optional) - Path to config_build.xsd within CIME. - >>> "CFLAGS" in MacroMaker('FakeOS', 'MyMach').flag_vars + >>> "CFLAGS" in Build('MyMach').flag_vars True - >>> "MPICC" in MacroMaker('FakeOS', 'MyMach').flag_vars + >>> "MPICC" in Build('MyMach').flag_vars False """ - self.os = os_ self.machobj = machobj # The schema is used to figure out which variables contain @@ -724,7 +719,7 @@ def write_macros(self, build_system, xml_file, output): for compiler_elem in ET.parse(xml_file).findall("compiler"): block = CompilerBlock(writer, compiler_elem, self.machobj) # If this block matches machine settings, use it. - if block.matches_machine(self.os): + if block.matches_machine(): block.add_settings_to_lists(self.flag_vars, value_lists) # Now that we've scanned through the input, output the variable diff --git a/utils/python/CIME/XML/compilers.py b/utils/python/CIME/XML/compilers.py index 3796f4edcc08..68bd76f531da 100644 --- a/utils/python/CIME/XML/compilers.py +++ b/utils/python/CIME/XML/compilers.py @@ -26,16 +26,16 @@ def __init__(self, compiler=None, machine=None, os_= None, mpilib=None, infile=N self.mpilib = mpilib self.compiler_nodes = None # Listed from last to first self.compiler = compiler - - if self.compiler is not None: - self.set_compiler(compiler) - #Append the contents of $HOME/.cime/config_compilers.xml if it exists #This could cause problems if node matchs are repeated when only one is expected infile = os.path.join(os.environ.get("HOME"),".cime","config_compilers.xml") if os.path.exists(infile): GenericXML.read(self, infile) + if self.compiler is not None: + self.set_compiler(compiler) + + def get_compiler(self): """ Return the name of the compiler diff --git a/utils/python/CIME/XML/env_batch.py b/utils/python/CIME/XML/env_batch.py index 846bec7c1ca9..be78beadba48 100644 --- a/utils/python/CIME/XML/env_batch.py +++ b/utils/python/CIME/XML/env_batch.py @@ -276,7 +276,7 @@ def set_job_defaults(self, bjobs, pesize=None, walltime=None, force_queue=None): else: task_count = int(task_count) - queue = force_queue if force_queue is not None else self.select_best_queue(task_count) + queue = force_queue if force_queue is not None else self.select_best_queue(task_count, job) self.set_value("JOB_QUEUE", queue, subgroup=job) walltime = self.get_max_walltime(queue) if walltime is None else walltime @@ -330,6 +330,8 @@ def get_submit_args(self, case, job): if name is None: submitargs+=" %s"%flag else: + if name.startswith("$"): + name = name[1:] val = case.get_value(name,subgroup=job) if val is None: val = case.get_resolved_value(name) @@ -464,7 +466,7 @@ def get_job_id(self, output): jobid = re.search(jobid_pattern, output).group(1) return jobid - def select_best_queue(self, num_pes): + def select_best_queue(self, num_pes, job=None): # Make sure to check default queue first. all_queues = [] all_queues.append( self.get_default_queue()) @@ -473,8 +475,12 @@ def select_best_queue(self, num_pes): if queue is not None: jobmin = queue.get("jobmin") jobmax = queue.get("jobmax") + jobname = queue.get("jobname") + if jobname is not None: + if job == jobname: + return queue.text # if the fullsum is between the min and max # jobs, then use this queue. - if jobmin is not None and jobmax is not None and num_pes >= int(jobmin) and num_pes <= int(jobmax): + elif jobmin is not None and jobmax is not None and num_pes >= int(jobmin) and num_pes <= int(jobmax): return queue.text return None diff --git a/utils/python/CIME/XML/env_mach_specific.py b/utils/python/CIME/XML/env_mach_specific.py index e1a64e67a6b6..be6e312e0773 100644 --- a/utils/python/CIME/XML/env_mach_specific.py +++ b/utils/python/CIME/XML/env_mach_specific.py @@ -20,6 +20,14 @@ def __init__(self, caseroot, infile="env_mach_specific.xml"): fullpath = infile if os.path.isabs(infile) else os.path.join(caseroot, infile) EnvBase.__init__(self, caseroot, fullpath) + def populate(self, machobj): + """Add entries to the file using information from a Machines object.""" + items = ("module_system", "environment_variables", "mpirun") + for item in items: + nodes = machobj.get_first_child_nodes(item) + for node in nodes: + self.add_child(node) + def get_values(self, item, attribute=None, resolved=True, subgroup=None): """Returns the value as a string of the first xml element with item as attribute value. &1" % (check_compare, run_dir)) - - if (stat != 0): - # found diff, offer rebless - print out - - if (not report_only and - (force or raw_input("Update this diff (y/n)? ").upper() in ["Y", "YES"])): - stat = run_cmd(compgen_cmd, verbose=True)[0] - if (stat != 0): - logging.warning("Hist file bless FAILED for test %s" % test_name) - return False, "Bless command failed" + with Case(testcase_dir_for_test) as case: + baseline_full_dir = os.path.join(baseline_root, baseline_name, case.get_value("CASEBASEID")) + result, comments = compare_baseline(case, baseline_dir=baseline_full_dir) + if result: + return True, None + else: + print comments + if (not report_only and + (force or raw_input("Update this diff (y/n)? ").upper() in ["Y", "YES"])): + result, comments = generate_baseline(case, baseline_dir=baseline_full_dir) + if not result: + logging.warning("Hist file bless FAILED for test %s" % test_name) + return False, "Generate baseline failed: %s" % comments + else: + print comments + return True, None else: return True, None - else: - return True, None - else: - logging.warning("Test '%s' was marked as DIFF but cprnc did not find diff?" % test_name) - return False, "No diff found or missing baseline" ############################################################################### -def bless_test_results(baseline_name, test_root, compiler, test_id=None, namelists_only=False, hist_only=False, report_only=False, force=False, bless_tests=None): +def bless_test_results(baseline_name, baseline_root, test_root, compiler, test_id=None, namelists_only=False, hist_only=False, report_only=False, force=False, bless_tests=None): ############################################################################### test_id_glob = "*%s*%s*" % (compiler, baseline_name) if test_id is None else "*%s" % test_id test_status_files = glob.glob("%s/%s/%s" % (test_root, test_id_glob, TEST_STATUS_FILENAME)) expect(test_status_files, "No matching test cases found in for %s/%s/%s" % (test_root, test_id_glob, TEST_STATUS_FILENAME)) - baseline_root = _MACHINE.get_value("CCSM_BASELINE") - baseline_tag = os.path.join(compiler, baseline_name) - baseline_area = os.path.join(baseline_root, baseline_tag) - - # The env_mach_specific script may need these to be defined - compiler = _MACHINE.get_default_compiler() # this MUST match compiler that cprnc was built with - os.environ["COMPILER"] = compiler - os.environ["MPILIB"] = _MACHINE.get_default_MPIlib(attributes={"compiler":compiler}) - broken_blesses = [] for test_status_file in test_status_files: - ts = TestStatus(test_dir=os.path.dirname(test_status_file)) + test_dir = os.path.dirname(test_status_file) + ts = TestStatus(test_dir=test_dir) test_name = ts.get_name() if (bless_tests in [[], None] or CIME.utils.match_any(test_name, bless_tests)): overall_result = ts.get_overall_test_status() @@ -118,22 +75,17 @@ def bless_test_results(baseline_name, test_root, compiler, test_id=None, namelis # Compute hist status, False implies it diffed if (not namelists_only): run_result = ts.get_status(RUN_PHASE) - baseline_comp_result = ts.get_status("%s_baseline" % COMPARE_PHASE) if (run_result is None): broken_blesses.append((test_name, "no run phase")) logging.warning("Test '%s' did not make it to run phase" % test_name) hist_no_bless = True - elif (run_result == TEST_PASS_STATUS): - if (baseline_comp_result is None): - broken_blesses.append((test_name, "no history compare performed")) - logging.warning("Test '%s' had no history compare phase" % test_name) - hist_no_bless = True - else: - hist_no_bless = baseline_comp_result == TEST_PASS_STATUS - else: + elif (run_result != TEST_PASS_STATUS): broken_blesses.append((test_name, "test did not pass")) logging.warning("Test '%s' did not pass, not safe to bless" % test_name) hist_no_bless = True + else: + hist_no_bless = False + else: hist_no_bless = True @@ -145,39 +97,25 @@ def bless_test_results(baseline_name, test_root, compiler, test_id=None, namelis print "###############################################################################" print "Blessing results for test:", test_name, "most recent result:", overall_result print "###############################################################################" - time.sleep(2) - - # Get baseline dir for this test - baseline_dir_for_test = os.path.join(baseline_area, test_name) - if (not os.path.isdir(baseline_dir_for_test)): - logging.warning("Problem, baseline dir '%s' does not exist" % baseline_dir_for_test) - broken_blesses.append((test_name, "missing baseline dir")) - continue - - # Get testcase dir for this test - if (test_id is None): - # The full name already contains the compiler, so we just need to glob for the branch name - globs = glob.glob("%s/%s*%s*" % (test_root, test_name, baseline_name)) - else: - globs = glob.glob("%s/%s%s" % (test_root, test_name, test_id_glob)) - - if (len(globs) != 1): - logging.warning("Expected exactly one match for testcase area for test '%s', found '%s'" % (test_name, globs)) - broken_blesses.append((test_name, "multiple matching testcase dirs")) - continue - - testcase_dir_for_test = globs[0] + if not force: + time.sleep(2) # Bless namelists if (not nl_no_bless): - bless_namelists(test_name, baseline_dir_for_test, testcase_dir_for_test, report_only, force) + success, reason = bless_namelists(test_name, report_only, force, baseline_name, baseline_root) + if not success: + broken_blesses.append(test_name, reason) # Bless hist files if (not hist_no_bless): - success, reason = bless_history(test_name, baseline_tag, baseline_dir_for_test, testcase_dir_for_test, report_only, force) + success, reason = bless_history(test_name, test_dir, baseline_name, baseline_root, report_only, force) if (not success): broken_blesses.append((test_name, reason)) # Make sure user knows that some tests were not blessed + success = True for broken_bless, reason in broken_blesses: logging.warning("FAILED TO BLESS TEST: %s, reason %s" % (broken_bless, reason)) + success = False + + return success diff --git a/utils/python/CIME/buildnml.py b/utils/python/CIME/buildnml.py index 80ad886d9a76..34fabbde2c70 100644 --- a/utils/python/CIME/buildnml.py +++ b/utils/python/CIME/buildnml.py @@ -154,7 +154,9 @@ def _build_data_nml(case, caseroot, compclass): rc, out, err = run_cmd(cmd, from_dir=confdir) expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) - + if out is not None and len(out) > 0: + logger.debug("cmd=%s"%cmd) + logger.info("out = %s"%out) # copy namelist files and stream text files, to rundir if os.path.isdir(rundir): filename = compname + "_in" diff --git a/utils/python/CIME/case.py b/utils/python/CIME/case.py index 1387b62c9d24..cedf850bdde7 100644 --- a/utils/python/CIME/case.py +++ b/utils/python/CIME/case.py @@ -10,6 +10,7 @@ from CIME.utils import expect, get_cime_root, append_status from CIME.utils import convert_to_type, get_model, get_project +from CIME.XML.build import Build from CIME.XML.machines import Machines from CIME.XML.pes import Pes from CIME.XML.files import Files @@ -30,7 +31,6 @@ from CIME.user_mod_support import apply_user_mods from CIME.case_setup import case_setup -from CIME.macros import MacroMaker logger = logging.getLogger(__name__) @@ -80,10 +80,9 @@ def __init__(self, case_root=None, read_only=True): # for xml files that haven't been created yet. We need a place # to store them until we are ready to create the file. At file # creation we get the values for those fields from this lookup - # table and then remove the entry. This was what I came up - # with in the perl anyway and I think that we still need it here. + # table and then remove the entry. self.lookups = {} - self.lookups['CIMEROOT'] = os.path.abspath(get_cime_root()) + self.set_lookup_value('CIMEROOT',os.path.abspath(get_cime_root())) self._compsetname = None self._gridname = None @@ -91,7 +90,6 @@ def __init__(self, case_root=None, read_only=True): self._pesfile = None self._gridfile = None self._components = [] - self._component_config_files = [] self._component_classes = [] # Define __enter__ and __exit__ so that we can use this as a context manager @@ -255,15 +253,26 @@ def get_resolved_value(self, item, recurse=0): recurse_limit = 10 if (num_unresolved > 0 and recurse < recurse_limit ): for env_file in self._env_entryid_files: - result = env_file.get_resolved_value(item) - item = result + item = env_file.get_resolved_value(item) if ("$" not in item): return item else: - self.get_resolved_value(item,recurse=recurse+1) + item = self.get_resolved_value(item,recurse=recurse+1) - if(recurse >= recurse_limit): + if recurse >= 2*recurse_limit: logging.warning("Not able to fully resolve item '%s'" % item) + elif recurse >= recurse_limit: + #try env_batch first + env_batch = self.get_env("batch") + item = env_batch.get_resolved_value(item) + logger.debug("item is %s, checking env_batch"%item) + if item is not None: + if ("$" not in item): + return item + else: + item = self.get_resolved_value(item,recurse=recurse+1) + else: + logging.warning("Not able to fully resolve item '%s'" % item) return item @@ -286,11 +295,12 @@ def set_value(self, item, value, subgroup=None, ignore_type=False): logger.debug("Will rewrite file %s %s",env_file.filename, item) self._env_files_that_need_rewrite.add(env_file) return result - if result is None: - if item in self.lookups.keys() and self.lookups[item] is not None: - logger.warn("Item %s already in lookups with value %s"%(item,self.lookups[item])) - else: - self.lookups[item] = value + + def set_lookup_value(self, item, value): + if item in self.lookups.keys() and self.lookups[item] is not None: + logger.warn("Item %s already in lookups with value %s"%(item,self.lookups[item])) + else: + self.lookups[item] = value def _set_compset_and_pesfile(self, compset_name, user_compset=False, pesfile=None): @@ -384,6 +394,10 @@ def _get_component_config_data(self): # Determine list of component classes that this coupler/driver knows how # to deal with. This list follows the same order as compset longnames follow. files = Files() + # Add the group and elements for the config_files.xml + for env_file in self._env_entryid_files: + env_file.add_elements_by_group(files, attlist) + drv_config_file = files.get_value("CONFIG_DRV_FILE") drv_comp = Component(drv_config_file) for env_file in self._env_entryid_files: @@ -399,16 +413,15 @@ def _get_component_config_data(self): comp_class = self._component_classes[i] comp_name = self._components[i-1] node_name = 'CONFIG_' + comp_class + '_FILE' - comp_config_file = files.get_value(node_name, {"component":comp_name}, resolved=True) + # Add the group and elements for the config_files.xml + comp_config_file = files.get_value(node_name, {"component":comp_name}, resolved=False) + self.set_value(node_name, comp_config_file) + comp_config_file = self.get_resolved_value(comp_config_file) expect(comp_config_file is not None,"No config file for component %s"%comp_name) compobj = Component(comp_config_file) for env_file in self._env_entryid_files: env_file.add_elements_by_group(compobj, attributes=attlist) - self._component_config_files.append((node_name,comp_config_file)) - # Add the group and elements for the config_files.xml - for env_file in self._env_entryid_files: - env_file.add_elements_by_group(files, attlist) for key,value in self.lookups.items(): result = self.set_value(key,value) @@ -462,10 +475,11 @@ def configure(self, compset_name, grid_name, machine_name=None, grids = Grids(gridfile) gridinfo = grids.get_grid_info(name=grid_name, compset=self._compsetname) + self._gridname = gridinfo["GRID"] for key,value in gridinfo.items(): logger.debug("Set grid %s %s"%(key,value)) - self.set_value(key,value) + self.set_lookup_value(key,value) #-------------------------------------------- # component config data @@ -474,10 +488,6 @@ def configure(self, compset_name, grid_name, machine_name=None, self.get_compset_var_settings() - # Add the group and elements for the config_files.xml - for config_file in self._component_config_files: - self.set_value(config_file[0],config_file[1]) - #-------------------------------------------- # machine #-------------------------------------------- @@ -491,9 +501,10 @@ def configure(self, compset_name, grid_name, machine_name=None, 'COMPILER' not in x and 'MPILIB' not in x] for nodename in nodenames: - value = machobj.get_value(nodename) + value = machobj.get_value(nodename, resolved=False) type_str = self.get_type_info(nodename) if type_str is not None: + logger.debug("machine nodname %s value %s"%(nodename, value)) self.set_value(nodename, convert_to_type(value, type_str, nodename)) if compiler is None: @@ -514,25 +525,9 @@ def configure(self, compset_name, grid_name, machine_name=None, machdir = machobj.get_machines_dir() self.set_value("MACHDIR", machdir) - # Overwriting an existing exeroot or rundir can cause problems - exeroot = self.get_value("EXEROOT") - rundir = self.get_value("RUNDIR") - for wdir in (exeroot, rundir): - if os.path.exists(wdir): - expect(not test, "Directory %s already exists, aborting test"% wdir) - response = raw_input("\nDirectory %s already exists, (r)eplace, (a)bort, or (u)se existing?"% wdir) - if response.startswith("r"): - shutil.rmtree(wdir) - else: - expect(response.startswith("u"), "Aborting by user request") - - # the following go into the env_mach_specific file - items = ("module_system", "environment_variables", "mpirun") + # Create env_mach_specific settings from machine info. env_mach_specific_obj = self.get_env("mach_specific") - for item in items: - nodes = machobj.get_first_child_nodes(item) - for node in nodes: - env_mach_specific_obj.add_child(node) + env_mach_specific_obj.populate(machobj) self.schedule_rewrite(env_mach_specific_obj) #-------------------------------------------- @@ -550,6 +545,7 @@ def configure(self, compset_name, grid_name, machine_name=None, opti_tasks = match2.group(1) opti_thrds = 1 + other = {} if match1 or match2: for component_class in self._component_classes: if component_class == "DRV": @@ -563,7 +559,7 @@ def configure(self, compset_name, grid_name, machine_name=None, else: pesobj = Pes(self._pesfile) - pes_ntasks, pes_nthrds, pes_rootpe = pesobj.find_pes_layout(self._gridname, self._compsetname, + pes_ntasks, pes_nthrds, pes_rootpe, other = pesobj.find_pes_layout(self._gridname, self._compsetname, machine_name, pesize_opts=pecount) mach_pes_obj = self.get_env("mach_pes") @@ -577,6 +573,9 @@ def configure(self, compset_name, grid_name, machine_name=None, for key, value in pes_nthrds.items(): totaltasks[key[-3:]] *= int(value) mach_pes_obj.set_value(key,int(value)) + for key, value in other.items(): + self.set_value(key, value) + maxval = 1 pes_per_node = mach_pes_obj.get_value("PES_PER_NODE") for key, val in totaltasks.items(): @@ -624,10 +623,6 @@ def configure(self, compset_name, grid_name, machine_name=None, logger.info(" Grid is: %s " %self._gridname ) logger.info(" Components in compset are: %s " %self._components) - # miscellaneous settings - if self.get_value("RUN_TYPE") == 'hybrid': - self.set_value("GET_REFCASE", True) - # Set project id if project is None: project = get_project(machobj) @@ -636,6 +631,23 @@ def configure(self, compset_name, grid_name, machine_name=None, elif machobj.get_value("PROJECT_REQUIRED"): expect(project is not None, "PROJECT_REQUIRED is true but no project found") + # Overwriting an existing exeroot or rundir can cause problems + exeroot = self.get_value("EXEROOT") + rundir = self.get_value("RUNDIR") + for wdir in (exeroot, rundir): + logging.debug("wdir is %s"%wdir) + if os.path.exists(wdir): + expect(not test, "Directory %s already exists, aborting test"% wdir) + response = raw_input("\nDirectory %s already exists, (r)eplace, (a)bort, or (u)se existing?"% wdir) + if response.startswith("r"): + shutil.rmtree(wdir) + else: + expect(response.startswith("u"), "Aborting by user request") + + # miscellaneous settings + if self.get_value("RUN_TYPE") == 'hybrid': + self.set_value("GET_REFCASE", True) + def get_compset_var_settings(self): compset_obj = Compsets(infile=self.get_value("COMPSETS_SPEC_FILE")) matches = compset_obj.get_compset_var_settings(self._compsetname, self._gridname) @@ -702,13 +714,16 @@ def _create_caseroot_tools(self): # Create Macros file. machine = self.get_value("MACH") - if os.getenv("CIME_USE_CONFIG_BUILD") == "TRUE": - os_ = self.get_value("OS") - files = Files() + files = Files() + # Use config_build if the environment variable is set, or if there is no + # config_compilers file. + if os.getenv("CIME_USE_CONFIG_BUILD") == "TRUE" or \ + files.get_value("COMPILERS_SPEC_FILE") is None: build_file = files.get_value("BUILD_SPEC_FILE") machobj = Machines(machine=machine, files=files) - macro_maker = MacroMaker(os_, machobj) - with open(os.path.join(self._caseroot, "Macros"), "w") as macros_file: + macro_maker = Build(machobj) + macros_path = os.path.join(self._caseroot, "Macros") + with open(macros_path, "w") as macros_file: macro_maker.write_macros('Makefile', build_file, macros_file) # Copy any system or compiler Depends files to the case. @@ -830,11 +845,13 @@ def create_clone(self, newcase, keepexe=False, mach_dir=None, project=None): if newcase_cimeroot != clone_cimeroot: logger.warning(" case CIMEROOT is %s " %newcase_cimeroot) logger.warning(" clone CIMEROOT is %s " %clone_cimeroot) - logger.warning(" It is NOT recommended to clone cases from different versions of CIMEROOT") + logger.warning(" It is NOT recommended to clone cases from different versions of CIME.") + # *** create case object as deepcopy of clone object *** srcroot = os.path.join(newcase_cimeroot,"..") newcase = self.copy(newcasename, newcaseroot, newsrcroot=srcroot) + newcase.set_value("CIMEROOT", newcase_cimeroot) # determine if will use clone executable or not if keepexe: diff --git a/utils/python/CIME/case_setup.py b/utils/python/CIME/case_setup.py index 4e7816186239..4713e70c6061 100644 --- a/utils/python/CIME/case_setup.py +++ b/utils/python/CIME/case_setup.py @@ -295,12 +295,15 @@ def _case_setup_impl(case, caseroot, casebaseid, clean=False, test_mode=False, r def case_setup(case, clean=False, test_mode=False, reset=False): ############################################################################### caseroot, casebaseid = case.get_value("CASEROOT"), case.get_value("CASEBASEID") - test_name = casebaseid if casebaseid is not None else case.get_value("CASE") - with TestStatus(test_dir=caseroot, test_name=test_name) as ts: - try: - _case_setup_impl(case, caseroot, casebaseid, clean=clean, test_mode=test_mode, reset=reset) - except: - ts.set_status(SETUP_PHASE, TEST_FAIL_STATUS) - raise - else: - ts.set_status(SETUP_PHASE, TEST_PASS_STATUS) + if case.get_value("TEST"): + test_name = casebaseid if casebaseid is not None else case.get_value("CASE") + with TestStatus(test_dir=caseroot, test_name=test_name) as ts: + try: + _case_setup_impl(case, caseroot, casebaseid, clean=clean, test_mode=test_mode, reset=reset) + except: + ts.set_status(SETUP_PHASE, TEST_FAIL_STATUS) + raise + else: + ts.set_status(SETUP_PHASE, TEST_PASS_STATUS) + else: + _case_setup_impl(case, caseroot, casebaseid, clean=clean, test_mode=test_mode, reset=reset) diff --git a/utils/python/CIME/case_test.py b/utils/python/CIME/case_test.py index 0175202f6cda..673bf961d766 100644 --- a/utils/python/CIME/case_test.py +++ b/utils/python/CIME/case_test.py @@ -3,9 +3,11 @@ """ from CIME.XML.standard_module_setup import * -from CIME.utils import expect, find_system_test +from CIME.utils import expect, find_system_test, append_status from CIME.SystemTests.system_tests_common import * +import sys + def case_test(case, testname=None): if testname is None: testname = case.get_value('TESTCASE') @@ -13,7 +15,19 @@ def case_test(case, testname=None): expect(testname is not None, "testname argument not resolved") logging.warn("Running test for %s" % testname) - test = find_system_test(testname, case)(case) + try: + # The following line can throw exceptions if the testname is + # not found or the test constructor throws. We need to be + # sure to leave TestStatus in the appropriate state if that + # happens. + test = find_system_test(testname, case)(case) + except: + caseroot = case.get_value("CASEROOT") + with TestStatus(test_dir=caseroot) as ts: + ts.set_status(RUN_PHASE, TEST_FAIL_STATUS, comments="failed to initialize") + append_status(sys.exc_info()[1], sfile="TestStatus.log") + raise + success = test.run() return success diff --git a/utils/python/CIME/check_lockedfiles.py b/utils/python/CIME/check_lockedfiles.py index 5beee69dd47c..ce8898ad144d 100644 --- a/utils/python/CIME/check_lockedfiles.py +++ b/utils/python/CIME/check_lockedfiles.py @@ -9,10 +9,13 @@ import glob -def check_lockedfiles(caseroot=os.getcwd()): +def check_lockedfiles(caseroot=None): """ Check that all lockedfiles match what's in case + + If caseroot is not specified, it is set to the current working directory """ + caseroot = os.getcwd() if caseroot is None else caseroot lockedfiles = glob.glob(os.path.join(caseroot, "LockedFiles", "*.xml")) for lfile in lockedfiles: fpart = os.path.basename(lfile) @@ -37,7 +40,7 @@ def check_lockedfiles(caseroot=os.getcwd()): print(" found difference in %s : case %s locked %s" % (key, repr(diffs[key][0]), repr(diffs[key][1]))) if objname == "env_mach_pes": - expect(False, "Invoke case.setup --clean followed by case.setup") + expect(False, "Invoke case.setup --reset ") elif objname == "env_case": expect(False, "Cannot change file env_case.xml, please" " recover the original copy from LockedFiles") diff --git a/utils/python/CIME/compare_namelists.py b/utils/python/CIME/compare_namelists.py index 6e4dbb6d0eb3..8e27e5360db2 100644 --- a/utils/python/CIME/compare_namelists.py +++ b/utils/python/CIME/compare_namelists.py @@ -88,7 +88,7 @@ def parse_namelists(namelist_lines, filename): expect(multiline_variable is None, "In file '%s', Incomplete multiline variable: '%s'" % (filename, multiline_variable[0] if multiline_variable is not None else "")) - # Unfornately, other tools were using the old compare_namelists.pl script + # Unfortunately, other tools were using the old compare_namelists.pl script # to compare files that are not namelist files. We need a special error # to signify this event if (namelist_re.match(line) is None): @@ -192,7 +192,7 @@ def normalize_string_value(name, value, case): """ # Any occurance of case must be normalized because test-ids might not match if (case is not None): - case_re = re.compile(r'%s[.]([GC])[.]([^./\s]+)' % case) + case_re = re.compile(r'%s[.]([GC]+)[.]([^./\s]+)' % case) value = case_re.sub("%s.ACTION.TESTID" % case, value) if (name in ["runid", "model_version", "username"]): diff --git a/utils/python/CIME/compare_test_results.py b/utils/python/CIME/compare_test_results.py new file mode 100644 index 000000000000..5c49a9e90ebb --- /dev/null +++ b/utils/python/CIME/compare_test_results.py @@ -0,0 +1,70 @@ +import CIME.compare_namelists, CIME.simple_compare +from CIME.utils import expect +from CIME.test_status import * +from CIME.hist_utils import compare_baseline +from CIME.case import Case + +import os, glob + +############################################################################### +def compare_history(testcase_dir_for_test, baseline_name, baseline_root): +############################################################################### + with Case(testcase_dir_for_test) as case: + baseline_full_dir = os.path.join(baseline_root, baseline_name, case.get_value("CASEBASEID")) + result, comments = compare_baseline(case, baseline_dir=baseline_full_dir) + if result: + return True, None + else: + logging.info(comments) + return False, "Diff'd" + +############################################################################### +def compare_test_results(baseline_name, baseline_root, test_root, compiler, test_id=None, compare_tests=None): +############################################################################### + test_id_glob = "*%s*%s*" % (compiler, baseline_name) if test_id is None else "*%s" % test_id + test_status_files = glob.glob("%s/%s/%s" % (test_root, test_id_glob, TEST_STATUS_FILENAME)) + expect(test_status_files, "No matching test cases found in for %s/%s/%s" % (test_root, test_id_glob, TEST_STATUS_FILENAME)) + + broken_compares = [] + for test_status_file in test_status_files: + test_dir = os.path.dirname(test_status_file) + ts = TestStatus(test_dir=test_dir) + test_name = ts.get_name() + if (compare_tests in [[], None] or CIME.utils.match_any(test_name, compare_tests)): + overall_result = ts.get_overall_test_status() + + # Compute hist status, False implies it diffed + run_result = ts.get_status(RUN_PHASE) + if (run_result is None): + broken_compares.append((test_name, "no run phase")) + logging.warning("Test '%s' did not make it to run phase" % test_name) + hist_no_compare = True + elif (run_result != TEST_PASS_STATUS): + broken_compares.append((test_name, "test did not pass")) + logging.warning("Test '%s' did not pass, not safe to compare" % test_name) + hist_no_compare = True + else: + hist_no_compare = False + + # Now, do the compare + if hist_no_compare: + logging.info("Cannot compare test: %s, overall status: %s" % (test_name, overall_result)) + else: + + logging.info("###############################################################################") + logging.info("Comparing results for test: %s, most recent result: %s" % (test_name, overall_result)) + logging.info("###############################################################################") + + # Compare hist files + if (not hist_no_compare): + success, reason = compare_history(test_dir, baseline_name, baseline_root) + if (not success): + broken_compares.append((test_name, reason)) + + # Make sure user knows that some tests were not compareed + success = True + for broken_compare, reason in broken_compares: + logging.warning("COMPARE FAILED FOR TEST: %s, reason %s" % (broken_compare, reason)) + success = False + + return success diff --git a/utils/python/CIME/hist_utils.py b/utils/python/CIME/hist_utils.py new file mode 100644 index 000000000000..395af87fa952 --- /dev/null +++ b/utils/python/CIME/hist_utils.py @@ -0,0 +1,290 @@ +""" +Functions for actions pertaining to history files. +""" + +from CIME.XML.standard_module_setup import * + +import logging, glob, os, shutil, re +logger = logging.getLogger(__name__) + +def _iter_model_file_substrs(case): + models = case.get_compset_components() + models.append('cpl') + for model in models: + yield model + +def _get_all_hist_files(testcase, model, from_dir, suffix=""): + suffix = (".%s" % suffix) if suffix else "" + + # Match hist files produced by run + test_hists = glob.glob("%s/%s.%s*.h?.nc%s" % (from_dir, testcase, model, suffix)) + test_hists.extend(glob.glob("%s/%s.%s*.h.nc%s" % (from_dir, testcase, model, suffix))) + + # Match multi-instance files produced by run + test_hists.extend(glob.glob("%s/%s.%s*.h?.*.nc%s" % (from_dir, testcase, model, suffix))) + test_hists.extend(glob.glob("%s/%s.%s*.h.*.nc%s" % (from_dir, testcase, model, suffix))) + + # suffix == "" implies baseline comparison, baseline hist files have simpler names + if suffix == "": + test_hists.extend(glob.glob("%s/%s.h.nc" % (from_dir, model))) + test_hists.extend(glob.glob("%s/%s.h?.nc" % (from_dir, model))) + test_hists.extend(glob.glob("%s/%s.h.*.nc" % (from_dir, model))) + test_hists.extend(glob.glob("%s/%s.h?.*.nc" % (from_dir, model))) + + test_hists.sort() + return test_hists + +def _get_latest_hist_files(testcase, model, from_dir, suffix=""): + test_hists = _get_all_hist_files(testcase, model, from_dir, suffix) + latest_files = {} + histlist = [] + date_match = re.compile(r"(\d\d\d\d)-(\d\d)-(\d\d)-(\d\d\d\d\d).nc") + for hist in test_hists: + ext = get_extension(model, hist) + if ext in latest_files: + s1 = date_match.search(hist) + if s1 is None: + latest_files[ext] = hist + continue + (yr,month,day,time) = s1.group(1,2,3,4) + s2 = date_match.search(latest_files[ext]) + (pyr,pmonth,pday,ptime) = s2.group(1,2,3,4) + if yr > pyr or (yr == pyr and month > pmonth) or \ + (yr == pyr and month == pmonth and day > pday) or \ + (yr == pyr and month == pmonth and day == pday and time > ptime): + latest_files[ext] = hist + logger.debug("ext %s hist %s %s"%(ext,hist,latest_files)) + else: + latest_files[ext] = hist + + for key in latest_files.keys(): + histlist.append(latest_files[key]) + return histlist + + +def move(case, suffix): + """ + Change the suffix for the most recent batch of hist files in a case. This can + allow you to temporarily "save" these files so they won't be blown away if you + re-run the case. + + case - The case containing the files you want to save + suffix - The string suffix you want to add to saved files, this can be used to find them later. + """ + rundir = case.get_value("RUNDIR") + testcase = case.get_value("CASE") + + # Loop over models + comments = "Moving hist files to suffix '%s'\n" % suffix + num_moved = 0 + for model in _iter_model_file_substrs(case): + comments += " Moving hist files for model '%s'\n" % model + test_hists = _get_latest_hist_files(testcase, model, rundir) + num_moved += len(test_hists) + for test_hist in test_hists: + new_file = "%s.%s" % (test_hist, suffix) + if os.path.exists(new_file): + os.remove(new_file) + + comments += " Copying '%s' to '%s'\n" % (test_hist, new_file) + shutil.copy(test_hist, new_file) + + expect(num_moved > 0, "move failed: no hist files found in rundir '%s'" % rundir) + + return comments + +def _hists_match(model, hists1, hists2, suffix1="", suffix2=""): + """ + return (num in set 1 but not 2 , num in set 2 but not 1, matchups) + + >>> hists1 = ['FOO.G.cpl.h1.nc', 'FOO.G.cpl.h2.nc', 'FOO.G.cpl.h3.nc'] + >>> hists2 = ['cpl.h2.nc', 'cpl.h3.nc', 'cpl.h4.nc'] + >>> _hists_match('cpl', hists1, hists2) + (['FOO.G.cpl.h1.nc'], ['cpl.h4.nc'], [('FOO.G.cpl.h2.nc', 'cpl.h2.nc'), ('FOO.G.cpl.h3.nc', 'cpl.h3.nc')]) + >>> hists1 = ['FOO.G.cpl.h1.nc.SUF1', 'FOO.G.cpl.h2.nc.SUF1', 'FOO.G.cpl.h3.nc.SUF1'] + >>> hists2 = ['cpl.h2.nc.SUF2', 'cpl.h3.nc.SUF2', 'cpl.h4.nc.SUF2'] + >>> _hists_match('cpl', hists1, hists2, 'SUF1', 'SUF2') + (['FOO.G.cpl.h1.nc.SUF1'], ['cpl.h4.nc.SUF2'], [('FOO.G.cpl.h2.nc.SUF1', 'cpl.h2.nc.SUF2'), ('FOO.G.cpl.h3.nc.SUF1', 'cpl.h3.nc.SUF2')]) + """ + normalized1, normalized2 = [], [] + for hists, suffix, normalized in [(hists1, suffix1, normalized1), (hists2, suffix2, normalized2)]: + for hist in hists: + normalized_name = hist[hist.rfind(model):] + if suffix1 != "": + expect(normalized_name.endswith(suffix), "How did '%s' hot have suffix '%s'" % (hist, suffix)) + normalized_name = normalized_name[:len(normalized_name) - len(suffix)] + + normalized.append(normalized_name) + + set_of_1_not_2 = set(normalized1) - set(normalized2) + set_of_2_not_1 = set(normalized2) - set(normalized1) + + one_not_two = sorted([hists1[normalized1.index(item)] for item in set_of_1_not_2]) + two_not_one = sorted([hists2[normalized2.index(item)] for item in set_of_2_not_1]) + + both = set(normalized1) & set(normalized2) + match_ups = sorted([ (hists1[normalized1.index(item)], hists2[normalized2.index(item)]) for item in both]) + expect(len(match_ups) + len(set_of_1_not_2) == len(hists1), "Programming error1") + expect(len(match_ups) + len(set_of_2_not_1) == len(hists2), "Programming error2") + + return one_not_two, two_not_one, match_ups + +def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2=""): + if from_dir1 == from_dir2: + expect(suffix1 != suffix2, "Comparing files to themselves?") + + testcase = case.get_value("CASE") + all_success = True + num_compared = 0 + comments = "Comparing hists for case '%s' dir1='%s', suffix1='%s', dir2='%s' suffix2='%s'\n" % \ + (testcase, from_dir1, suffix1, from_dir2, suffix2) + + for model in _iter_model_file_substrs(case): + comments += " comparing model '%s'\n" % model + hists1 = _get_latest_hist_files(testcase, model, from_dir1, suffix1) + hists2 = _get_latest_hist_files(testcase, model, from_dir2, suffix2) + + if len(hists1) == 0 and len(hists2) == 0: + comments += " no hist files found for model %s\n" % model + continue + + one_not_two, two_not_one, match_ups = _hists_match(model, hists1, hists2, suffix1, suffix2) + for item in one_not_two: + comments += " File '%s' had no counterpart in '%s' with suffix '%s'\n" % (item, from_dir2, suffix2) + all_success = False + for item in two_not_one: + comments += " File '%s' had no counterpart in '%s' with suffix '%s'\n" % (item, from_dir1, suffix1) + all_success = False + + num_compared += len(match_ups) + for hist1, hist2 in match_ups: + success, cprnc_comments = cprnc(hist1, hist2, case, from_dir1) + if success: + comments += " %s matched %s\n" % (hist1, hist2) + else: + comments += " %s did NOT match %s\n" % (hist1, hist2) + comments += cprnc_comments + "\n" + all_success = False + + expect(num_compared > 0, "Did not compare any hist files for suffix1='%s' suffix2='%s', dir1='%s', dir2='%s'\nComments=%s" % + (suffix1, suffix2, from_dir1, from_dir2, comments)) + return all_success, comments + +def compare_test(case, suffix1, suffix2): + """ + Compares two sets of component history files in the testcase directory + + case - The case containing the hist files to compare + suffix1 - The suffix that identifies the first batch of hist files + suffix1 - The suffix that identifies the second batch of hist files + + returns (SUCCESS, comments) + """ + rundir = case.get_value("RUNDIR") + + return _compare_hists(case, rundir, rundir, suffix1, suffix2) + +def cprnc(file1, file2, case, rundir): + """ + Run cprnc to compare two individual nc files + + file1 - the full or relative path of the first file + file2 - the full or relative path of the second file + case - the case containing the files + rundir - the rundir for the case + + returns True if the files matched + """ + cprnc_exe = case.get_value("CCSM_CPRNC") + basename = os.path.basename(file1) + stat, out, _ = run_cmd("%s -m %s %s 2>&1 | tee %s/%s.cprnc.out" % (cprnc_exe, file1, file2, rundir, basename)) + return (stat == 0 and "files seem to be IDENTICAL" in out, out) + +def compare_baseline(case, baseline_dir=None): + """ + compare the current test output to a baseline result + + case - The case containing the hist files to be compared against baselines + baseline_dir - Optionally, specify a specific baseline dir, otherwise it will be computed from case config + + returns (SUCCESS, comments) + SUCCESS means all hist files matched their corresponding baseline + """ + rundir = case.get_value("RUNDIR") + if baseline_dir is None: + baselineroot = case.get_value("BASELINE_ROOT") + basecmp_dir = os.path.join(baselineroot, case.get_value("BASECMP_CASE")) + dirs_to_check = (baselineroot, basecmp_dir) + else: + basecmp_dir = baseline_dir + dirs_to_check = (basecmp_dir,) + + for bdir in dirs_to_check: + if not os.path.isdir(bdir): + return False, "ERROR baseline directory '%s' does not exist" % bdir + + return _compare_hists(case, rundir, basecmp_dir) + +def get_extension(model, filepath): + """ + For a hist file for the given model, return what we call the "extension" + + model - The component model + filepath - The path of the hist file + + >>> get_extension("cpl", "cpl.hi.nc") + 'hi' + >>> get_extension("cpl", "cpl.h.nc") + 'h' + >>> get_extension("cpl", "cpl.h1.nc") + 'h1' + >>> get_extension("cpl", "TESTRUNDIFF_Mmpi-serial.f19_g16_rx1.A.melvin_gnu.C.fake_testing_only_20160816_164150-20160816_164240.cpl.hi.0.nc.base") + 'hi' + >>> get_extension("cpl", "TESTRUNDIFF_Mmpi-serial.f19_g16_rx1.A.melvin_gnu.C.fake_testing_only_20160816_164150-20160816_164240.cpl.h.nc") + 'h' + """ + basename = os.path.basename(filepath) + ext_regex = re.compile(r'.*%s.*[.](h.?)([.][^.]+)?[.]nc' % model) + m = ext_regex.match(basename) + expect(m is not None, "Failed to get extension for file '%s'" % filepath) + return m.groups()[0] + +def generate_baseline(case, baseline_dir=None): + """ + copy the current test output to baseline result + + case - The case containing the hist files to be copied into baselines + baseline_dir - Optionally, specify a specific baseline dir, otherwise it will be computed from case config + + returns (SUCCESS, comments) + """ + rundir = case.get_value("RUNDIR") + if baseline_dir is None: + baselineroot = case.get_value("BASELINE_ROOT") + basegen_dir = os.path.join(baselineroot, case.get_value("BASEGEN_CASE")) + else: + basegen_dir = baseline_dir + testcase = case.get_value("CASE") + + if not os.path.isdir(basegen_dir): + os.makedirs(basegen_dir) + + comments = "Generating baselines into '%s'\n" % basegen_dir + num_gen = 0 + for model in _iter_model_file_substrs(case): + comments += " generating for model '%s'\n" % model + hists = _get_latest_hist_files(testcase, model, rundir) + logger.debug("latest_files: %s" % hists) + num_gen += len(hists) + for hist in hists: + basename = hist[hist.rfind(model):] + baseline = os.path.join(basegen_dir, basename) + if os.path.exists(baseline): + os.remove(baseline) + + shutil.copy(hist, baseline) + comments += " generating baseline '%s' from file %s\n" % (baseline, hist) + + expect(num_gen > 0, "Could not generate any hist files for case '%s', something is seriously wrong" % testcase) + + return True, comments diff --git a/utils/python/CIME/preview_namelists.py b/utils/python/CIME/preview_namelists.py index e5d981aa5572..236afe70c0c1 100644 --- a/utils/python/CIME/preview_namelists.py +++ b/utils/python/CIME/preview_namelists.py @@ -71,11 +71,12 @@ def preview_namelists(case, dryrun=False): logger.info("Running %s:"%cmd) if (logger.level == logging.DEBUG): rc, out, err = run_cmd("PREVIEW_NML=1 %s %s" % (cmd, caseroot)) - expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) + expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) else: rc, out, err = run_cmd("%s %s" % (cmd, caseroot)) expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) - logger.info(" %s"%out) + if out is not None: + logger.info(" %s"%out) # refresh case xml object from file case.read_xml() # Save namelists to docdir diff --git a/utils/python/CIME/test_scheduler.py b/utils/python/CIME/test_scheduler.py index cbce98231954..ca75cd852f14 100644 --- a/utils/python/CIME/test_scheduler.py +++ b/utils/python/CIME/test_scheduler.py @@ -14,7 +14,6 @@ import CIME.utils from CIME.utils import append_status from CIME.test_status import * -import update_acme_tests from CIME.XML.machines import Machines from CIME.XML.env_test import EnvTest from CIME.XML.files import Files @@ -35,33 +34,27 @@ class TestScheduler(object): ############################################################################### ########################################################################### - def __init__(self, test_names, + def __init__(self, test_names, test_data=None, no_run=False, no_build=False, no_setup=False, no_batch=None, test_root=None, test_id=None, machine_name=None, compiler=None, - baseline_root=None, baseline_name=None, - clean=False, compare=False, generate=False, namelists_only=False, + baseline_root=None, baseline_cmp_name=None, baseline_gen_name=None, + clean=False, namelists_only=False, project=None, parallel_jobs=None, - xml_machine=None, xml_compiler=None, xml_category=None, - xml_testlist=None, walltime=None, proc_pool=None, - use_existing=False, save_timing=False, queue=None): + walltime=None, proc_pool=None, + use_existing=False, save_timing=False, queue=None, allow_baseline_overwrite=False): ########################################################################### self._cime_root = CIME.utils.get_cime_root() self._cime_model = CIME.utils.get_model() self._save_timing = save_timing self._queue = queue + self._test_data = {} if test_data is None else test_data # Format: {test_name -> {data_name -> data}} # needed for perl interface os.environ["CIMEROOT"] = self._cime_root - # if machine_name is set use it, otherwise if xml_machine is set use it, - # otherwise probe for machine_name - if machine_name is None: - machine_name = xml_machine - self._machobj = Machines(machine=machine_name) - machine_name = self._machobj.get_machine_name() self._no_setup = no_setup self._no_build = no_build or no_setup or namelists_only @@ -81,50 +74,19 @@ def __init__(self, test_names, expect(not (self._no_batch and self._queue is not None), "Does not make sense to request a queue without batch system") - self._test_root = test_root if test_root is not None \ - else self._machobj.get_value("CESMSCRATCHROOT") - + # Determine and resolve test_root + self._test_root = self._machobj.get_value("CESMSCRATCHROOT") if test_root is None else test_root if self._project is not None: self._test_root = self._test_root.replace("$PROJECT", self._project) self._test_root = os.path.abspath(self._test_root) self._test_id = test_id if test_id is not None else CIME.utils.get_utc_timestamp() - # if compiler is set use it, otherwise if xml_compiler is set use it, - # otherwise use the default compiler for the machine - if compiler is not None: - self._compiler = compiler - elif xml_compiler is not None: - self._compiler = xml_compiler - else: - self._compiler = self._machobj.get_default_compiler() - - expect(self._machobj.is_valid_compiler(self._compiler), - "Compiler %s not valid for machine %s" % (self._compiler, machine_name)) + self._compiler = self._machobj.get_default_compiler() if compiler is None else compiler self._clean = clean self._namelists_only = namelists_only - # Extra data associated with tests, do not modify after construction - # test_name -> test_data - # test_data: name -> value - self._test_xml = {} - - # If xml options are provided get tests from xml file, otherwise use acme dictionary - if not test_names and (xml_machine is not None or xml_category is not None or - xml_compiler is not None or xml_testlist is not None): - test_data = CIME.test_utils.get_tests_from_xml(xml_machine, xml_category, - xml_compiler, xml_testlist, - machine_name, compiler) - test_names = [item["name"] for item in test_data] - logger.info("Testnames: %s"%test_names) - for test_datum in test_data: - self._test_xml[test_datum["name"]] = test_datum - else: - expect(len(test_names) > 0, "No tests to run") - test_names = update_acme_tests.get_full_test_names(test_names, - machine_name, self._compiler) - self._walltime = walltime if parallel_jobs is None: @@ -133,44 +95,10 @@ def __init__(self, test_names, else: self._parallel_jobs = parallel_jobs - self._baseline_cmp_name = None - self._baseline_gen_name = None - self._compare = False - self._generate = False - if compare or generate: - # Figure out what baseline name to use - if baseline_name is None: - if compare is not None and isinstance(compare, str): - self._baseline_cmp_name = compare - self._compare = True - if generate is not None and isinstance(generate, str): - self._baseline_gen_name = generate - self._generate = True - - if self._compare and self._baseline_cmp_name is None: - branch_name = CIME.utils.get_current_branch(repo=self._cime_root) - expect(branch_name is not None, - "Could not determine baseline name from branch, please use -b option") - self._baseline_cmp_name = os.path.join(self._compiler, branch_name) - if self._generate and self._baseline_gen_name is None: - branch_name = CIME.utils.get_current_branch(repo=self._cime_root) - expect(branch_name is not None, - "Could not determine baseline name from branch, please use -b option") - self._baseline_gen_name = os.path.join(self._compiler, branch_name) - else: - if compare: - self._compare = True - self._baseline_cmp_name = baseline_name - if not self._baseline_cmp_name.startswith("%s/" % self._compiler): # pylint: disable=maybe-no-member - self._baseline_cmp_name = os.path.join(self._compiler, - self._baseline_cmp_name) - if generate: - self._generate = True - self._baseline_gen_name = baseline_name - if not self._baseline_gen_name.startswith("%s/" % self._compiler): # pylint: disable=maybe-no-member - self._baseline_gen_name = os.path.join(self._compiler, - self._baseline_gen_name) + self._baseline_cmp_name = baseline_cmp_name # Implies comparison should be done if not None + self._baseline_gen_name = baseline_gen_name # Implies generation should be done if not None + if baseline_cmp_name or baseline_gen_name: # Compute baseline_root self._baseline_root = baseline_root if baseline_root is not None \ else self._machobj.get_value("CCSM_BASELINE") @@ -180,10 +108,17 @@ def __init__(self, test_names, self._baseline_root = os.path.abspath(self._baseline_root) - if self._compare: + if self._baseline_cmp_name: full_baseline_dir = os.path.join(self._baseline_root, self._baseline_cmp_name) expect(os.path.isdir(full_baseline_dir), "Missing baseline comparison directory %s" % full_baseline_dir) + + # the following is to assure that the existing generate directory is not overwritten + if self._baseline_gen_name and not allow_baseline_overwrite: + full_baseline_dir = os.path.join(self._baseline_root, self._baseline_gen_name) + expect(not os.path.isdir(full_baseline_dir), + "Refusing to overwrite existing baseline directory, use -o to force overwrite %s" % full_baseline_dir) + else: self._baseline_root = None @@ -215,7 +150,7 @@ def __init__(self, test_names, self._phases.remove(MODEL_BUILD_PHASE) if self._no_run: self._phases.remove(RUN_PHASE) - if not self._compare and not self._generate: + if not self._baseline_cmp_name and not self._baseline_gen_name: self._phases.remove(NAMELIST_PHASE) if use_existing: @@ -249,9 +184,9 @@ def _log_output(self, test, output): def _get_case_id(self, test): ########################################################################### baseline_action_code = "" - if self._generate: + if self._baseline_gen_name: baseline_action_code += "G" - if self._compare: + if self._baseline_cmp_name: baseline_action_code += "C" if len(baseline_action_code) > 0: return "%s.%s.%s" % (test, baseline_action_code, self._test_id) @@ -348,9 +283,12 @@ def _shell_cmd_for_phase(self, test, cmd, phase, from_dir=None): else: break else: - self._log_output(test, - "%s PASSED for test '%s'.\nCommand: %s\nOutput: %s\n\nErrput: %s" % - (phase, test, cmd, output, errput)) + # We don't want "RUN PASSED" in the TestStatus.log if the only thing that + # succeeded was the submission. + if phase != RUN_PHASE or self._no_batch: + self._log_output(test, + "%s PASSED for test '%s'.\nCommand: %s\nOutput: %s\n\nErrput: %s" % + (phase, test, cmd, output, errput)) break return rc == 0 @@ -400,8 +338,8 @@ def _create_newcase_phase(self, test): if self._walltime is not None: create_newcase_cmd += " --walltime %s" % self._walltime - elif test in self._test_xml and "wallclock" in self._test_xml[test]: - create_newcase_cmd += " --walltime %s" % self._test_xml[test]['wallclock'] + elif test in self._test_data and "wallclock" in self._test_data[test]: + create_newcase_cmd += " --walltime %s" % self._test_data[test]['wallclock'] logger.debug("Calling create_newcase: " + create_newcase_cmd) return self._shell_cmd_for_phase(test, create_newcase_cmd, CREATE_NEWCASE_PHASE) @@ -427,11 +365,13 @@ def _xml_phase(self, test): envtest.set_value("CASEBASEID", test) test_argv = "-testname %s -testroot %s" % (test, self._test_root) - if self._generate: + if self._baseline_gen_name: test_argv += " -generate %s" % self._baseline_gen_name + basegen_case_fullpath = os.path.join(self._baseline_root,self._baseline_gen_name, test) + logger.warn("basegen_case is %s"%basegen_case_fullpath) envtest.set_value("BASELINE_NAME_GEN", self._baseline_gen_name) envtest.set_value("BASEGEN_CASE", os.path.join(self._baseline_gen_name, test)) - if self._compare: + if self._baseline_cmp_name: test_argv += " -compare %s" % self._baseline_cmp_name envtest.set_value("BASELINE_NAME_CMP", self._baseline_cmp_name) envtest.set_value("BASECMP_CASE", os.path.join(self._baseline_cmp_name, test)) @@ -439,10 +379,10 @@ def _xml_phase(self, test): envtest.set_value("TEST_ARGV", test_argv) envtest.set_value("CLEANUP", self._clean) - if self._generate or self._compare: + if self._baseline_gen_name or self._baseline_cmp_name: envtest.set_value("BASELINE_ROOT", self._baseline_root) - envtest.set_value("GENERATE_BASELINE", self._generate) - envtest.set_value("COMPARE_BASELINE", self._compare) + envtest.set_value("GENERATE_BASELINE", self._baseline_gen_name is not None) + envtest.set_value("COMPARE_BASELINE", self._baseline_cmp_name is not None) envtest.set_value("CCSM_CPRNC", self._machobj.get_value("CCSM_CPRNC", resolved=False)) # Add the test instructions from config_test to env_test in the case @@ -533,7 +473,7 @@ def _nlcomp_phase(self, test): compare_nl = os.path.join(CIME.utils.get_scripts_root(), "Tools", "compare_namelists") simple_compare = os.path.join(CIME.utils.get_scripts_root(), "Tools", "simple_compare") - if self._compare: + if self._baseline_cmp_name: has_fails = False baseline_dir = os.path.join(self._baseline_root, self._baseline_cmp_name, test) baseline_casedocs = os.path.join(baseline_dir, "CaseDocs") @@ -568,7 +508,7 @@ def _nlcomp_phase(self, test): if has_fails: self._test_has_nl_problem(test) - if self._generate: + if self._baseline_gen_name: baseline_dir = os.path.join(self._baseline_root, self._baseline_gen_name, test) baseline_casedocs = os.path.join(baseline_dir, "CaseDocs") if not os.path.isdir(baseline_dir): diff --git a/utils/python/CIME/test_status.py b/utils/python/CIME/test_status.py index 7398ccf7b235..baf67e3717d7 100644 --- a/utils/python/CIME/test_status.py +++ b/utils/python/CIME/test_status.py @@ -62,7 +62,13 @@ def _test_helper2(file_contents, wait_for_run=False, check_throughput=False, che class TestStatus(object): - def __init__(self, test_dir=os.getcwd(), test_name=None): + def __init__(self, test_dir=None, test_name=None): + """ + Create a TestStatus object + + If test_dir is not specified, it is set to the current working directory + """ + test_dir = os.getcwd() if test_dir is None else test_dir self._filename = os.path.join(test_dir, TEST_STATUS_FILENAME) self._phase_statuses = OrderedDict() # {name -> (status, comments)} self._test_name = test_name diff --git a/utils/python/CIME/tests/README b/utils/python/CIME/tests/README new file mode 100644 index 000000000000..0af6c386d827 --- /dev/null +++ b/utils/python/CIME/tests/README @@ -0,0 +1,6 @@ +The directory structure of this tests directory mirrors the directory structure +of the parent (production code) directory. + +So, for example, unit tests for CIME/foo.py should live in +CIME/tests/test_foo.py, and unit tests for CIME/SystemTests/bar.py should live +in CIME/tests/SystemTests/test_bar.py. diff --git a/utils/python/CIME/tests/SystemTests/__init__.py b/utils/python/CIME/tests/SystemTests/__init__.py new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/utils/python/CIME/tests/SystemTests/test_system_tests_compare_two.py b/utils/python/CIME/tests/SystemTests/test_system_tests_compare_two.py new file mode 100644 index 000000000000..03b662fd20f1 --- /dev/null +++ b/utils/python/CIME/tests/SystemTests/test_system_tests_compare_two.py @@ -0,0 +1,392 @@ +#!/usr/bin/env python + +""" +This module contains unit tests of the core logic in SystemTestsCompareTwo. +""" + +# Ignore privacy concerns for unit tests, so that unit tests can access +# protected members of the system under test +# +# pylint:disable=protected-access + +import unittest +from collections import namedtuple +import os +import shutil +import tempfile + +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo +import CIME.test_status as test_status +from CIME.tests.case_fake import CaseFake + +# ======================================================================== +# Structure for storing information about calls made to methods +# ======================================================================== + +# You can create a Call object to record a single call made to a method: +# +# Call(method, arguments) +# method (str): name of method +# arguments (dict): dictionary mapping argument names to values +# +# Example: +# If you want to record a call to foo(bar = 1, baz = 2): +# somecall = Call(method = 'foo', arguments = {'bar': 1, 'baz': 2}) +# Or simply: +# somecall = Call('foo', {'bar': 1, 'baz': 2}) +Call = namedtuple('Call', ['method', 'arguments']) + +# ======================================================================== +# Names of methods for which we want to record calls +# ======================================================================== + +# We use constants for these method names because, in some cases, a typo in a +# hard-coded string could cause a test to always pass, which would be a Bad +# Thing. +# +# For now the names of the constants match the strings they equate to, which +# match the actual method names. But it's fine if this doesn't remain the case +# moving forward (which is another reason to use constants rather than +# hard-coded strings in the tests). + +METHOD_component_compare_test = "_component_compare_test" +METHOD_link_to_case2_output = "_link_to_case2_output" +METHOD_run_indv = "_run_indv" + +# ======================================================================== +# Fake version of SystemTestsCompareTwo that overrides some functionality for +# the sake of unit testing +# ======================================================================== + +# A SystemTestsCompareTwoFake object can be controlled to fail at a given +# point. See the documentation in its __init__ method for details. +# +# It logs what stubbed-out methods have been called in its log attribute; this +# is a list of Call objects (see above for their definition). + +class SystemTestsCompareTwoFake(SystemTestsCompareTwo): + def __init__(self, + case1, + run_one_suffix = 'base', + run_two_suffix = 'test', + case2setup_raises_exception = False, + run_one_should_pass = True, + run_two_should_pass = True): + """ + Initialize a SystemTestsCompareTwoFake object + + Args: + case1 (CaseFake): existing case + run_one_suffix (str, optional): Suffix used for first run. Defaults + to 'base'. Currently MUST be 'base'. + run_two_suffix (str, optional): Suffix used for the second run. Defaults to 'test'. + case2setup_raises_exception (bool, optional): If True, then the call + to _case_two_setup will raise an exception. Default is False. + run_one_should_pass (bool, optional): Whether the run_indv method should + pass for the first run. Default is True, meaning it will pass. + run_two_should_pass (bool, optional): Whether the run_indv method should + pass for the second run. Default is True, meaning it will pass. + """ + + self._case2setup_raises_exception = case2setup_raises_exception + + # NOTE(wjs, 2016-08-03) Currently, due to limitations in the test + # infrastructure, run_one_suffix MUST be 'base'. However, I'm keeping it + # as an explicit argument to the constructor so that it's easy to relax + # this requirement later: To relax this assumption, remove the following + # assertion and add run_one_suffix as an argument to + # SystemTestsCompareTwo.__init__ + assert(run_one_suffix == 'base') + + SystemTestsCompareTwo.__init__( + self, + case1, + separate_builds = False, + run_two_suffix = run_two_suffix) + + # Need to tell test status that case has been built, since this is + # checked in the run call + with self._test_status: + self._test_status.set_status( + test_status.MODEL_BUILD_PHASE, + test_status.TEST_PASS_STATUS) + + self.run_pass_casenames = [] + if run_one_should_pass: + self.run_pass_casenames.append(self._case1.get_value('CASE')) + if run_two_should_pass: + self.run_pass_casenames.append(self._case2.get_value('CASE')) + + self.log = [] + + # ------------------------------------------------------------------------ + # Stubs of methods called by SystemTestsCommon.__init__ that interact with + # the system or case object in ways we want to avoid here + # ------------------------------------------------------------------------ + + def _init_environment(self, caseroot): + pass + + def _init_locked_files(self, caseroot, expected): + pass + + def _init_case_setup(self): + pass + + # ------------------------------------------------------------------------ + # Fake implementations of methods that are typically provided by + # SystemTestsCommon + # ------------------------------------------------------------------------ + + def run_indv(self, suffix="base", st_archive=False): + """ + This fake implementation appends to the log and raises an exception if + it's supposed to + + Note that the Call object appended to the log has the current CASE name + in addition to the method arguments. (This is mainly to ensure that the + proper suffix is used for the proper case, but this extra check can be + removed if it's a maintenance problem.) + """ + casename = self._case.get_value('CASE') + self.log.append(Call(METHOD_run_indv, + {'suffix': suffix, 'CASE': casename})) + + # Determine whether we should raise an exception + # + # It's important that this check be based on some attribute of the + # self._case object, to ensure that the right case has been activated + # for this call to run_indv (e.g., to catch if we forgot to activate + # case2 before the second call to run_indv). + if casename not in self.run_pass_casenames: + raise RuntimeError('casename not in run_pass_casenames') + + def _component_compare_test(self, suffix1, suffix2): + # Trying to use the real version of _component_compare_test would pull + # too much baggage into these tests. Since the return value from this + # method isn't important, it's sufficient for the tests of this class to + # just ensure that _component_compare_test was actually called + # correctly. + # + # An alternative would be to extract the main work of + # _component_compare_test into a different method that returns a True + # (success) / False (failure) result, with _component_compare_test then + # updating test_status appropriately. Then we could override that new + # method in this Fake class, using the true implementation of + # _component_compare_test. Then the test verification would include + # verification that TestStatus is set correctly for the COMPARE + # phase. But that seems more about testing _component_compare_test than + # testing SystemTestsCompareTwo itself, so I don't see much added value + # of that. + + self.log.append(Call(METHOD_component_compare_test, + {'suffix1': suffix1, 'suffix2': suffix2})) + + def _check_for_memleak(self): + pass + + # ------------------------------------------------------------------------ + # Fake implementations of methods that are typically provided by + # SystemTestsCompareTwo + # + # Since we're overriding these, their functionality is untested here! + # (Though note that _link_to_case2_output is tested elsewhere.) + # ------------------------------------------------------------------------ + + def _case_from_existing_caseroot(self, caseroot): + """ + Returns a CaseFake object instead of a Case object + """ + return CaseFake(caseroot, create_case_root=False) + + def _link_to_case2_output(self): + self.log.append(Call(METHOD_link_to_case2_output, {})) + + # ------------------------------------------------------------------------ + # Fake implementations of methods that are typically provided by the + # individual test + # + # The values set here are asserted against in some unit tests + # ------------------------------------------------------------------------ + + def _common_setup(self): + self._case.set_value('var_set_in_common_setup', 'common_val') + + def _case_one_setup(self): + self._case.set_value('var_set_in_setup', 'case1val') + + def _case_two_setup(self): + self._case.set_value('var_set_in_setup', 'case2val') + if self._case2setup_raises_exception: + raise RuntimeError + +# ======================================================================== +# Test class itself +# ======================================================================== + +class TestSystemTestsCompareTwo(unittest.TestCase): + + def setUp(self): + self.original_wd = os.getcwd() + # create a sandbox in which case directories can be created + self.tempdir = tempfile.mkdtemp() + + def tearDown(self): + # Some tests trigger a chdir call in the SUT; make sure we return to the + # original directory at the end of the test + os.chdir(self.original_wd) + + shutil.rmtree(self.tempdir, ignore_errors=True) + + def test_setup(self): + # Ensure that test setup properly sets up case 1 and case 2 + + # Setup + case1root = os.path.join(self.tempdir, 'case1') + case1 = CaseFake(case1root) + case1.set_value('var_preset', 'preset_value') + + # Exercise + mytest = SystemTestsCompareTwoFake(case1) + + # Verify + # Make sure that pre-existing values in case1 are copied to case2 (via + # clone) + self.assertEqual('preset_value', + mytest._case2.get_value('var_preset')) + + # Make sure that _common_setup is called for both + self.assertEqual('common_val', + mytest._case1.get_value('var_set_in_common_setup')) + self.assertEqual('common_val', + mytest._case2.get_value('var_set_in_common_setup')) + + # Make sure that _case_one_setup and _case_two_setup are called + # appropriately + self.assertEqual('case1val', + mytest._case1.get_value('var_set_in_setup')) + self.assertEqual('case2val', + mytest._case2.get_value('var_set_in_setup')) + + def test_setup_case2_exists(self): + # If case2 already exists, then setup code should not be called + + # Setup + case1root = os.path.join(self.tempdir, 'case1') + case1 = CaseFake(case1root) + os.makedirs(os.path.join(case1root, 'case1.test')) + + # Exercise + mytest = SystemTestsCompareTwoFake(case1, + run_two_suffix = 'test') + + # Verify: + + # Make sure that case2 object is set (i.e., that it doesn't remain None) + self.assertEqual('case1.test', mytest._case2.get_value('CASE')) + + # Variables set in various setup methods should not be set + # (In the real world - i.e., outside of this unit testing fakery - these + # values would be set when the Case objects are created.) + self.assertIsNone(mytest._case1.get_value('var_set_in_common_setup')) + self.assertIsNone(mytest._case2.get_value('var_set_in_common_setup')) + self.assertIsNone(mytest._case1.get_value('var_set_in_setup')) + self.assertIsNone(mytest._case2.get_value('var_set_in_setup')) + + def test_setup_error(self): + # If there is an error in setup, an exception should be raised and the + # case2 directory should be removed + + # Setup + case1root = os.path.join(self.tempdir, 'case1') + case1 = CaseFake(case1root) + + # Exercise + with self.assertRaises(Exception): + SystemTestsCompareTwoFake(case1, + run_two_suffix = 'test', + case2setup_raises_exception = True) + + # Verify + self.assertFalse(os.path.exists(os.path.join(case1root, 'case1.test'))) + + def test_run_phase_passes(self): + # Make sure the run phase behaves properly when all runs succeed. + + # Setup + case1root = os.path.join(self.tempdir, 'case1') + case1 = CaseFake(case1root) + mytest = SystemTestsCompareTwoFake(case1) + + # Exercise + mytest.run() + + # Verify + self.assertEqual(test_status.TEST_PASS_STATUS, + mytest._test_status.get_status(test_status.RUN_PHASE)) + + def test_run_phase_internal_calls(self): + # Make sure that the correct calls are made to methods stubbed out by + # SystemTestsCompareTwoFake (when runs succeed) + # + # The point of this is: A number of methods called from the run_phase + # method are stubbed out in the Fake test implementation, because their + # actions are awkward in these unit tests. But we still want to make + # sure that those methods actually got called correctly. + + # Setup + run_one_suffix = 'base' + run_two_suffix = 'run2' + casename = 'mytest' + case1root = os.path.join(self.tempdir, casename) + case1 = CaseFake(case1root) + mytest = SystemTestsCompareTwoFake(case1, + run_one_suffix = run_one_suffix, + run_two_suffix = run_two_suffix) + + # Exercise + mytest.run() + + # Verify + expected_calls = [ + Call(METHOD_run_indv, + {'suffix': run_one_suffix, 'CASE': casename}), + Call(METHOD_run_indv, + {'suffix': run_two_suffix, 'CASE': '%s.%s'%(casename, run_two_suffix)}), + Call(METHOD_link_to_case2_output, {}), + Call(METHOD_component_compare_test, + {'suffix1': run_one_suffix, 'suffix2': run_two_suffix})] + self.assertEqual(expected_calls, mytest.log) + + def test_run1_fails(self): + # Make sure that a failure in run1 is reported correctly + + # Setup + case1root = os.path.join(self.tempdir, 'case1') + case1 = CaseFake(case1root) + mytest = SystemTestsCompareTwoFake(case1, + run_one_should_pass = False) + + # Exercise + mytest.run() + + # Verify + self.assertEqual(test_status.TEST_FAIL_STATUS, + mytest._test_status.get_status(test_status.RUN_PHASE)) + + def test_run2_fails(self): + # Make sure that a failure in run2 is reported correctly + + # Setup + case1root = os.path.join(self.tempdir, 'case1') + case1 = CaseFake(case1root) + mytest = SystemTestsCompareTwoFake(case1, + run_two_should_pass = False) + + # Exercise + mytest.run() + + # Verify + self.assertEqual(test_status.TEST_FAIL_STATUS, + mytest._test_status.get_status(test_status.RUN_PHASE)) + diff --git a/utils/python/CIME/tests/SystemTests/test_system_tests_compare_two_link_to_case2_output.py b/utils/python/CIME/tests/SystemTests/test_system_tests_compare_two_link_to_case2_output.py new file mode 100644 index 000000000000..7ab40676f5d7 --- /dev/null +++ b/utils/python/CIME/tests/SystemTests/test_system_tests_compare_two_link_to_case2_output.py @@ -0,0 +1,154 @@ +#!/usr/bin/env python + +""" +This module contains unit tests of the method +SystemTestsCompareTwo._link_to_case2_output +""" + +# Ignore privacy concerns for unit tests, so that unit tests can access +# protected members of the system under test +# +# pylint:disable=protected-access + +import unittest +import os +import shutil +import tempfile +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo +from CIME.tests.case_fake import CaseFake + +# ======================================================================== +# Fake version of SystemTestsCompareTwo that overrides some functionality for +# the sake of unit testing +# ======================================================================== + +class SystemTestsCompareTwoFake(SystemTestsCompareTwo): + def __init__(self, + case1, + run_two_suffix = 'test'): + + SystemTestsCompareTwo.__init__( + self, + case1, + separate_builds = False, + run_two_suffix = run_two_suffix) + + # ------------------------------------------------------------------------ + # Stubs of methods called by SystemTestsCommon.__init__ that interact with + # the system or case object in ways we want to avoid here + # ------------------------------------------------------------------------ + + def _init_environment(self, caseroot): + pass + + def _init_locked_files(self, caseroot, expected): + pass + + def _init_case_setup(self): + pass + + # ------------------------------------------------------------------------ + # Stubs of methods that are typically provided by the individual test + # ------------------------------------------------------------------------ + + def _case_one_setup(self): + pass + + def _case_two_setup(self): + pass + +# ======================================================================== +# Test class itself +# ======================================================================== + +class TestLinkToCase2Output(unittest.TestCase): + + # ======================================================================== + # Test helper functions + # ======================================================================== + + def setUp(self): + self.original_wd = os.getcwd() + # Create a sandbox in which case directories can be created + self.tempdir = tempfile.mkdtemp() + + def tearDown(self): + # Some tests trigger a chdir call in the SUT; make sure we return to the + # original directory at the end of the test + os.chdir(self.original_wd) + + shutil.rmtree(self.tempdir, ignore_errors=True) + + def setup_test_and_directories(self, casename1, run2_suffix): + """ + Returns test object + """ + + case1root = os.path.join(self.tempdir, casename1) + case1 = CaseFake(case1root) + mytest = SystemTestsCompareTwoFake(case1, run_two_suffix = run2_suffix) + mytest._case1.make_rundir() #pylint: disable=maybe-no-member + mytest._case2.make_rundir() #pylint: disable=maybe-no-member + + return mytest + + def create_file_in_rundir2(self, mytest, core_filename, run2_suffix): + """ + Creates a file in rundir2 named CASE2.CORE_FILENAME.nc.RUN2_SUFFIX + (where CASE2 is the casename of case2) + + Returns full path to the file created + """ + filename = '%s.%s.nc.%s'%( + mytest._case2.get_value('CASE'), + core_filename, + run2_suffix) + filepath = os.path.join(mytest._case2.get_value('RUNDIR'), filename) + open(filepath, 'w').close() + return filepath + + # ======================================================================== + # Begin actual tests + # ======================================================================== + + def test_basic(self): + # Setup + casename1 = 'mytest' + run2_suffix = 'run2' + + mytest = self.setup_test_and_directories(casename1, run2_suffix) + filepath1 = self.create_file_in_rundir2(mytest, 'clm2.h0', run2_suffix) + filepath2 = self.create_file_in_rundir2(mytest, 'clm2.h1', run2_suffix) + + # Exercise + mytest._link_to_case2_output() + + # Verify + expected_link_filename1 = '%s.clm2.h0.nc.%s'%(casename1, run2_suffix) + expected_link_filepath1 = os.path.join(mytest._case1.get_value('RUNDIR'), + expected_link_filename1) + self.assertTrue(os.path.islink(expected_link_filepath1)) + self.assertEqual(filepath1, os.readlink(expected_link_filepath1)) + + expected_link_filename2 = '%s.clm2.h1.nc.%s'%(casename1, run2_suffix) + expected_link_filepath2 = os.path.join(mytest._case1.get_value('RUNDIR'), + expected_link_filename2) + self.assertTrue(os.path.islink(expected_link_filepath2)) + self.assertEqual(filepath2, os.readlink(expected_link_filepath2)) + + def test_existing_link(self): + # Setup + casename1 = 'mytest' + run2_suffix = 'run2' + + mytest = self.setup_test_and_directories(casename1, run2_suffix) + self.create_file_in_rundir2(mytest, 'clm2.h0', run2_suffix) + + # Create initial link via a call to _link_to_case2_output + mytest._link_to_case2_output() + + # Exercise + # See what happens when we try to recreate that link + mytest._link_to_case2_output() + + # (No verification: Test passes if no exception was raised) diff --git a/utils/python/CIME/tests/SystemTests/test_utils/__init__.py b/utils/python/CIME/tests/SystemTests/test_utils/__init__.py new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/utils/python/CIME/tests/SystemTests/test_utils/test_user_nl_utils.py b/utils/python/CIME/tests/SystemTests/test_utils/test_user_nl_utils.py new file mode 100644 index 000000000000..676461096735 --- /dev/null +++ b/utils/python/CIME/tests/SystemTests/test_utils/test_user_nl_utils.py @@ -0,0 +1,116 @@ +#!/usr/bin/env python + +import unittest +import os +import shutil +import tempfile +from CIME.SystemTests.test_utils import user_nl_utils + +class TestUserNLCopier(unittest.TestCase): + + # ======================================================================== + # Test helper functions + # ======================================================================== + + def setUp(self): + self._caseroot = tempfile.mkdtemp() + + def tearDown(self): + shutil.rmtree(self._caseroot, ignore_errors=True) + + def write_user_nl_file(self, component, contents, suffix=''): + """Write contents to a user_nl file in the case directory. Returns the + basename (i.e., not the full path) of the file that is created. + + For a component foo, with the default suffix of '', the file name will + be user_nl_foo + + If the suffix is '_0001', the file name will be user_nl_foo_0001 + """ + + filename = 'user_nl_' + component + suffix + + with open(os.path.join(self._caseroot, filename), 'w') as user_nl_file: + user_nl_file.write(contents) + + return filename + + def assertFileContentsEqual(self, expected, filepath, msg=None): + """Asserts that the contents of the file given by 'filepath' are equal to + the string given by 'expected'. 'msg' gives an optional message to be + printed if the assertion fails.""" + + with open(filepath, 'r') as myfile: + contents = myfile.read() + + self.assertEqual(expected, contents, msg=msg) + + # ======================================================================== + # Begin actual tests + # ======================================================================== + + def test_append(self): + # Define some variables + component = 'foo' + # deliberately exclude new line from file contents, to make sure that's + # handled correctly + orig_contents = 'bar = 42' + contents_to_append = 'baz = 101' + + # Setup + filename = self.write_user_nl_file(component, orig_contents) + + # Exercise + user_nl_utils.append_to_user_nl_files(caseroot = self._caseroot, + component = component, + contents = contents_to_append) + + # Verify + expected_contents = orig_contents + '\n' + contents_to_append + '\n' + self.assertFileContentsEqual(expected_contents, + os.path.join(self._caseroot, filename)) + + def test_append_multiple_files(self): + # Simulates a multi-instance test + component = 'foo' + orig_contents1 = 'bar = 42' + orig_contents2 = 'bar = 17' + contents_to_append = 'baz = 101' + + # Setup + filename1 = self.write_user_nl_file(component, orig_contents1, suffix='_0001') + filename2 = self.write_user_nl_file(component, orig_contents2, suffix='_0002') + + # Exercise + user_nl_utils.append_to_user_nl_files(caseroot = self._caseroot, + component = component, + contents = contents_to_append) + + # Verify + expected_contents1 = orig_contents1 + '\n' + contents_to_append + '\n' + expected_contents2 = orig_contents2 + '\n' + contents_to_append + '\n' + self.assertFileContentsEqual(expected_contents1, + os.path.join(self._caseroot, filename1)) + self.assertFileContentsEqual(expected_contents2, + os.path.join(self._caseroot, filename2)) + + + def test_append_without_files_raises_exception(self): + # This test verifies that you get an exception if you call + # append_to_user_nl_files when there are no user_nl files of interest + + # Define some variables + component_exists = 'foo' + component_for_append = 'bar' + + # Setup + # Create file in caseroot for component_exists, but not for component_for_append + self.write_user_nl_file(component_exists, 'irrelevant contents') + + # Exercise & verify + self.assertRaisesRegexp(RuntimeError, "No user_nl files found", + user_nl_utils.append_to_user_nl_files, + caseroot = self._caseroot, + component = component_for_append, + contents = 'irrelevant contents to append') + diff --git a/utils/python/CIME/tests/__init__.py b/utils/python/CIME/tests/__init__.py new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/utils/python/CIME/tests/case_fake.py b/utils/python/CIME/tests/case_fake.py new file mode 100644 index 000000000000..2ff315bea211 --- /dev/null +++ b/utils/python/CIME/tests/case_fake.py @@ -0,0 +1,103 @@ +""" +This module contains a fake implementation of the Case class that can be used +for testing the tests. +""" + +import os +from copy import deepcopy + +class CaseFake(object): + def __init__(self, case_root, create_case_root=True): + """ + Initialize a new case object for the given case_root directory. + + Args: + case_root (str): path to CASEROOT + create_case_root (bool): If True, creates the directory given by case_root + """ + self.vars = dict() + if create_case_root: + os.makedirs(case_root) + self.set_value('CASEROOT', case_root) + casename = os.path.basename(case_root) + self.set_value('CASE', casename) + self.set_value('CASEBASEID', casename) + self.set_rundir() + + def get_value(self, item): + """ + Get the value of the given item + + Returns None if item isn't set for this case + + Args: + item (str): variable of interest + """ + return self.vars.get(item) + + def set_value(self, item, value): + """ + Set the value of the given item to the given value + + Args: + item (str): variable of interest + value (any type): new value for item + """ + self.vars[item] = value + + def copy(self, newcasename, newcaseroot): + """ + Create and return a copy of self, but with CASE and CASEBASEID set to newcasename, + CASEROOT set to newcaseroot, and RUNDIR set appropriately. + + Args: + newcasename (str): new value for CASE + newcaseroot (str): new value for CASEROOT + """ + newcase = deepcopy(self) + newcase.set_value('CASE', newcasename) + newcase.set_value('CASEBASEID', newcasename) + newcase.set_value('CASEROOT', newcaseroot) + newcase.set_rundir() + + return newcase + + def create_clone(self, newcase, keepexe=False): + # Need to disable unused-argument checking: keepexe is needed to match + # the interface of Case, but is not used in this fake implementation + # + # pylint: disable=unused-argument + """ + Create a clone of the current case. Also creates the CASEROOT directory + for the clone case (given by newcase). + + Args: + newcase (str): full path to the new case. This directory should not + already exist; it will be created + keepexe (bool, optional): Ignored + + Returns the clone case object + """ + newcaseroot = os.path.abspath(newcase) + newcasename = os.path.basename(newcase) + os.makedirs(newcaseroot) + clone = self.copy(newcasename = newcasename, newcaseroot = newcaseroot) + + return clone + + def flush(self): + pass + + def make_rundir(self): + """ + Make directory given by RUNDIR + """ + os.makedirs(self.get_value('RUNDIR')) + + def set_rundir(self): + """ + Assumes CASEROOT is already set; sets an appropriate RUNDIR (nested + inside CASEROOT) + """ + self.set_value('RUNDIR', os.path.join(self.get_value('CASEROOT'), 'run')) + diff --git a/utils/python/CIME/tests/test_case_fake.py b/utils/python/CIME/tests/test_case_fake.py new file mode 100644 index 000000000000..36c3ffb5599b --- /dev/null +++ b/utils/python/CIME/tests/test_case_fake.py @@ -0,0 +1,39 @@ +#/usr/bin/env python + +""" +This module contains unit tests of CaseFake +""" + +import unittest +import tempfile +import os +import shutil + +from CIME.tests.case_fake import CaseFake + +class TestCaseFake(unittest.TestCase): + + def setUp(self): + self.tempdir = tempfile.mkdtemp() + + def tearDown(self): + shutil.rmtree(self.tempdir, ignore_errors=True) + + def test_create_clone(self): + # Setup + old_caseroot = os.path.join(self.tempdir, 'oldcase') + oldcase = CaseFake(old_caseroot) + oldcase.set_value('foo', 'bar') + + # Exercise + new_caseroot = os.path.join(self.tempdir, 'newcase') + clone = oldcase.create_clone(new_caseroot) + + # Verify + self.assertEqual('bar', clone.get_value('foo')) + self.assertEqual('newcase', clone.get_value('CASE')) + self.assertEqual('newcase', clone.get_value('CASEBASEID')) + self.assertEqual(new_caseroot, clone.get_value('CASEROOT')) + self.assertEqual(os.path.join(new_caseroot, 'run'), + clone.get_value('RUNDIR')) + diff --git a/utils/python/CIME/utils.py b/utils/python/CIME/utils.py index 947db7276c4f..fbf7a675eb1f 100644 --- a/utils/python/CIME/utils.py +++ b/utils/python/CIME/utils.py @@ -541,8 +541,10 @@ def get_project(machobj=None): return None def setup_standard_logging_options(parser): + helpfile = "%s.log"%sys.argv[0] + helpfile = os.path.join(os.getcwd(),os.path.basename(helpfile)) parser.add_argument("-d", "--debug", action="store_true", - help="Print debug information (very verbose) to file %s.log" % sys.argv[0]) + help="Print debug information (very verbose) to file %s" % helpfile) parser.add_argument("-v", "--verbose", action="store_true", help="Add additional context (time and file) to log messages") parser.add_argument("-s", "--silent", action="store_true", diff --git a/utils/python/tests/scripts_regression_tests.py b/utils/python/tests/scripts_regression_tests.py index c3fe667311db..a10342641ee6 100755 --- a/utils/python/tests/scripts_regression_tests.py +++ b/utils/python/tests/scripts_regression_tests.py @@ -15,10 +15,10 @@ import update_acme_tests import CIME.test_scheduler, CIME.wait_for_tests from CIME.test_scheduler import TestScheduler +from CIME.XML.build import Build from CIME.XML.machines import Machines from CIME.XML.files import Files from CIME.case import Case -from CIME.macros import MacroMaker from CIME.test_status import * SCRIPT_DIR = CIME.utils.get_scripts_root() @@ -30,6 +30,26 @@ os.environ["CIME_GLOBAL_WALLTIME"] = "0:05:00" # pragma pylint: disable=protected-access +############################################################################### +def run_cmd_assert_result(test_obj, cmd, from_dir=None, expected_stat=0): +############################################################################### + from_dir = os.getcwd() if from_dir is None else from_dir + stat, output, errput = run_cmd(cmd, from_dir=from_dir) + if expected_stat == 0: + expectation = "SHOULD HAVE WORKED, INSTEAD GOT STAT %s" % stat + else: + expectation = "EXPECTED STAT %s, INSTEAD GOT STAT %s" % (expected_stat, stat) + msg = \ +""" +COMMAND: %s +FROM_DIR: %s +%s +OUTPUT: %s +ERRPUT: %s +""" % (cmd, from_dir, expectation, output, errput) + test_obj.assertEqual(stat, expected_stat, msg=msg) + + return output ############################################################################### class A_RunUnitTests(unittest.TestCase): @@ -41,15 +61,43 @@ def test_resolve_variable_name(self): self.assertTrue(os.path.isfile(machinefile), msg="Path did not resolve to existing file %s" % machinefile) - def test_CIME_unit_tests(self): - # Find and run all the unit tests in the CIME directory tree - stat, output, _ = run_cmd("PYTHONPATH=%s:$PYTHONPATH python -m doctest *.py 2>&1" % LIB_DIR, from_dir=os.path.join(LIB_DIR,"CIME")) - self.assertEqual(stat, 0, msg=output) + def test_unittests(self): + # Finds all files contained in CIME/tests or its subdirectories that + # match the pattern 'test*.py', and runs the unit tests found there + # (i.e., tests defined using python's unittest module). + # + # This is analogous to running: + # python -m unittest discover -s CIME/tests -t . + # from cime/utils/python + # + # Yes, that means we have a bunch of unit tests run from this one unit + # test. + + testsuite = unittest.defaultTestLoader.discover( + start_dir = os.path.join(LIB_DIR,"CIME","tests"), + pattern = 'test*.py', + top_level_dir = LIB_DIR) + + testrunner = unittest.TextTestRunner(buffer=False) + + # Disable logging; otherwise log messages written by code under test + # clutter the unit test output + log_lvl = logging.getLogger().getEffectiveLevel() + logging.disable(logging.CRITICAL) + try: + results = testrunner.run(testsuite) + finally: + logging.getLogger().setLevel(log_lvl) + + self.assertTrue(results.wasSuccessful()) + + def test_CIME_doctests(self): + # Find and run all the doctests in the CIME directory tree + run_cmd_assert_result(self, "PYTHONPATH=%s:$PYTHONPATH python -m doctest *.py 2>&1" % LIB_DIR, from_dir=os.path.join(LIB_DIR,"CIME")) - def test_CIMEXML_unit_tests(self): - # Find and run all the unit tests in the XML directory tree - stat, output, _ = run_cmd("PYTHONPATH=%s:$PYTHONPATH python -m doctest *.py 2>&1" % LIB_DIR, from_dir=os.path.join(LIB_DIR,"CIME","XML")) - self.assertEqual(stat, 0, msg=output) + def test_CIMEXML_doctests(self): + # Find and run all the doctests in the XML directory tree + run_cmd_assert_result(self, "PYTHONPATH=%s:$PYTHONPATH python -m doctest *.py 2>&1" % LIB_DIR, from_dir=os.path.join(LIB_DIR,"CIME","XML")) ############################################################################### def make_fake_teststatus(path, testname, status, phase): @@ -113,7 +161,7 @@ def setup_proxy(): return False ############################################################################### -class B_TestCreateNewcase(unittest.TestCase): +class J_TestCreateNewcase(unittest.TestCase): ############################################################################### def setUp(self): self._testroot = MACHINE.get_value("CESMSCRATCHROOT") @@ -121,35 +169,35 @@ def setUp(self): self._do_teardown = [] def test_createnewcase(self): - testdir = os.path.join(self._testroot, 'scripts_regression_tests.testcreatenewcase') + testdir = os.path.join(self._testroot, 'scripts_regression_tests.testcreatenewcase.%s'% CIME.utils.get_utc_timestamp()) if os.path.exists(testdir): shutil.rmtree(testdir) + self._testdirs.append(testdir) - cmd = "%s/create_newcase --case %s --compset X --res f19_g16" % (SCRIPT_DIR, testdir) - stat, output, errput = run_cmd(cmd, from_dir=SCRIPT_DIR) - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\noutput:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) - cmd = "./case.setup " - stat, output, errput = run_cmd(cmd, from_dir=testdir) - self.assertEqual(stat, 0, msg="COMMAND '%s' from case directory '%s' SHOULD HAVE WORKED\noutput:\n%s\n\nerrput:\n%s" % (cmd, testdir, output, errput)) - cmd = "./case.build" - stat, output, errput = run_cmd(cmd, from_dir=testdir) - self.assertEqual(stat, 0, msg="COMMAND '%s' from case directory '%s' SHOULD HAVE WORKED\noutput:\n%s\n\nerrput:\n%s" % (cmd, testdir,output, errput)) + + run_cmd_assert_result(self, "%s/create_newcase --case %s --compset X --res f19_g16" % (SCRIPT_DIR, testdir), from_dir=SCRIPT_DIR) + run_cmd_assert_result(self, "./case.setup", from_dir=testdir) + run_cmd_assert_result(self, "./case.build", from_dir=testdir) + self._do_teardown.append(testdir) def test_user_mods(self): - testdir = os.path.join(self._testroot, 'scripts_regression_tests.testusermods') + testdir = os.path.join(self._testroot, 'scripts_regression_tests.testusermods.%s'% CIME.utils.get_utc_timestamp()) if os.path.exists(testdir): shutil.rmtree(testdir) + self._testdirs.append(testdir) + user_mods_dir = os.path.join(CIME.utils.get_python_libs_root(), "tests", "user_mods_test1") - cmd = "%s/create_newcase --case %s --compset X --res f19_g16 --user-mods-dir %s" % (SCRIPT_DIR, testdir, user_mods_dir) - stat, output, errput = run_cmd(cmd, from_dir=SCRIPT_DIR) - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\noutput:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) + run_cmd_assert_result(self, "%s/create_newcase --case %s --compset X --res f19_g16 --user-mods-dir %s" % (SCRIPT_DIR, testdir, user_mods_dir), + from_dir=SCRIPT_DIR) + self.assertTrue(os.path.isfile(os.path.join(testdir,"SourceMods","src.drv","somefile.F90")), msg="User_mods SourceMod missing") with open(os.path.join(testdir,"user_nl_cpl"),"r") as fd: contents = fd.read() - self.assertTrue("a different cpl test option" in contents, msg="User_mods contents of user_nl_cpl missing") - self.assertTrue("a cpl namelist option" in contents, msg="User_mods contents of user_nl_cpl missing") + self.assertTrue("a different cpl test option" in contents, msg="User_mods contents of user_nl_cpl missing") + self.assertTrue("a cpl namelist option" in contents, msg="User_mods contents of user_nl_cpl missing") + self._do_teardown.append(testdir) def tearDown(self): @@ -161,18 +209,19 @@ def tearDown(self): print "Leaving case directory : %s"%tfile elif do_teardown: shutil.rmtree(tfile) + ############################################################################### -class D_TestWaitForTests(unittest.TestCase): +class M_TestWaitForTests(unittest.TestCase): ############################################################################### ########################################################################### def setUp(self): ########################################################################### self._testroot = MACHINE.get_value("CESMSCRATCHROOT") - self._testdir_all_pass = os.path.join(self._testroot, 'scripts_regression_tests.testdir_all_pass') - self._testdir_with_fail = os.path.join(self._testroot, 'scripts_regression_tests.testdir_with_fail') - self._testdir_unfinished = os.path.join(self._testroot, 'scripts_regression_tests.testdir_unfinished') - self._testdir_unfinished2 = os.path.join(self._testroot, 'scripts_regression_tests.testdir_unfinished2') + self._testdir_all_pass = os.path.join(self._testroot, 'scripts_regression_tests.testdir_all_pass.%s'% CIME.utils.get_utc_timestamp()) + self._testdir_with_fail = os.path.join(self._testroot, 'scripts_regression_tests.testdir_with_fail.%s'% CIME.utils.get_utc_timestamp()) + self._testdir_unfinished = os.path.join(self._testroot, 'scripts_regression_tests.testdir_unfinished.%s'% CIME.utils.get_utc_timestamp()) + self._testdir_unfinished2 = os.path.join(self._testroot, 'scripts_regression_tests.testdir_unfinished2.%s'% CIME.utils.get_utc_timestamp()) testdirs = [self._testdir_all_pass, self._testdir_with_fail, self._testdir_unfinished, self._testdir_unfinished2] for testdir in testdirs: if os.path.exists(testdir): @@ -212,13 +261,9 @@ def simple_test(self, testdir, expected_results, extra_args="", build_name=None) if CIME.utils.get_model() == "acme" and build_name is not None: extra_args += " -b %s" % build_name - cmd = "%s/wait_for_tests -p ACME_test */TestStatus %s" % (TOOLS_DIR, extra_args) - stat, output, errput = run_cmd(cmd, from_dir=testdir) - if (expected_results == ["PASS"]*len(expected_results)): - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\nwait_for_tests output:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) - else: - self.assertEqual(stat, CIME.utils.TESTS_FAILED_ERR_CODE, - msg="COMMAND '%s' SHOULD HAVE DETECTED FAILED TESTS\nwait_for_tests output:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) + expected_stat = 0 if expected_results == ["PASS"]*len(expected_results) else CIME.utils.TESTS_FAILED_ERR_CODE + output = run_cmd_assert_result(self, "%s/wait_for_tests -p ACME_test */TestStatus %s" % (TOOLS_DIR, extra_args), + from_dir=testdir, expected_stat=expected_stat) lines = [line for line in output.splitlines() if line.startswith("Test '")] self.assertEqual(len(lines), 10) @@ -395,7 +440,7 @@ def tearDown(self): files_to_clean = [] - baselines = os.path.join(self._baseline_area, self._compiler, self._baseline_name) + baselines = os.path.join(self._baseline_area, self._baseline_name) if (os.path.isdir(baselines)): files_to_clean.append(baselines) @@ -417,7 +462,7 @@ def tearDown(self): os.remove(file_to_clean) ############################################################################### -class C_TestCreateTest(TestCreateTestCommon): +class N_TestCreateTest(TestCreateTestCommon): ############################################################################### ########################################################################### @@ -425,22 +470,23 @@ def simple_test(self, expect_works, extra_args): ########################################################################### if NO_BATCH: extra_args += " --no-batch" - cmd = "%s/create_test acme_test_only_pass %s" % (SCRIPT_DIR, extra_args) - stat, output, errput = run_cmd(cmd) - if (expect_works): - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\ncreate_test output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (cmd, output, errput, stat)) - else: - self.assertEqual(stat, CIME.utils.TESTS_FAILED_ERR_CODE, - msg="COMMAND '%s' SHOULD HAVE DETECTED FAILED TESTS\ncreate_test output:\n%s\n\nerrput:\n%ss\n\ncode: %d" % (cmd, output, errput, stat)) + run_cmd_assert_result(self, "%s/create_test cime_test_only_pass %s" % (SCRIPT_DIR, extra_args), + expected_stat=(0 if expect_works else CIME.utils.TESTS_FAILED_ERR_CODE)) ############################################################################### def test_create_test_rebless_namelist(self): ############################################################################### # Generate some namelist baselines - self.simple_test(True, "-g -n -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + if CIME.utils.get_model() == "acme": + genarg = "-g -o -b %s"%self._baseline_name + comparg = "-c -b %s"%self._baseline_name + else: + genarg = "-g %s -o"%self._baseline_name + comparg = "-c %s"%self._baseline_name + self.simple_test(True, "%s -n -t %s-%s" % (genarg,self._baseline_name, CIME.utils.get_utc_timestamp())) # Basic namelist compare - self.simple_test(True, "-c -n -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + self.simple_test(True, "%s -n -t %s-%s" % (comparg, self._baseline_name, CIME.utils.get_utc_timestamp())) # Modify namelist fake_nl = """ @@ -449,8 +495,7 @@ def test_create_test_rebless_namelist(self): fake = .true. /""" baseline_area = self._baseline_area - compiler = self._compiler - baseline_glob = glob.glob(os.path.join(baseline_area, compiler, self._baseline_name, "TEST*")) + baseline_glob = glob.glob(os.path.join(baseline_area, self._baseline_name, "TEST*")) self.assertEqual(len(baseline_glob), 3, msg="Expected three matches, got:\n%s" % "\n".join(baseline_glob)) baseline_dir = baseline_glob[0] @@ -463,24 +508,27 @@ def test_create_test_rebless_namelist(self): nl_file.write(fake_nl) # Basic namelist compare should now fail - self.simple_test(False, "-c -n -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + self.simple_test(False, "%s -n -t %s-%s" % (comparg, self._baseline_name, CIME.utils.get_utc_timestamp())) # Regen - self.simple_test(True, "-g -n -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + self.simple_test(True, "%s -n -t %s-%s" % (genarg, self._baseline_name, CIME.utils.get_utc_timestamp())) # Basic namelist compare should now pass again - self.simple_test(True, "-c -n -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + self.simple_test(True, "%s -n -t %s-%s" % (comparg, self._baseline_name, CIME.utils.get_utc_timestamp())) ############################################################################### -class E_TestTestScheduler(TestCreateTestCommon): +class O_TestTestScheduler(TestCreateTestCommon): ############################################################################### ########################################################################### def test_a_phases(self): ########################################################################### # exclude the MEMLEAK tests here. - tests = update_acme_tests.get_full_test_names(["acme_test_only", - "^TESTMEMLEAKFAIL_Mmpi-serial.f19_g16.X", "^TESTMEMLEAKPASS_Mmpi-serial.f19_g16.X"], + tests = update_acme_tests.get_full_test_names(["cime_test_only", + "^TESTMEMLEAKFAIL_Mmpi-serial.f19_g16.X", + "^TESTMEMLEAKPASS_Mmpi-serial.f19_g16.X", + "^TESTBUILDFAILEXC.f19_g16_rx1.A", + "^TESTRUNFAILEXC_Mmpi-serial.f19_g16_rx1.A"], self._machine, self._compiler) self.assertEqual(len(tests), 3) ct = TestScheduler(tests) @@ -551,15 +599,17 @@ def test_a_phases(self): ########################################################################### def test_b_full(self): ########################################################################### - tests = update_acme_tests.get_full_test_names(["acme_test_only"], self._machine, self._compiler) + tests = update_acme_tests.get_full_test_names(["cime_test_only"], self._machine, self._compiler) test_id="%s-%s" % (self._baseline_name, CIME.utils.get_utc_timestamp()) ct = TestScheduler(tests, test_id=test_id, no_batch=NO_BATCH) - build_fail_test = [item for item in tests if "TESTBUILDFAIL" in item][0] - run_fail_test = [item for item in tests if "TESTRUNFAIL" in item][0] - pass_test = [item for item in tests if "TESTRUNPASS" in item][0] - mem_fail_test = [item for item in tests if "TESTMEMLEAKFAIL" in item][0] - mem_pass_test = [item for item in tests if "TESTMEMLEAKPASS" in item][0] + build_fail_test = [item for item in tests if "TESTBUILDFAIL." in item][0] + build_fail_exc_test = [item for item in tests if "TESTBUILDFAILEXC" in item][0] + run_fail_test = [item for item in tests if "TESTRUNFAIL_" in item][0] + run_fail_exc_test = [item for item in tests if "TESTRUNFAILEXC" in item][0] + pass_test = [item for item in tests if "TESTRUNPASS" in item][0] + mem_fail_test = [item for item in tests if "TESTMEMLEAKFAIL" in item][0] + mem_pass_test = [item for item in tests if "TESTMEMLEAKPASS" in item][0] log_lvl = logging.getLogger().getEffectiveLevel() logging.disable(logging.CRITICAL) @@ -569,7 +619,8 @@ def test_b_full(self): logging.getLogger().setLevel(log_lvl) if (self._hasbatch): - run_cmd("%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, test_id), from_dir=self._testroot) + run_cmd_assert_result(self, "%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, test_id), from_dir=self._testroot, + expected_stat=CIME.utils.TESTS_FAILED_ERR_CODE) test_statuses = glob.glob("%s/*%s/TestStatus" % (self._testroot, test_id)) self.assertEqual(len(tests), len(test_statuses)) @@ -577,10 +628,26 @@ def test_b_full(self): for test_status in test_statuses: ts = TestStatus(test_dir=os.path.dirname(test_status)) test_name = ts.get_name() + log_files = glob.glob("%s/%s*%s/TestStatus.log" % (self._testroot, test_name, test_id)) + self.assertEqual(len(log_files), 1, "Expected exactly one TestStatus.log file, found %d" % len(log_files)) + log_file = log_files[0] if (test_name == build_fail_test): self.assertEqual(ts.get_status(CIME.test_scheduler.MODEL_BUILD_PHASE), TEST_FAIL_STATUS) + data = open(log_file, "r").read() + self.assertTrue("Intentional fail for testing infrastructure" in data, + "Broken test did not report build error:\n%s" % data) + elif (test_name == build_fail_exc_test): + data = open(log_file, "r").read() + self.assertEqual(ts.get_status(CIME.test_scheduler.SHAREDLIB_BUILD_PHASE), TEST_FAIL_STATUS) + self.assertTrue("Exception from init" in data, + "Broken test did not report build error:\n%s" % data) elif (test_name == run_fail_test): self.assertEqual(ts.get_status(CIME.test_scheduler.RUN_PHASE), TEST_FAIL_STATUS) + elif (test_name == run_fail_exc_test): + self.assertEqual(ts.get_status(CIME.test_scheduler.RUN_PHASE), TEST_FAIL_STATUS) + data = open(log_file, "r").read() + self.assertTrue("Exception from run_phase" in data, + "Broken test did not report run error:\n%s" % data) elif (test_name == mem_fail_test): self.assertEqual(ts.get_status(MEMLEAK_PHASE), TEST_FAIL_STATUS) self.assertEqual(ts.get_status(CIME.test_scheduler.RUN_PHASE), TEST_PASS_STATUS) @@ -591,7 +658,7 @@ def test_b_full(self): self.assertEqual(ts.get_status(MEMLEAK_PHASE), TEST_PASS_STATUS) ############################################################################### -class TestJenkinsGenericJob(TestCreateTestCommon): +class P_TestJenkinsGenericJob(TestCreateTestCommon): ############################################################################### ########################################################################### @@ -617,12 +684,8 @@ def simple_test(self, expect_works, extra_args, build_name=None): if CIME.utils.get_model() == "acme" and build_name is not None: extra_args += " -p ACME_test --submit-to-cdash --cdash-build-group=Nightly -c %s" % build_name - cmd = "%s/jenkins_generic_job -r %s %s" % (TOOLS_DIR, self._testdir, extra_args) - stat, output, errput = run_cmd(cmd, from_dir=self._testdir) - if (expect_works): - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\njenkins_generic_job output:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) - else: - self.assertEqual(stat, CIME.utils.TESTS_FAILED_ERR_CODE, msg="COMMAND '%s' SHOULD HAVE DETECTED FAILED TESTS\njenkins_generic_job output:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) + run_cmd_assert_result(self, "%s/jenkins_generic_job -r %s %s" % (TOOLS_DIR, self._testdir, extra_args), + from_dir=self._testdir, expected_stat=(0 if expect_works else CIME.utils.TESTS_FAILED_ERR_CODE)) ########################################################################### def threaded_test(self, expect_works, extra_args, build_name=None): @@ -639,7 +702,7 @@ def assert_num_leftovers(self, test_id=None): # the testroot (bld/run dump area) and jenkins root if (test_id is None): test_id = self._baseline_name - num_tests_in_tiny = len(update_acme_tests.get_test_suite("acme_test_only_pass")) + num_tests_in_tiny = len(update_acme_tests.get_test_suite("cime_test_only_pass")) jenkins_dirs = glob.glob("%s/*%s*/" % (self._jenkins_root, test_id)) # case dirs # scratch_dirs = glob.glob("%s/*%s*/" % (self._testroot, test_id)) # blr/run dirs @@ -660,11 +723,11 @@ def test_jenkins_generic_job(self): # Generate fresh baselines so that this test is not impacted by # unresolved diffs - self.simple_test(True, "-t acme_test_only_pass -g -b %s" % self._baseline_name) + self.simple_test(True, "-t cime_test_only_pass -g -b %s" % self._baseline_name) self.assert_num_leftovers() build_name = "jenkins_generic_job_pass_%s" % CIME.utils.get_utc_timestamp() - self.simple_test(True, "-t acme_test_only_pass -b %s" % self._baseline_name, build_name=build_name) + self.simple_test(True, "-t cime_test_only_pass -b %s" % self._baseline_name, build_name=build_name) self.assert_num_leftovers() # jenkins_generic_job should have automatically cleaned up leftovers from prior run assert_dashboard_has_build(self, build_name) @@ -672,7 +735,7 @@ def test_jenkins_generic_job(self): def test_jenkins_generic_job_kill(self): ########################################################################### build_name = "jenkins_generic_job_kill_%s" % CIME.utils.get_utc_timestamp() - run_thread = threading.Thread(target=self.threaded_test, args=(False, " -t acme_test_only_slow_pass -b master --baseline-compare=no", build_name)) + run_thread = threading.Thread(target=self.threaded_test, args=(False, " -t cime_test_only_slow_pass -b master --baseline-compare=no", build_name)) run_thread.daemon = True run_thread.start() @@ -687,7 +750,7 @@ def test_jenkins_generic_job_kill(self): assert_dashboard_has_build(self, build_name) ############################################################################### -class TestBlessTestResults(TestCreateTestCommon): +class Q_TestBlessTestResults(TestCreateTestCommon): ############################################################################### _test_name = "TESTRUNDIFF_Mmpi-serial.f19_g16_rx1.A" @@ -705,45 +768,57 @@ def simple_test(self, expect_works, extra_args): ########################################################################### if NO_BATCH: extra_args += " --no-batch" - cmd = "%s/create_test %s %s" % (SCRIPT_DIR, self._test_name, extra_args) - stat, output, errput = run_cmd(cmd) + + run_cmd_assert_result(self, "%s/create_test %s %s" % (SCRIPT_DIR, self._test_name, extra_args), + expected_stat=(0 if expect_works or self._hasbatch else CIME.utils.TESTS_FAILED_ERR_CODE)) if self._hasbatch: - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\ncreate_test output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (cmd, output, errput, stat)) test_id = extra_args.split()[extra_args.split().index("-t") + 1] - cmd = "%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, test_id) - stat, output, errput = run_cmd(cmd, from_dir=self._testroot) - - if (expect_works): - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\nOutput:\n%s\n\nerrput:\n%s\n\ncode: %d" % (cmd, output, errput, stat)) - else: - self.assertEqual(stat, CIME.utils.TESTS_FAILED_ERR_CODE, msg="COMMAND '%s' SHOULD HAVE DETECTED FAILED TESTS\nOutput:\n%s\n\nerrput:\n%ss\n\ncode: %d" % (cmd, output, errput, stat)) + run_cmd_assert_result(self, "%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, test_id), + from_dir=self._testroot, expected_stat=(0 if expect_works else CIME.utils.TESTS_FAILED_ERR_CODE)) ############################################################################### def test_bless_test_results(self): ############################################################################### # Generate some namelist baselines - self.simple_test(True, "-g -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + if CIME.utils.get_model() == "acme": + genarg = "-g -o -b %s"%self._baseline_name + comparg = "-c -b %s"%self._baseline_name + else: + genarg = "-g %s -o"%self._baseline_name + comparg = "-c %s"%self._baseline_name + + self.simple_test(True, "%s -t %s-%s" % (genarg, self._baseline_name, CIME.utils.get_utc_timestamp())) # Hist compare should pass - self.simple_test(True, "-c -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + self.simple_test(True, "%s -t %s-%s" % (comparg, self._baseline_name, CIME.utils.get_utc_timestamp())) # Change behavior os.environ["TESTRUNDIFF_ALTERNATE"] = "True" # Hist compare should now fail test_id = "%s-%s" % (self._baseline_name, CIME.utils.get_utc_timestamp()) - self.simple_test(False, "-c -b %s -t %s" % (self._baseline_name, test_id)) + self.simple_test(False, "%s -t %s" % (comparg, test_id)) + + # compare_test_results should detect the fail + cpr_cmd = "%s/compare_test_results -b %s -t %s 2>&1" % (TOOLS_DIR, self._baseline_name, test_id) + output = run_cmd_assert_result(self, cpr_cmd, expected_stat=1) + + # use regex + expected_pattern = re.compile(r'COMPARE FAILED FOR TEST: %s[^\s]* reason Diff' % self._test_name) + the_match = expected_pattern.search(output) + self.assertNotEqual(the_match, None, + msg="Cmd '%s' failed to display failed test in output:\n%s" % (cpr_cmd, output)) # Bless run_cmd_no_fail("%s/bless_test_results --hist-only --force -b %s -t %s" % (TOOLS_DIR, self._baseline_name, test_id)) # Hist compare should now pass again - self.simple_test(True, "-c -b %s -t %s-%s" % (self._baseline_name, self._baseline_name, CIME.utils.get_utc_timestamp())) + self.simple_test(True, "%s -t %s-%s" % (comparg, self._baseline_name, CIME.utils.get_utc_timestamp())) ############################################################################### @unittest.skip("Disabling this test until we figure out how to integrate ACME tests and CIME xml files.") -class TestUpdateACMETests(unittest.TestCase): +class R_TestUpdateACMETests(unittest.TestCase): ############################################################################### ########################################################################### @@ -763,7 +838,7 @@ def test_update_acme_tests(self): ########################################################################### # Add some testable stuff to acme tests pass - # update_acme_tests._TEST_SUITES["acme_tiny"] = \ + # update_acme_tests._TEST_SUITES["cime_tiny"] = \ # (None, (("ERS.f19_g16_rx1.A", "jgftestmodtest/test_mod"), # ("NCK.f19_g16_rx1.A", "jgftestmodtest/test_mod")) # ) @@ -785,7 +860,7 @@ def test_update_acme_tests_test_mods(self): # not_my_machine = "%s_jgftest" % machine # # Add some testable stuff to acme tests - # update_acme_tests._TEST_SUITES["acme_tiny"] = \ + # update_acme_tests._TEST_SUITES["cime_tiny"] = \ # (None, (("ERS.f19_g16_rx1.A", "test_mod"), # ("ERS.f19_g16_rx1.B", "test_mod", machine), # ("ERS.f19_g16_rx1.C", "test_mod", (machine, not_my_machine)), @@ -793,7 +868,7 @@ def test_update_acme_tests_test_mods(self): # "ERS.f19_g16_rx1.E") # ) - # tests = update_acme_tests.get_test_suite("acme_tiny", compiler="gnu") + # tests = update_acme_tests.get_test_suite("cime_tiny", compiler="gnu") # self.assertEqual(5, len(tests)) # self.assertTrue("ERS.f19_g16_rx1.A.melvin_gnu.test_mod" in tests) @@ -827,20 +902,14 @@ def test_full_system(self): if NO_BATCH: create_test_cmd += " --no-batch" - stat, output, errput = run_cmd(create_test_cmd) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\ncreate_test output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) + run_cmd_assert_result(self, create_test_cmd) if (self._hasbatch): - stat, output, errput = run_cmd("%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, self._baseline_name), - from_dir=self._testroot) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\nwait_for_tests output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) + run_cmd_assert_result(self, "%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, self._baseline_name), + from_dir=self._testroot) - stat, output, errput = run_cmd("%s/cs.status.%s" % (self._testroot, self._baseline_name), - from_dir=self._testroot) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\ncs.status output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) + run_cmd_assert_result(self, "%s/cs.status.%s" % (self._testroot, self._baseline_name), + from_dir=self._testroot) # Ensure that we can get test times test_statuses = glob.glob(os.path.join(self._testroot, "*%s" % self._baseline_name, "TestStatus")) @@ -850,15 +919,13 @@ def test_full_system(self): self.assertTrue(test_time > 0, msg="test time was zero for %s" % test_status) ############################################################################### -class TestCimeCase(TestCreateTestCommon): +class K_TestCimeCase(TestCreateTestCommon): ############################################################################### ########################################################################### def test_cime_case(self): ########################################################################### - stat, output, errput = run_cmd("%s/create_test acme_test_only -t %s --no-build" % (SCRIPT_DIR, self._baseline_name)) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\ncreate_test output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) + run_cmd_assert_result(self, "%s/create_test cime_test_only -t %s --no-build" % (SCRIPT_DIR, self._baseline_name)) casedir = os.path.join(self._testroot, "%s.%s" % (CIME.utils.get_full_test_name("TESTRUNPASS_Mmpi-serial.f19_g16_rx1.A", machine=self._machine, compiler=self._compiler), self._baseline_name)) @@ -892,7 +959,7 @@ def test_cime_case(self): self.assertEqual(case.get_value("PIO_TYPENAME"), "netcdf") ############################################################################### -class TestSingleSubmit(TestCreateTestCommon): +class X_TestSingleSubmit(TestCreateTestCommon): ############################################################################### ########################################################################### @@ -905,17 +972,13 @@ def test_single_submit(self): self.skipTest("Skipping single submit. ACME experimental feature") # Keep small enough for now that we don't have to worry about load balancing - stat, output, errput = run_cmd("unset CIME_GLOBAL_WALLTIME && %s/create_test SMS_Ln9_P8.f45_g37_rx1.A SMS_Ln9_P8.f19_g16_rx1.A -t %s --single-submit" % (SCRIPT_DIR, self._baseline_name)) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\ncreate_test output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) - - stat, output, errput = run_cmd("%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, self._baseline_name), - from_dir=self._testroot) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\nwait_for_tests output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) + run_cmd_assert_result(self, + "unset CIME_GLOBAL_WALLTIME && %s/create_test SMS_Ln9_P8.f45_g37_rx1.A SMS_Ln9_P8.f19_g16_rx1.A -t %s --single-submit" % (SCRIPT_DIR, self._baseline_name)) + run_cmd_assert_result(self, "%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, self._baseline_name), + from_dir=self._testroot) ############################################################################### -class TestSaveTimings(TestCreateTestCommon): +class L_TestSaveTimings(TestCreateTestCommon): ############################################################################### ########################################################################### @@ -925,18 +988,13 @@ def test_save_timings(self): if NO_BATCH: create_test_cmd += " --no-batch" - stat, output, errput = run_cmd(create_test_cmd) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\ncreate_test output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) - + run_cmd_assert_result(self, create_test_cmd) if (self._hasbatch): - stat, output, errput = run_cmd("%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, self._baseline_name), - from_dir=self._testroot) - self.assertEqual(stat, 0, - msg="COMMAND SHOULD HAVE WORKED\nwait_for_tests output:\n%s\n\nerrput:\n%s\n\ncode: %d" % (output, errput, stat)) + run_cmd_assert_result(self, "%s/wait_for_tests *%s/TestStatus" % (TOOLS_DIR, self._baseline_name), + from_dir=self._testroot) ############################################################################### -class TestXMLQuery(unittest.TestCase): +class C_TestXMLQuery(unittest.TestCase): # Testing command line scripts ############################################################################### @@ -946,14 +1004,15 @@ def setUp(self): self._testdirs = [] self._do_teardown = [] - testdir = os.path.join(self._testroot, 'scripts_regression_tests.testscripts') - machine = 'melvin' + testdir = os.path.join(self._testroot, 'scripts_regression_tests.testscripts.%s'% CIME.utils.get_utc_timestamp()) if os.path.exists(testdir): shutil.rmtree(testdir) + self._testdirs.append(testdir) + + machine = 'melvin' cmd = "%s/create_newcase --case %s --compset X --res f19_g16 --mach %s " % (SCRIPT_DIR, testdir, machine) - stat, output, errput = run_cmd(cmd, from_dir=SCRIPT_DIR) - self.assertEqual(stat, 0, msg="COMMAND '%s' SHOULD HAVE WORKED\noutput:\n%s\n\nerrput:\n%s" % (cmd, output, errput)) + run_cmd_assert_result(self, cmd, from_dir=SCRIPT_DIR) self._do_teardown.append(testdir) @@ -1019,14 +1078,23 @@ def test_subgroup(self): self.assertEqual(searchObj.group() , group_out) ############################################################################### -class CheckCode(unittest.TestCase): +class B_CheckCode(unittest.TestCase): ############################################################################### ########################################################################### def test_check_code(self): ########################################################################### - stat, output, _ = run_cmd(os.path.join(TOOLS_DIR, "code_checker -d 2>&1")) - self.assertEqual(stat, 0, msg=output) + from distutils.spawn import find_executable + pylint = find_executable("pylint") + if pylint is not None: + output = run_cmd_no_fail("pylint --version") + pylintver = re.search(r"pylint\s+(\d+)[.](\d+)[.](\d+)", output) + major = int(pylintver.group(1)) + minor = int(pylintver.group(2)) + if pylint is None or (major <= 1 and minor < 5): + self.skipTest("pylint version 1.5 or newer not found") + else: + run_cmd_assert_result(self, os.path.join(TOOLS_DIR, "code_checker -d 2>&1")) # Machinery for Macros generation tests. @@ -1034,15 +1102,22 @@ class MockMachines(object): """A mock version of the Machines object to simplify testing.""" - def __init__(self, name): + def __init__(self, name, os_): """Store the name.""" self.name = name + self.os = os_ def get_machine_name(self): """Return the name we were given.""" return self.name - def is_valid_compiler(self, _): + def get_value(self, var_name): + """Allow the operating system to be queried.""" + assert var_name == "OS", "Build asked for a value not " \ + "implemented in the testing infrastructure." + return self.os + + def is_valid_compiler(self, _): # pylint:disable=no-self-use """Assume all compilers are valid.""" return True @@ -1055,13 +1130,13 @@ def get_macros(macro_maker, build_xml, build_system): """Generate build system ("Macros" file) output from config_build XML. Arguments: - macro_maker - The underlying MacroMaker object. + macro_maker - The underlying Build object. build_xml - A string containing the XML to operate on. build_system - Either "Makefile" or "CMake", depending on desired output. The return value is a string containing the build system output. """ - # MacroMaker.write_macros expects file-like objects as input, so + # Build.write_macros expects file-like objects as input, so # we need to wrap the strings in StringIO objects. xml = io.StringIO(unicode(build_xml)) output = io.StringIO() @@ -1265,7 +1340,7 @@ def assert_variable_matches(self, var_name, regex, env=None, var=None): ############################################################################### -class TestMacrosBasic(unittest.TestCase): +class G_TestMacrosBasic(unittest.TestCase): ############################################################################### """Basic infrastructure tests. @@ -1278,19 +1353,19 @@ class TestMacrosBasic(unittest.TestCase): def test_script_is_callable(self): """The test script can be called on valid output without dying.""" # This is really more a smoke test of this script than anything else. - maker = MacroMaker("SomeOS", MockMachines("mymachine")) + maker = Build(MockMachines("mymachine", "SomeOS")) test_xml = _wrap_config_build_xml("FALSE") get_macros(maker, test_xml, "Makefile") def test_script_rejects_bad_xml(self): """The macro writer rejects input that's not valid XML.""" - maker = MacroMaker("SomeOS", MockMachines("mymachine")) + maker = Build(MockMachines("mymachine", "SomeOS")) with self.assertRaises(ParseError): get_macros(maker, "This is not valid XML.", "Makefile") def test_script_rejects_bad_build_system(self): """The macro writer rejects a bad build system string.""" - maker = MacroMaker("SomeOS", MockMachines("mymachine")) + maker = Build(MockMachines("mymachine", "SomeOS")) bad_string = "argle-bargle." with self.assertRaisesRegexp( SystemExit, @@ -1299,12 +1374,12 @@ def test_script_rejects_bad_build_system(self): ############################################################################### -class TestMakeMacros(unittest.TestCase): +class H_TestMakeMacros(unittest.TestCase): ############################################################################### """Makefile macros tests. - This class contains tests of the Makefile output of MacrosMaker. + This class contains tests of the Makefile output of Build. Aside from the usual setUp and test methods, this class has a utility method (xml_to_tester) that converts XML input directly to a MakefileTester object. @@ -1314,7 +1389,7 @@ class TestMakeMacros(unittest.TestCase): test_machine = "mymachine" def setUp(self): - self._maker = MacroMaker(self.test_os, MockMachines(self.test_machine)) + self._maker = Build(MockMachines(self.test_machine, self.test_os)) def xml_to_tester(self, xml_string): """Helper that directly converts an XML string to a MakefileTester.""" @@ -1573,13 +1648,12 @@ def test_variable_insertion_with_machine_specific_setting(self): ############################################################################### -@unittest.skipIf(FAST_ONLY, "Skipping slow CMake tests.") -class TestCMakeMacros(TestMakeMacros): +class I_TestCMakeMacros(H_TestMakeMacros): ############################################################################### """CMake macros tests. - This class contains tests of the CMake output of MacrosMaker. + This class contains tests of the CMake output of Build. This class simply inherits all of the methods of TestMakeOutput, but changes the definition of xml_to_tester to create a CMakeTester instead. @@ -1617,7 +1691,7 @@ def _main_func(): CIME.utils.handle_standard_logging_options(args) - unittest.main(verbosity=2) + unittest.main(verbosity=2, catchbreak=True) if (__name__ == "__main__"): _main_func() diff --git a/utils/python/update_acme_tests.py b/utils/python/update_acme_tests.py index b175eb35aa43..e605f6457c1d 100644 --- a/utils/python/update_acme_tests.py +++ b/utils/python/update_acme_tests.py @@ -10,31 +10,47 @@ # If testmods are needed, a 2-ple must be provided (test, mods) # If you want to restrict the test mods to certain machines, than a 3-ple is needed (test, mods, [machines]) _TEST_SUITES = { - "acme_tiny" : (None, + "cime_tiny" : (None, ("ERS.f19_g16_rx1.A", "NCK.f19_g16_rx1.A") ), - "acme_test_only_pass" : (None, + "cime_test_only_pass" : (None, ("TESTRUNPASS_Mmpi-serial.f19_g16_rx1.A", "TESTRUNPASS_Mmpi-serial.ne30_g16_rx1.A", "TESTRUNPASS_Mmpi-serial.f45_g37_rx1.A") ), - "acme_test_only_slow_pass" : (None, + "cime_test_only_slow_pass" : (None, ("TESTRUNSLOWPASS_Mmpi-serial.f19_g16_rx1.A", "TESTRUNSLOWPASS_Mmpi-serial.ne30_g16_rx1.A", "TESTRUNSLOWPASS_Mmpi-serial.f45_g37_rx1.A") ), - "acme_test_only" : (None, + "cime_test_only" : (None, ("TESTBUILDFAIL.f19_g16_rx1.A", + "TESTBUILDFAILEXC.f19_g16_rx1.A", "TESTRUNFAIL_Mmpi-serial.f19_g16_rx1.A", + "TESTRUNFAILEXC_Mmpi-serial.f19_g16_rx1.A", "TESTRUNPASS_Mmpi-serial.f19_g16_rx1.A", "TESTMEMLEAKFAIL_Mmpi-serial.f19_g16.X", "TESTMEMLEAKPASS_Mmpi-serial.f19_g16.X") ), + "cime_developer" : (None, + ("NCK_Ld3.f45_g37_rx1.A", + "ERI.f45_g37.X", + "SEQ_Ln9.f19_g16_rx1.A", + "ERS_Ld3.ne30_g16_rx1.A", + "ERS_N2_Ld3.f19_g16_rx1.A", + "ERR_Ld3.f45_g37_rx1.A", + "SMS_D_Ln9_Mmpi-serial.f19_g16_rx1.A") + ), + + # + # ACME tests below + # + "acme_runoff_developer" : (None, ("SMS.f19_f19.IM1850CLM45CN", "SMS.f19_f19.IMCLM45") @@ -63,16 +79,6 @@ "SMS_D.f19_g16.FC5ATMMODCOSP") ), - "cime_developer" : (None, - ("NCK_Ld3.f45_g37_rx1.A", - "ERI.f45_g37.X", - "SEQ_Ln9.f19_g16_rx1.A", - "ERS_Ld3.ne30_g16_rx1.A", - "ERS_N2_Ld3.f19_g16_rx1.A", - "ERR_Ld3.f45_g37_rx1.A", - "SMS_D_Ln9_Mmpi-serial.f19_g16_rx1.A") - ), - "acme_developer" : ("acme_land_developer", ("ERS.f19_g16_rx1.A", "ERS.f45_g37_rx1.DTEST", @@ -194,16 +200,16 @@ def get_full_test_names(testargs, machine, compiler): Testargs can be categories or test names and support the NOT symbol '^' - >>> get_full_test_names(["acme_tiny"], "melvin", "gnu") + >>> get_full_test_names(["cime_tiny"], "melvin", "gnu") ['ERS.f19_g16_rx1.A.melvin_gnu', 'NCK.f19_g16_rx1.A.melvin_gnu'] - >>> get_full_test_names(["acme_tiny", "PEA_P1_M.f45_g37_rx1.A"], "melvin", "gnu") + >>> get_full_test_names(["cime_tiny", "PEA_P1_M.f45_g37_rx1.A"], "melvin", "gnu") ['ERS.f19_g16_rx1.A.melvin_gnu', 'NCK.f19_g16_rx1.A.melvin_gnu', 'PEA_P1_M.f45_g37_rx1.A.melvin_gnu'] >>> get_full_test_names(['ERS.f19_g16_rx1.A', 'NCK.f19_g16_rx1.A', 'PEA_P1_M.f45_g37_rx1.A'], "melvin", "gnu") ['ERS.f19_g16_rx1.A.melvin_gnu', 'NCK.f19_g16_rx1.A.melvin_gnu', 'PEA_P1_M.f45_g37_rx1.A.melvin_gnu'] - >>> get_full_test_names(["acme_tiny", "^NCK.f19_g16_rx1.A"], "melvin", "gnu") + >>> get_full_test_names(["cime_tiny", "^NCK.f19_g16_rx1.A"], "melvin", "gnu") ['ERS.f19_g16_rx1.A.melvin_gnu'] """ expect(machine is not None, "Must define a machine")