From ba848b9099952c210f3c76e4f155215866513aac Mon Sep 17 00:00:00 2001 From: anton-climate Date: Tue, 5 Dec 2023 11:19:42 +1100 Subject: [PATCH 01/32] add gadi standalone setup --- configuration/scripts/cice.batch.csh | 13 ++++ configuration/scripts/cice.launch.csh | 12 ++++ .../scripts/machines/Macros.gadi_intel | 66 +++++++++++++++++++ configuration/scripts/machines/env.gadi_intel | 60 +++++++++++++++++ 4 files changed, 151 insertions(+) create mode 100644 configuration/scripts/machines/Macros.gadi_intel create mode 100644 configuration/scripts/machines/env.gadi_intel diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 33b27cbf8..0ff80f0a4 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -48,6 +48,19 @@ cat >> ${jobfile} << EOFB ###PBS -m be EOFB +else if (${ICE_MACHINE} =~ gadi*) then +cat >> ${jobfile} << EOFB +#PBS -q ${queue} +#PBS -P ${ICE_MACHINE_PROJ} +#PBS -l storage=gdata/ICE_MACHINE_PROJECT+scratch/ICE_MACHINE_PROJECT+gdata/ik11 +#PBS -N ${ICE_CASENAME} +#PBS -l ncpus=${ncores} +#PBS -l walltime=${batchtime} +#PBS -W umask=022 +#PBS -o ${ICE_CASEDIR} +#PBS -e ${ICE_CASEDIR} +EOFB + else if (${ICE_MACHINE} =~ gust*) then cat >> ${jobfile} << EOFB #PBS -q ${queue} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index f8347e101..8a9a17392 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -46,6 +46,18 @@ mpiexec --cpu-bind depth -n ${ntasks} -ppn ${taskpernodelimit} -d ${nthrds} ./ci EOFR endif +#======= +else if (${ICE_MACHCOMP} =~ gadi*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +mpiexec -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + #======= else if (${ICE_MACHCOMP} =~ hobart* || ${ICE_MACHCOMP} =~ izumi*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/machines/Macros.gadi_intel b/configuration/scripts/machines/Macros.gadi_intel new file mode 100644 index 000000000..0c25ed539 --- /dev/null +++ b/configuration/scripts/machines/Macros.gadi_intel @@ -0,0 +1,66 @@ +#============================================================================== +# Makefile macros for NCI Gadi, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise # -xHost + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) +# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg + FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := icx +SFC := ifort +MPICC := mpicc +MPIFC := mpifort + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#PNETCDF_PATH := $(PNETCDF) +INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +ifeq ($(ICE_IOTYPE), pio1) + LIB_PIO := $(PIO_LIBDIR) + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + CPPDEFS := $(CPPDEFS) + LIB_PIO := $(PIO_LIBDIR) + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/env.gadi_intel b/configuration/scripts/machines/env.gadi_intel new file mode 100644 index 000000000..93ed39098 --- /dev/null +++ b/configuration/scripts/machines/env.gadi_intel @@ -0,0 +1,60 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + + source /etc/profile.d/modules.csh + + module purge + module load intel-compiler + module load openmpi + module load netcdf + + if ($?ICE_IOTYPE) then + if ($ICE_IOTYPE =~ pio*) then + if ($ICE_IOTYPE == "pio1") then + # unchecked + module load pnetcdf + module load pio + else + module load parallelio + endif + endif + endif + + if ($?ICE_BFBTYPE) then + if ($ICE_BFBTYPE =~ qcchk*) then + # conda/analysis has the required librarys, skip building from cice yaml file + module use /g/data/hh5/public/modules + module load conda/analysis + # conda env create -f ../../configuration/scripts/tests/qctest.yml + # conda activate qctest + endif + endif + +endif + +# May be needed for OpenMP memory +#export OMP_STACKSIZE 64M +# OMP runtime diagnostics +#export OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME gadi +setenv ICE_MACHINE_MACHINFO "Intel Xeon Scalable" +setenv ICE_MACHINE_ENVNAME intel +# setenv ICE_MACHINE_ENVINFO ${module list} +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /scratch/$PROJECT/$USER/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /g/data/tm70/as2285 +setenv ICE_MACHINE_BASELINE /scratch/$PROJECT/$USER/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_PROJ $PROJECT +setenv ICE_MACHINE_ACCT $USER +setenv ICE_MACHINE_QUEUE "normal" +setenv ICE_MACHINE_TPNODE 48 +setenv ICE_MACHINE_BLDTHRDS 4 +setenv ICE_MACHINE_QSTAT "qstat " From 3551dbdfb1c5097d47e81fde5898804d488c5d10 Mon Sep 17 00:00:00 2001 From: anton-climate Date: Tue, 5 Dec 2023 14:50:38 +1100 Subject: [PATCH 02/32] updates for cice standalone on gadi --- configuration/scripts/cice.batch.csh | 16 ++++++++++++---- configuration/scripts/cice.launch.csh | 2 +- configuration/scripts/cice.settings | 11 ++++++----- configuration/scripts/machines/Macros.gadi_intel | 4 +--- configuration/scripts/machines/env.gadi_intel | 5 ----- 5 files changed, 20 insertions(+), 18 deletions(-) diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 0ff80f0a4..4fd3ad2ae 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -49,16 +49,24 @@ cat >> ${jobfile} << EOFB EOFB else if (${ICE_MACHINE} =~ gadi*) then +if (${queue} =~ *sr) then #sapphire rapids + @ memuse = ( $ncores * 481 / 100 ) +else if (${queue} =~ *bw) then #broadwell + @ memuse = ( $ncores * 457 / 100 ) +else if (${queue} =~ *sl) then #broadwell + @ memuse = ( $ncores * 6 ) +else #normal queues + @ memuse = ( $ncores * 395 / 100 ) +endif cat >> ${jobfile} << EOFB #PBS -q ${queue} #PBS -P ${ICE_MACHINE_PROJ} -#PBS -l storage=gdata/ICE_MACHINE_PROJECT+scratch/ICE_MACHINE_PROJECT+gdata/ik11 #PBS -N ${ICE_CASENAME} -#PBS -l ncpus=${ncores} -#PBS -l walltime=${batchtime} +#PBS -l storage=gdata/${ICE_MACHINE_PROJ}+scratch/${ICE_MACHINE_PROJ}+gdata/ik11 +#PBS -l ncpus=${ncores}:mem=${memuse}gb:walltime=${batchtime} +#PBS -j oe #PBS -W umask=022 #PBS -o ${ICE_CASEDIR} -#PBS -e ${ICE_CASEDIR} EOFB else if (${ICE_MACHINE} =~ gust*) then diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 8a9a17392..8b4b85bfd 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -54,7 +54,7 @@ cat >> ${jobfile} << EOFR EOFR else cat >> ${jobfile} << EOFR -mpiexec -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE +mpiexec -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE #check this re:threading?? EOFR endif diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index ee4709940..38962dc02 100644 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -1,13 +1,13 @@ #!/bin/csh -f setenv ICE_CASENAME undefined -setenv ICE_SANDBOX undefined -setenv ICE_MACHINE undefined -setenv ICE_ENVNAME undefined +setenv ICE_SANDBOX /scratch/${PROJECT}/${USER}/cice-dirs +setenv ICE_MACHINE gadi +setenv ICE_ENVNAME intel setenv ICE_MACHCOMP undefined setenv ICE_SCRIPTS undefined -setenv ICE_CASEDIR undefined -setenv ICE_RUNDIR /glade/scratch/tcraig/CICE_RUNS/${ICE_CASENAME} +setenv ICE_CASEDIR /scratch/${PROJECT}/${USER}/cice-dirs/cases/${ICE_CASENAME} +setenv ICE_RUNDIR /scratch/${PROJECT}/${USER}/cice-dirs/output/${ICE_CASENAME} setenv ICE_OBJDIR ${ICE_RUNDIR}/compile setenv ICE_RSTDIR ${ICE_RUNDIR}/restart setenv ICE_HSTDIR ${ICE_RUNDIR}/history @@ -35,6 +35,7 @@ setenv ICE_RUNLENGTH -1 setenv ICE_MEMUSE -1 setenv ICE_ACCOUNT undefined setenv ICE_QUEUE undefined +setenv ICE_BLDDEBUG true #====================================================== diff --git a/configuration/scripts/machines/Macros.gadi_intel b/configuration/scripts/machines/Macros.gadi_intel index 0c25ed539..aa8b14c47 100644 --- a/configuration/scripts/machines/Macros.gadi_intel +++ b/configuration/scripts/machines/Macros.gadi_intel @@ -4,7 +4,7 @@ CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise # -xHost +CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR @@ -12,9 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) -# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 -# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/env.gadi_intel b/configuration/scripts/machines/env.gadi_intel index 93ed39098..2de4aa8ad 100644 --- a/configuration/scripts/machines/env.gadi_intel +++ b/configuration/scripts/machines/env.gadi_intel @@ -38,11 +38,6 @@ if ("$inp" != "-nomodules") then endif -# May be needed for OpenMP memory -#export OMP_STACKSIZE 64M -# OMP runtime diagnostics -#export OMP_DISPLAY_ENV TRUE - setenv ICE_MACHINE_MACHNAME gadi setenv ICE_MACHINE_MACHINFO "Intel Xeon Scalable" setenv ICE_MACHINE_ENVNAME intel From 4f871cb4d654ef2959f91f32873ef40807819c15 Mon Sep 17 00:00:00 2001 From: anton-climate Date: Tue, 5 Dec 2023 15:06:13 +1100 Subject: [PATCH 03/32] fixes --- configuration/scripts/cice.batch.csh | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 4fd3ad2ae..1a9377f0a 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -53,7 +53,7 @@ if (${queue} =~ *sr) then #sapphire rapids @ memuse = ( $ncores * 481 / 100 ) else if (${queue} =~ *bw) then #broadwell @ memuse = ( $ncores * 457 / 100 ) -else if (${queue} =~ *sl) then #broadwell +else if (${queue} =~ *sl) then @ memuse = ( $ncores * 6 ) else #normal queues @ memuse = ( $ncores * 395 / 100 ) @@ -63,7 +63,9 @@ cat >> ${jobfile} << EOFB #PBS -P ${ICE_MACHINE_PROJ} #PBS -N ${ICE_CASENAME} #PBS -l storage=gdata/${ICE_MACHINE_PROJ}+scratch/${ICE_MACHINE_PROJ}+gdata/ik11 -#PBS -l ncpus=${ncores}:mem=${memuse}gb:walltime=${batchtime} +#PBS -l ncpus=${ncores} +#PBS -l mem=${memuse}gb +#PBS -l walltime=${batchtime} #PBS -j oe #PBS -W umask=022 #PBS -o ${ICE_CASEDIR} From 8c728e5ab1cc78eea6d3194da1fe6cb7d15dfb5e Mon Sep 17 00:00:00 2001 From: anton-climate Date: Wed, 6 Dec 2023 16:56:15 +1100 Subject: [PATCH 04/32] this builds now for pio2 but is messy --- configuration/scripts/cice.launch.csh | 2 +- .../scripts/machines/Macros.gadi_intel | 20 ++++++++++++++++--- configuration/scripts/machines/env.gadi_intel | 6 ++++-- 3 files changed, 22 insertions(+), 6 deletions(-) diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 8b4b85bfd..f8a177b46 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -54,7 +54,7 @@ cat >> ${jobfile} << EOFR EOFR else cat >> ${jobfile} << EOFR -mpiexec -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE #check this re:threading?? +mpirun -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE EOFR endif diff --git a/configuration/scripts/machines/Macros.gadi_intel b/configuration/scripts/machines/Macros.gadi_intel index aa8b14c47..487f77eb9 100644 --- a/configuration/scripts/machines/Macros.gadi_intel +++ b/configuration/scripts/machines/Macros.gadi_intel @@ -8,7 +8,7 @@ CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) @@ -58,7 +58,21 @@ endif ifeq ($(ICE_IOTYPE), pio2) CPPDEFS := $(CPPDEFS) - LIB_PIO := $(PIO_LIBDIR) - SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc + LIBRARY_PATH := /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-c-4.9.2-qtuky2a/lib64 + SLIBS := -L$(LIBRARY_PATH) -lnetcdf + + LIBRARY_PATH := /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-fortran-4.6.0-zfqomcv/lib + SLIBS := $(SLIBS) -L$(LIBRARY_PATH) -lnetcdff + + LIBRARY_PATH := /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/parallelio-2.5.10-hyj75i7/lib + SLIBS := $(SLIBS) -L$(LIBRARY_PATH) -lpioc -lpiof + + LIBRARY_PATH := /apps/openmpi/4.1.5/lib/ + SLIBS := $(SLIBS) -L$(LIBRARY_PATH) -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh + + INCLDIR := -I /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/parallelio-2.5.10-hyj75i7/include + INCLDIR += -I /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-c-4.9.2-qtuky2a/include + INCLDIR += -I /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-fortran-4.6.0-zfqomcv/include + endif diff --git a/configuration/scripts/machines/env.gadi_intel b/configuration/scripts/machines/env.gadi_intel index 2de4aa8ad..00bcea6f7 100644 --- a/configuration/scripts/machines/env.gadi_intel +++ b/configuration/scripts/machines/env.gadi_intel @@ -12,8 +12,7 @@ if ("$inp" != "-nomodules") then module purge module load intel-compiler module load openmpi - module load netcdf - + if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then if ($ICE_IOTYPE == "pio1") then @@ -21,8 +20,11 @@ if ("$inp" != "-nomodules") then module load pnetcdf module load pio else + module use /g/data/ik11/spack/0.20.1/modules/access-om3/0.x.0/linux-rocky8-cascadelake #this path is not stable, is there a better way to do this?? module load parallelio endif + else + module load netcdf endif endif From 5d957770c10e07117cd70f8548001536898edc28 Mon Sep 17 00:00:00 2001 From: anton-climate Date: Mon, 11 Dec 2023 12:00:10 +1100 Subject: [PATCH 05/32] testing --- .../scripts/machines/Macros.gadi_intel | 46 +++++++++---------- configuration/scripts/machines/env.gadi_intel | 3 +- 2 files changed, 23 insertions(+), 26 deletions(-) diff --git a/configuration/scripts/machines/Macros.gadi_intel b/configuration/scripts/machines/Macros.gadi_intel index 487f77eb9..f0301d711 100644 --- a/configuration/scripts/machines/Macros.gadi_intel +++ b/configuration/scripts/machines/Macros.gadi_intel @@ -31,19 +31,23 @@ else endif LD:= $(FC) -NETCDF_PATH := $(NETCDF) - PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs -#PNETCDF_PATH := $(PNETCDF) +SLIBS := $(SLIBS) INCLDIR := $(INCLDIR) -LIB_NETCDF := $(NETCDF_PATH)/lib -#LIB_PNETCDF := $(PNETCDF_PATH)/lib -LIB_MPI := $(IMPILIBDIR) +ifndef SPACK_NETCDF_FORTRAN_ROOT + SLIBS += -L$(NETCDF)/lib -lnetcdf -lnetcdff +else + SLIBS += -L$(SPACK_NETCDF_C_ROOT)/lib64 -lnetcdf + SLIBS += -L$(SPACK_NETCDF_FORTRAN_ROOT)/lib -lnetcdff + INCLDIR += -I $(SPACK_NETCDF_C_ROOT)/include + INCLDIR += -I $(SPACK_NETCDF_FORTRAN_ROOT)/include +endif -#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff +#LIB_MPI := $(IMPILIBDIR) +#LIB_PNETCDF := $(PNETCDF)/lib +#SLIBS += L$(LIB_PNETCDF) -lpnetcdf ifeq ($(ICE_THREADED), true) LDFLAGS += -qopenmp @@ -53,26 +57,18 @@ endif ifeq ($(ICE_IOTYPE), pio1) LIB_PIO := $(PIO_LIBDIR) - SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio + SLIBS += -L$(LIB_PIO) -lpio endif ifeq ($(ICE_IOTYPE), pio2) - CPPDEFS := $(CPPDEFS) - LIBRARY_PATH := /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-c-4.9.2-qtuky2a/lib64 - SLIBS := -L$(LIBRARY_PATH) -lnetcdf - - LIBRARY_PATH := /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-fortran-4.6.0-zfqomcv/lib - SLIBS := $(SLIBS) -L$(LIBRARY_PATH) -lnetcdff - - LIBRARY_PATH := /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/parallelio-2.5.10-hyj75i7/lib - SLIBS := $(SLIBS) -L$(LIBRARY_PATH) -lpioc -lpiof - - LIBRARY_PATH := /apps/openmpi/4.1.5/lib/ - SLIBS := $(SLIBS) -L$(LIBRARY_PATH) -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh - - INCLDIR := -I /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/parallelio-2.5.10-hyj75i7/include - INCLDIR += -I /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-c-4.9.2-qtuky2a/include - INCLDIR += -I /g/data/ik11/spack/0.20.1/opt/linux-rocky8-cascadelake/intel-2021.6.0/netcdf-fortran-4.6.0-zfqomcv/include + ifndef SPACK_PARALLELIO_ROOT + SLIBS += -L$(PARALLELIO_ROOT)/lib -lpioc -lpiof + else + SLIBS += -L$(SPACK_PARALLELIO_ROOT)/lib -lpioc -lpiof + INCLDIR += -I $(SPACK_PARALLELIO_ROOT)/include + endif + + SLIBS += $(SLIBS) -L$(OMPI_BASE)/lib -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh endif diff --git a/configuration/scripts/machines/env.gadi_intel b/configuration/scripts/machines/env.gadi_intel index 00bcea6f7..f4fd2da71 100644 --- a/configuration/scripts/machines/env.gadi_intel +++ b/configuration/scripts/machines/env.gadi_intel @@ -16,8 +16,9 @@ if ("$inp" != "-nomodules") then if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then if ($ICE_IOTYPE == "pio1") then - # unchecked + # we don't have pio1 installed anywhere module load pnetcdf + module load netcdf module load pio else module use /g/data/ik11/spack/0.20.1/modules/access-om3/0.x.0/linux-rocky8-cascadelake #this path is not stable, is there a better way to do this?? From 028a376705d5b7bbde0420c1f26d5b1d5ca6ee30 Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Mon, 11 Dec 2023 12:05:27 +1100 Subject: [PATCH 06/32] Update test-cice.yml --- .github/workflows/test-cice.yml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index b04ca1714..1ae99921a 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -6,10 +6,6 @@ name: GHActions on: push: - branches: - - main - - 'CICE*' - - 'ghactions*' pull_request: release: types: From 7f38886dd8591599c1ec96ddb5520384bbe808f3 Mon Sep 17 00:00:00 2001 From: anton-seaice Date: Mon, 11 Dec 2023 12:09:08 +1100 Subject: [PATCH 07/32] workflows --- .github/workflows/test-cice.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 1ae99921a..837819684 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -5,7 +5,7 @@ name: GHActions # To Do: get it working with bash and ubuntu on: - push: + push pull_request: release: types: From 7a2c07259d91ac1464628ce504c7ebc56fab7ce4 Mon Sep 17 00:00:00 2001 From: anton-seaice Date: Mon, 11 Dec 2023 12:10:46 +1100 Subject: [PATCH 08/32] workflows --- .github/workflows/test-cice.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 837819684..933d04c23 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -6,7 +6,7 @@ name: GHActions on: push - pull_request: + pull_request release: types: - created From 50f06562de6e8ca9deae7b168782e3aa3370b46d Mon Sep 17 00:00:00 2001 From: anton-seaice Date: Mon, 11 Dec 2023 12:11:52 +1100 Subject: [PATCH 09/32] workflows --- .github/workflows/test-cice.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 933d04c23..1ae99921a 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -5,8 +5,8 @@ name: GHActions # To Do: get it working with bash and ubuntu on: - push - pull_request + push: + pull_request: release: types: - created From 2a7b25b15246db7e63937f9c33d6a40d94a0f505 Mon Sep 17 00:00:00 2001 From: anton-seaice Date: Mon, 11 Dec 2023 13:14:32 +1100 Subject: [PATCH 10/32] cice.settings? --- configuration/scripts/cice.settings | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index 38962dc02..ee4709940 100644 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -1,13 +1,13 @@ #!/bin/csh -f setenv ICE_CASENAME undefined -setenv ICE_SANDBOX /scratch/${PROJECT}/${USER}/cice-dirs -setenv ICE_MACHINE gadi -setenv ICE_ENVNAME intel +setenv ICE_SANDBOX undefined +setenv ICE_MACHINE undefined +setenv ICE_ENVNAME undefined setenv ICE_MACHCOMP undefined setenv ICE_SCRIPTS undefined -setenv ICE_CASEDIR /scratch/${PROJECT}/${USER}/cice-dirs/cases/${ICE_CASENAME} -setenv ICE_RUNDIR /scratch/${PROJECT}/${USER}/cice-dirs/output/${ICE_CASENAME} +setenv ICE_CASEDIR undefined +setenv ICE_RUNDIR /glade/scratch/tcraig/CICE_RUNS/${ICE_CASENAME} setenv ICE_OBJDIR ${ICE_RUNDIR}/compile setenv ICE_RSTDIR ${ICE_RUNDIR}/restart setenv ICE_HSTDIR ${ICE_RUNDIR}/history @@ -35,7 +35,6 @@ setenv ICE_RUNLENGTH -1 setenv ICE_MEMUSE -1 setenv ICE_ACCOUNT undefined setenv ICE_QUEUE undefined -setenv ICE_BLDDEBUG true #====================================================== From 3ea282c575c4511c5106aad2a312791aa95d8a5c Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Mon, 11 Dec 2023 16:21:47 +1100 Subject: [PATCH 11/32] Update test-cice.yml --- .github/workflows/test-cice.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 1ae99921a..019f8038f 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -162,6 +162,11 @@ jobs: ./.github/workflows/write_logfiles.csh cd testsuite.${{ matrix.os }} ./results.csh + - name: get logs + uses: actions/download-artifact@v3 + with: + name: logs + path: $HOME/cice/testsuite.${{ matrix.os }}/*/logs/cice.runlog.* - name: successful run if: ${{ success() }} run: | From eddf67b7b62404e585cd5c65a2d60983644819b8 Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Mon, 11 Dec 2023 16:52:33 +1100 Subject: [PATCH 12/32] Update test-cice.yml --- .github/workflows/test-cice.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 019f8038f..e83520fa1 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -156,17 +156,17 @@ jobs: run: | cd $HOME/cice ./cice.setup -m conda -e ${{ matrix.envdef }} --suite travis_suite --testid ${{ matrix.os }} + - name: get logs + uses: actions/download-artifact@v3 + with: + name: logs + path: $HOME/cice/testsuite.${{ matrix.os }}/*/logs/cice.runlog.* - name: write output run: | cd $HOME/cice ./.github/workflows/write_logfiles.csh cd testsuite.${{ matrix.os }} ./results.csh - - name: get logs - uses: actions/download-artifact@v3 - with: - name: logs - path: $HOME/cice/testsuite.${{ matrix.os }}/*/logs/cice.runlog.* - name: successful run if: ${{ success() }} run: | From 851bdbd974cac99c7d3f7b8a7c21744663aeb676 Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Thu, 30 Nov 2023 14:06:37 +1100 Subject: [PATCH 13/32] Parallel IO on MacOS Conda: --- configuration/scripts/cice.settings | 2 +- configuration/scripts/machines/Macros.conda_macos | 2 +- configuration/scripts/machines/environment.yml | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index ee4709940..92ce8d006 100644 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -14,7 +14,7 @@ setenv ICE_HSTDIR ${ICE_RUNDIR}/history setenv ICE_LOGDIR ${ICE_CASEDIR}/logs setenv ICE_DRVOPT standalone/cice setenv ICE_TARGET cice -setenv ICE_IOTYPE netcdf # binary, netcdf, pio1, pio2 +setenv ICE_IOTYPE pio2 # binary, netcdf, pio1, pio2 setenv ICE_CLEANBUILD true setenv ICE_CPPDEFS "" setenv ICE_QUIETMODE false diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index fad87507c..a74605a85 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -51,7 +51,7 @@ else endif # Libraries to be passed to the linker -SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh -lmpi +SLIBS := -L$(CONDA_PREFIX)/lib -lpiof -lnetcdf -lnetcdff -llapack -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh -lmpi # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) diff --git a/configuration/scripts/machines/environment.yml b/configuration/scripts/machines/environment.yml index e76ff692f..30ed1e148 100644 --- a/configuration/scripts/machines/environment.yml +++ b/configuration/scripts/machines/environment.yml @@ -6,6 +6,7 @@ dependencies: # Build dependencies - compilers - netcdf-fortran + - parallelio - openmpi - make - liblapack From 2c78c329342853277f95e121ebe481cf929ab085 Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Fri, 1 Dec 2023 14:33:31 +1100 Subject: [PATCH 14/32] simple netcdf4 --- .../infrastructure/io/io_pio2/ice_pio.F90 | 16 ++++++++-------- .../infrastructure/io/io_pio2/ice_restart.F90 | 4 ++-- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index b242f542b..9482ff671 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -94,11 +94,11 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) !--- initialize type of io !pio_iotype = PIO_IOTYPE_PNETCDF !pio_iotype = PIO_IOTYPE_NETCDF4C - !pio_iotype = PIO_IOTYPE_NETCDF4P - pio_iotype = PIO_IOTYPE_NETCDF - if (present(iotype)) then - pio_iotype = iotype - endif + pio_iotype = PIO_IOTYPE_NETCDF4P + !pio_iotype = PIO_IOTYPE_NETCDF + !if (present(iotype)) then + ! pio_iotype = iotype + !endif !--- initialize ice_pio_subsystem nprocs = get_num_procs() @@ -146,7 +146,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) if (present(clobber)) lclobber=clobber lcdf64 = .false. - if (present(cdf64)) lcdf64=cdf64 + !if (present(cdf64)) lcdf64=cdf64 if (File%fh<0) then ! filename not open @@ -154,7 +154,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) if (exists) then if (lclobber) then nmode = pio_clobber - if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) + !if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) @@ -168,7 +168,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) endif else nmode = pio_noclobber - if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) + !if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index aefcf61f9..44b0ec110 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -223,8 +223,8 @@ subroutine init_restart_write(filename_spec) ! if (restart_format(1:3) == 'pio') then - iotype = PIO_IOTYPE_NETCDF - if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF + iotype = PIO_IOTYPE_NETCDF4P + !if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 call ice_pio_init(mode='write',filename=trim(filename), File=File, & clobber=.true., cdf64=lcdf64, iotype=iotype) From ba4e79582c7cd80ddf9c947670a64124bf6fe6a1 Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Thu, 14 Dec 2023 17:03:26 +1100 Subject: [PATCH 15/32] pio error handling --- .../io/io_pio2/ice_history_write.F90 | 336 +++++++++++------- .../infrastructure/io/io_pio2/ice_pio.F90 | 43 ++- 2 files changed, 246 insertions(+), 133 deletions(-) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index cf2f40521..192c7165e 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -1,6 +1,6 @@ !======================================================================= ! -! Writes history in netCDF format +! Writes history in netCDF format using NCAR ParallelIO library ! ! authors Tony Craig and Bruce Briegleb, NCAR ! Elizabeth C. Hunke and William H. Lipscomb, LANL @@ -194,61 +194,92 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- if (hist_avg(ns) .and. .not. write_ic) then - status = pio_def_dim(File,'nbnd',2,boundid) + call ice_pio_check(pio_def_dim(File,'nbnd',2,boundid), & + subname//'ERROR: defining dim nbnd with len 2') endif - status = pio_def_dim(File,'ni',nx_global,imtid) - status = pio_def_dim(File,'nj',ny_global,jmtid) - status = pio_def_dim(File,'nc',ncat_hist,cmtid) - status = pio_def_dim(File,'nkice',nzilyr,kmtidi) - status = pio_def_dim(File,'nksnow',nzslyr,kmtids) - status = pio_def_dim(File,'nkbio',nzblyr,kmtidb) - status = pio_def_dim(File,'nkaer',nzalyr,kmtida) - status = pio_def_dim(File,'time',PIO_UNLIMITED,timid) - status = pio_def_dim(File,'nvertices',nverts,nvertexid) - status = pio_def_dim(File,'nf',nfsd_hist,fmtid) + call ice_pio_check(pio_def_dim(File,'ni',nx_global,imtid), & + subname//'ERROR: defining dim ni') + + call ice_pio_check(pio_def_dim(File,'nj',ny_global,jmtid), & + subname//'ERROR: defining dim nj') + + call ice_pio_check(pio_def_dim(File,'nc',ncat_hist,cmtid), & + subname//'ERROR: defining dim nc') + + call ice_pio_check(pio_def_dim(File,'nkice',nzilyr,kmtidi), & + subname//'ERROR: defining dim nkice') + + call ice_pio_check(pio_def_dim(File,'nksnow',nzslyr,kmtids), & + subname//'ERROR: defining dim nksnow') + + call ice_pio_check(pio_def_dim(File,'nkbio',nzblyr,kmtidb), & + subname//'ERROR: defining dim nkbio') + + call ice_pio_check(pio_def_dim(File,'nkaer',nzalyr,kmtida), & + subname//'ERROR: defining dim nkaer') + + call ice_pio_check(pio_def_dim(File,'time',PIO_UNLIMITED,timid), & + subname//'ERROR: defining dim time') + + call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & + subname//'ERROR: defining dim nverticies') + + call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & + subname//'ERROR: defining dim nf') !----------------------------------------------------------------- ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- - status = pio_def_var(File,'time',pio_double,(/timid/),varid) - status = pio_put_att(File,varid,'long_name','time') + call ice_pio_check(pio_def_var(File,'time',pio_double,(/timid/),varid), & + subname//'ERROR: defining var time') + call ice_pio_check(pio_put_att(File,varid,'long_name','time'), & + subname//'ERROR: defining attribute "long_name" as "time"') write(cdate,'(i8.8)') idate0 write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & hh_init,':',mm_init,':',ss_init - status = pio_put_att(File,varid,'units',trim(title)) + call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & + subname//'ERROR: defining attribute "units" as '//trim(title)) if (days_per_year == 360) then - status = pio_put_att(File,varid,'calendar','360_day') + call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & + subname//'ERROR: defining calendar') elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = pio_put_att(File,varid,'calendar','noleap') + call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & + subname//'ERROR: defining calendar') elseif (use_leap_years) then - status = pio_put_att(File,varid,'calendar','Gregorian') + call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & + subname//'ERROR: defining calendar') else call abort_ice(subname//'ERROR: invalid calendar settings') endif if (hist_avg(ns) .and. .not. write_ic) then - status = pio_put_att(File,varid,'bounds','time_bounds') + call ice_pio_check(pio_put_att(File,varid,'bounds','time_bounds'), & + subname//'ERROR: defining attribute "bounds" as "time_bounds"') endif ! Define attributes for time_bounds if hist_avg is true if (hist_avg(ns) .and. .not. write_ic) then dimid2(1) = boundid dimid2(2) = timid - status = pio_def_var(File,'time_bounds',pio_double,dimid2,varid) - status = pio_put_att(File,varid,'long_name', & - 'time interval endpoints') + call ice_pio_check(pio_def_var(File,'time_bounds',pio_double,dimid2,varid), & + subname//'ERROR: defining var time_bounds') + call ice_pio_check(pio_put_att(File,varid,'long_name', 'time interval endpoints'), & + subname//'ERROR: defining attribute "long_name" as "time interval endpoints"') if (days_per_year == 360) then - status = pio_put_att(File,varid,'calendar','360_day') + call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & + subname//'ERROR: defining calendar for time_bounds') elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = pio_put_att(File,varid,'calendar','noleap') + call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & + subname//'ERROR: defining calendar for time_bounds') elseif (use_leap_years) then - status = pio_put_att(File,varid,'calendar','Gregorian') + call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & + subname//'ERROR: defining calendar for time_bounds') else call abort_ice(subname//'ERROR: invalid calendar settings') endif @@ -257,7 +288,8 @@ subroutine ice_write_hist (ns) write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & hh_init,':',mm_init,':',ss_init - status = pio_put_att(File,varid,'units',trim(title)) + call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & + subname//'ERROR: defining attribute "units" as '//trim(title)) endif !----------------------------------------------------------------- @@ -406,17 +438,22 @@ subroutine ice_write_hist (ns) dimid2(2) = jmtid do i = 1, ncoord - status = pio_def_var(File, trim(var_coord(i)%short_name), lprecision, & - dimid2, varid) - status = pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)) - status = pio_put_att(File, varid, 'units', trim(var_coord(i)%units)) + call ice_pio_check(pio_def_var(File, trim(var_coord(i)%short_name), lprecision, & + dimid2, varid), & + subname//'ERROR: defining var'//trim(var_coord(i)%short_name)) + call ice_pio_check(pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)), & + subname//'ERROR: putting attribute "long_name" as '//trim(var_coord(i)%long_name)) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_coord(i)%units)), & + subname//'ERROR: putting attribute "units" as '//trim(var_coord(i)%units)) call ice_write_hist_fill(File,varid,var_coord(i)%short_name,history_precision) if (var_coord(i)%short_name == 'ULAT') then - status = pio_put_att(File,varid,'comment', & - trim('Latitude of NE corner of T grid cell')) + call ice_pio_check(pio_put_att(File,varid,'comment', & + trim('Latitude of NE corner of T grid cell')), & + subname//'ERROR: putting attribute "comment"') endif if (f_bounds) then - status = pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))) + call ice_pio_check(pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))), & + subname//'ERROR: putting attribute "bounds" as '//trim(coord_bounds(i))) endif enddo @@ -430,20 +467,27 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grdz if (igrdz(i)) then - status = pio_def_var(File, trim(var_grdz(i)%short_name), lprecision, & - (/dimidex(i)/), varid) - status = pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name) - status = pio_put_att(File, varid, 'units' , var_grdz(i)%units) + call ice_pio_check(pio_def_var(File, trim(var_grdz(i)%short_name), lprecision, & + (/dimidex(i)/), varid), & + subname//'ERROR: defining var'//trim(var_grdz(i)%short_name)) + call ice_pio_check(pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name), & + subname//'ERROR: putting attribute "long_name" as '//trim(var_grdz(i)%long_name)) + call ice_pio_check(pio_put_att(File, varid, 'units' , var_grdz(i)%units), & + subname//'ERROR: putting attribute "units" as '//trim(var_grdz(i)%units)) endif enddo do i = 1, nvar_grd if (igrd(i)) then - status = pio_def_var(File, trim(var_grd(i)%req%short_name), & - lprecision, dimid2, varid) - status = pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)) - status = pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)) - status = pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)) + call ice_pio_check(pio_def_var(File, trim(var_grd(i)%req%short_name), & + lprecision, dimid2, varid), & + subname//'ERROR: defining var'//trim(var_grd(i)%req%short_name)) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)), & + subname//'ERROR: putting attribute "long_name" as '//trim(var_grd(i)%req%long_name)) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)), & + subname//'ERROR: putting attribute "units" as '//trim(var_grd(i)%req%units)) + call ice_pio_check(pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)), & + subname//'ERROR: putting attribute "coordinates" as '//trim(var_grd(i)%coordinates)) call ice_write_hist_fill(File,varid,var_grd(i)%req%short_name,history_precision) endif enddo @@ -454,12 +498,13 @@ subroutine ice_write_hist (ns) dimid_nverts(3) = jmtid do i = 1, nvar_verts if (f_bounds) then - status = pio_def_var(File, trim(var_nverts(i)%short_name), & - lprecision,dimid_nverts, varid) - status = & - pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) - status = & - pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) + call ice_pio_check(pio_def_var(File, trim(var_nverts(i)%short_name), & + lprecision,dimid_nverts, varid), & + subname//'ERROR: defining var'//trim(var_nverts(i)%short_name)) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)), & + subname//'ERROR: putting attribute "long_name" as '//trim(var_nverts(i)%long_name)) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)), & + subname//'ERROR: putting attribute "units" as '//trim(var_nverts(i)%units)) call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) endif enddo @@ -478,8 +523,9 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimid3, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimid3, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_2D @@ -495,8 +541,9 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Dc @@ -512,8 +559,9 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Dz @@ -529,8 +577,9 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Db @@ -546,8 +595,9 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Da @@ -563,8 +613,9 @@ subroutine ice_write_hist (ns) do n = n3Dacum + 1, n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Df @@ -586,8 +637,9 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidcz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_4Di @@ -604,8 +656,9 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidcz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_4Ds @@ -623,8 +676,9 @@ subroutine ice_write_hist (ns) do n = n4Dscum + 1, n4Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid) + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & + lprecision, dimidcz, varid), & + subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_4Df @@ -635,29 +689,36 @@ subroutine ice_write_hist (ns) ! ... the user should change these to something useful ... !----------------------------------------------------------------- #ifdef CESMCOUPLED - status = pio_put_att(File,pio_global,'title',runid) + call ice_pio_check(pio_put_att(File,pio_global,'title',runid), & + subname//'ERROR: putting attribute "title" as '//runid) #else title = 'sea ice model output for CICE' - status = pio_put_att(File,pio_global,'title',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'title',trim(title)), & + subname//'ERROR: putting attribute "title" as '//trim(title)) #endif title = 'Diagnostic and Prognostic Variables' - status = pio_put_att(File,pio_global,'contents',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'contents',trim(title)), & + subname//'ERROR: putting attribute "contents" as '//trim(title)) write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) - status = pio_put_att(File,pio_global,'source',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'source',trim(title)), & + subname//'ERROR: putting attribute "source" as '//trim(title)) if (use_leap_years) then write(title,'(a,i3,a)') 'This year has ',dayyr,' days' else write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' endif - status = pio_put_att(File,pio_global,'comment',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'comment',trim(title)), & + subname//'ERROR: putting attribute "comment" as '//trim(title)) write(title,'(a,i8.8)') 'File written on model date ',idate - status = pio_put_att(File,pio_global,'comment2',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'comment2',trim(title)), & + subname//'ERROR: putting attribute '//trim(title)) write(title,'(a,i6)') 'seconds elapsed into model date: ',msec - status = pio_put_att(File,pio_global,'comment3',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'comment3',trim(title)), & + subname//'ERROR: putting attribute '//trim(title)) select case (histfreq(ns)) case ("y", "Y") @@ -673,15 +734,17 @@ subroutine ice_write_hist (ns) end select if (.not.write_ic .and. trim(time_period_freq) /= 'none') then - status = pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)) + call ice_pio_check(pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)), & + subname//'ERROR: putting attribute "time_period_freq" as '//trim(time_period_freq)) endif if (hist_avg(ns)) & - status = pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)) + call ice_pio_check(pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)), & + subname//'ERROR: putting attribute "time_axis_position" as '//trim(hist_time_axis)) title = 'CF-1.0' - status = & - pio_put_att(File,pio_global,'conventions',trim(title)) + call ice_pio_check(pio_put_att(File,pio_global,'conventions',trim(title)), & + subname//'ERROR: putting attribute "conventions" as '//trim(title)) call date_and_time(date=current_date, time=current_time) write(start_time,1000) current_date(1:4), current_date(5:6), & @@ -689,19 +752,23 @@ subroutine ice_write_hist (ns) current_time(3:4) 1000 format('This dataset was created on ', & a,'-',a,'-',a,' at ',a,':',a) - status = pio_put_att(File,pio_global,'history',trim(start_time)) + call ice_pio_check(pio_put_att(File,pio_global,'history',trim(start_time)), & + subname//'ERROR: putting attribute "history" as '//trim(start_time)) if (history_format == 'pio_pnetcdf') then - status = pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf') + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf'), & + subname//'ERROR: putting attribute "io_flavor"' ) else - status = pio_put_att(File,pio_global,'io_flavor','io_pio netcdf') + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio netcdf'), & + subname//'ERROR: putting attribute "io_flavor"' ) endif !----------------------------------------------------------------- ! end define mode !----------------------------------------------------------------- - status = pio_enddef(File) + call ice_pio_check(pio_enddef(File), & + subname//'ERROR: ending pio definitions') !----------------------------------------------------------------- ! write time variable @@ -716,20 +783,24 @@ subroutine ice_write_hist (ns) if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) endif - status = pio_inq_varid(File,'time',varid) - status = pio_put_var(File,varid,(/1/),ltime2) + call ice_pio_check(pio_inq_varid(File,'time',varid), & + subname//'ERROR: getting var "time"') + call ice_pio_check(pio_put_var(File,varid,(/1/),ltime2), & + subname//'ERROR: setting var "time"') !----------------------------------------------------------------- ! write time_bounds info !----------------------------------------------------------------- if (hist_avg(ns) .and. .not. write_ic) then - status = pio_inq_varid(File,'time_bounds',varid) + call ice_pio_check(pio_inq_varid(File,'time_bounds',varid), & + subname//'ERROR: getting "time_bounds"' ) time_bounds=(/time_beg(ns),time_end(ns)/) bnd_start = (/1,1/) bnd_length = (/2,1/) - status = pio_put_var(File,varid,ival=time_bounds, & - start=bnd_start(:),count=bnd_length(:)) + call ice_pio_check(pio_put_var(File,varid,ival=time_bounds, & + start=bnd_start(:),count=bnd_length(:)), & + subname//'ERROR: setting "time_bounds"' ) endif !----------------------------------------------------------------- @@ -740,7 +811,8 @@ subroutine ice_write_hist (ns) allocate(workr2(nx_block,ny_block,nblocks)) do i = 1,ncoord - status = pio_inq_varid(File, var_coord(i)%short_name, varid) + call ice_pio_check(pio_inq_varid(File, var_coord(i)%short_name, varid), & + subname//'ERROR: getting '//var_coord(i)%short_name ) SELECT CASE (var_coord(i)%short_name) CASE ('TLON') ! Convert T grid longitude from -180 -> 180 to 0 to 360 @@ -774,20 +846,27 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grdz if (igrdz(i)) then - status = pio_inq_varid(File, var_grdz(i)%short_name, varid) + call ice_pio_check(pio_inq_varid(File, var_grdz(i)%short_name, varid), & + subname//'ERROR: getting '//var_grdz(i)%short_name ) SELECT CASE (var_grdz(i)%short_name) CASE ('NCAT') - status = pio_put_var(File, varid, hin_max(1:ncat_hist)) + call ice_pio_check(pio_put_var(File, varid, hin_max(1:ncat_hist)), & + subname//'ERROR: setting '//var_grdz(i)%short_name ) CASE ('NFSD') - status = pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)) + call ice_pio_check(pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)), & + subname//'ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDi') - status = pio_put_var(File, varid, (/(k, k=1,nzilyr)/)) + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzilyr)/)), & + subname//'ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDs') - status = pio_put_var(File, varid, (/(k, k=1,nzslyr)/)) + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzslyr)/)), & + subname//'ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDb') - status = pio_put_var(File, varid, (/(k, k=1,nzblyr)/)) + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzblyr)/)), & + subname//'ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDa') - status = pio_put_var(File, varid, (/(k, k=1,nzalyr)/)) + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzalyr)/)), & + subname//'ERROR: setting '//var_grdz(i)%short_name ) END SELECT endif enddo @@ -842,7 +921,8 @@ subroutine ice_write_hist (ns) CASE ('ANGLET') workd2 = ANGLET(:,:,1:nblocks) END SELECT - status = pio_inq_varid(File, var_grd(i)%req%short_name, varid) + call ice_pio_check(pio_inq_varid(File, var_grd(i)%req%short_name, varid), & + subname//'ERROR: getting '//var_grd(i)%req%short_name ) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc2d, & workd2, status, fillval=spval_dbl) @@ -898,7 +978,8 @@ subroutine ice_write_hist (ns) enddo END SELECT - status = pio_inq_varid(File, var_nverts(i)%short_name, varid) + call ice_pio_check(pio_inq_varid(File, var_nverts(i)%short_name, varid), & + subname//'ERROR: getting '//var_nverts(i)%short_name ) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3dv, & workd3v, status, fillval=spval_dbl) @@ -920,8 +1001,7 @@ subroutine ice_write_hist (ns) ! 2D do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR getting varid for '//avail_hist_fields(n)%vname) workd2(:,:,:) = a2D(:,:,n,1:nblocks) #ifdef CESM1_PIO @@ -949,8 +1029,7 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum nn = n - n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, ncat_hist @@ -981,8 +1060,7 @@ subroutine ice_write_hist (ns) do n = n3Dccum+1, n3Dzcum nn = n - n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzilyr @@ -1013,8 +1091,7 @@ subroutine ice_write_hist (ns) do n = n3Dzcum+1, n3Dbcum nn = n - n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzblyr @@ -1045,8 +1122,7 @@ subroutine ice_write_hist (ns) do n = n3Dbcum+1, n3Dacum nn = n - n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzalyr @@ -1077,8 +1153,7 @@ subroutine ice_write_hist (ns) do n = n3Dacum+1, n3Dfcum nn = n - n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nfsd_hist @@ -1109,8 +1184,7 @@ subroutine ice_write_hist (ns) do n = n3Dfcum+1, n4Dicum nn = n - n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, ncat_hist @@ -1143,8 +1217,7 @@ subroutine ice_write_hist (ns) do n = n4Dicum+1, n4Dscum nn = n - n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, ncat_hist @@ -1177,8 +1250,7 @@ subroutine ice_write_hist (ns) do n = n4Dscum+1, n4Dfcum nn = n - n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, ncat_hist @@ -1256,16 +1328,21 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) integer (kind=int_kind) :: status character(len=*), parameter :: subname = '(ice_write_hist_attrs)' - status = pio_put_att(File,varid,'units', trim(hfield%vunit)) + call ice_pio_check(pio_put_att(File,varid,'units', trim(hfield%vunit)), & + 'ERROR: setting "units" as '//trim(hfield%vunit)) - status = pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)), & + 'ERROR: setting "long_name" as '//trim(hfield%vdesc)) - status = pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)) + call ice_pio_check(pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)), & + 'ERROR: setting "coordinates" as '//trim(hfield%vdesc)) - status = pio_put_att(File,varid,'cell_measures', trim(hfield%vcellmeas)) + call ice_pio_check(pio_put_att(File,varid,'cell_measures', trim(hfield%vcellmeas)), & + 'ERROR: setting "cell_measures" as '//trim(hfield%vcoord)) if (hfield%vcomment /= "none") then - status = pio_put_att(File,varid,'comment', trim(hfield%vcomment)) + call ice_pio_check(pio_put_att(File,varid,'comment', trim(hfield%vcomment)), & + 'ERROR: setting "comment" as '//trim(hfield%vcomment)) endif call ice_write_hist_fill(File,varid,hfield%vname,history_precision) @@ -1277,7 +1354,8 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .and.TRIM(hfield%vname(1:9))/='sistreave' & .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then - status = pio_put_att(File,varid,'cell_methods','time: mean') + call ice_pio_check(pio_put_att(File,varid,'cell_methods','time: mean'), & + 'ERROR: setting "cell_methods"') endif endif @@ -1296,9 +1374,11 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .or.TRIM(hfield%vname(1:9))=='frz_onset' & .or.TRIM(hfield%vname(1:6))=='hisnap' & .or.TRIM(hfield%vname(1:6))=='aisnap') then - status = pio_put_att(File,varid,'time_rep','instantaneous') + call ice_pio_check(pio_put_att(File,varid,'time_rep','instantaneous'), & + 'ERROR: setting "time_rep"') else - status = pio_put_att(File,varid,'time_rep','averaged') + call ice_pio_check(pio_put_att(File,varid,'time_rep','averaged'), & + 'ERROR: setting "time_rep"') endif end subroutine ice_write_hist_attrs @@ -1322,11 +1402,15 @@ subroutine ice_write_hist_fill(File,varid,vname,precision) character(len=*), parameter :: subname = '(ice_write_hist_fill)' if (precision == 8) then - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) + call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval_dbl), & + 'ERROR: setting "missing_value"') + call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval_dbl), & + 'ERROR: setting "_FillValue"') else - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval), & + 'ERROR: setting "missing_value"') + call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval), & + 'ERROR: setting "_FillValue"') endif end subroutine ice_write_hist_fill diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index 9482ff671..491337c5f 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -25,6 +25,7 @@ module ice_pio module procedure ice_pio_initdecomp_3d_inner end interface + public ice_pio_check public ice_pio_init public ice_pio_initdecomp @@ -40,6 +41,19 @@ module ice_pio !=============================================================================== + ! check status code returned from pio function, and abort on error + subroutine ice_pio_check(status, msg) + integer, intent (in) :: status + integer :: strerror_status + character (len=*), intent (in) :: msg + character (len=:), allocatable :: err_str + + if(status /= PIO_NOERR) then + strerror_status = pio_strerror(status, err_str) + call abort_ice('ice: ParallelIO error '//trim(err_str)//' '//trim(msg)) + end if + end subroutine ice_pio_check + ! Initialize the io subsystem ! 2009-Feb-17 - J. Edwards - initial version @@ -75,7 +89,6 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) logical :: exists logical :: lclobber logical :: lcdf64 - integer :: status integer :: nmode character(len=*), parameter :: subname = '(ice_pio_init)' logical, save :: first_call = .true. @@ -83,6 +96,8 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) #ifdef CESMCOUPLED ice_pio_subsystem => shr_pio_getiosys(inst_name) pio_iotype = shr_pio_getiotype(inst_name) + + pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) #else #ifdef GPTL @@ -118,6 +133,9 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & rearranger, ice_pio_subsystem, base=basetask) + + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) + !--- initialize rearranger options !pio_rearr_opt_comm_type = integer (PIO_REARR_COMM_[P2P,COLL]) !pio_rearr_opt_fcd = integer, flow control (PIO_REARR_COMM_FC_[2D_ENABLE,1D_COMP2IO,1D_IO2COMP,2D_DISABLE]) @@ -155,13 +173,19 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) if (lclobber) then nmode = pio_clobber !if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) - status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check(& + pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode), & + subname//'ERROR: Failed to create file '//trim(filename) & + ) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if else nmode = pio_write - status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check( & + pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode), & + subname//'ERROR: Failed to open file '//trim(filename) & + ) if (my_task == master_task) then write(nu_diag,*) subname,' open file ',trim(filename) end if @@ -169,20 +193,25 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) else nmode = pio_noclobber !if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) - status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check( & + pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) ,& + subname//'ERROR: Failed to create file '//trim(filename) & + ) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if endif - else - ! filename is already open, just return + ! else: filename is already open, just return endif end if if (trim(mode) == 'read') then inquire(file=trim(filename),exist=exists) if (exists) then - status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite) + call ice_pio_check( & + pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite),& + subname//'ERROR: Failed to open file '//trim(filename) & + ) else if(my_task==master_task) then write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename) From d8227b1746d4c2f83d61175dc56866b57cd5a43c Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Tue, 19 Dec 2023 10:56:40 +1100 Subject: [PATCH 16/32] tidy up io error handling --- .github/workflows/test-cice.yml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index e83520fa1..b04ca1714 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -6,6 +6,10 @@ name: GHActions on: push: + branches: + - main + - 'CICE*' + - 'ghactions*' pull_request: release: types: @@ -156,11 +160,6 @@ jobs: run: | cd $HOME/cice ./cice.setup -m conda -e ${{ matrix.envdef }} --suite travis_suite --testid ${{ matrix.os }} - - name: get logs - uses: actions/download-artifact@v3 - with: - name: logs - path: $HOME/cice/testsuite.${{ matrix.os }}/*/logs/cice.runlog.* - name: write output run: | cd $HOME/cice From f3c96aa12ee186b539d5582cfd553e57ce8b3419 Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Tue, 19 Dec 2023 11:04:39 +1100 Subject: [PATCH 17/32] tidy up io error handling --- .github/workflows/test-cice.yml | 9 +- .../io/io_pio2/ice_history_write.F90 | 275 ++++++++++-------- .../infrastructure/io/io_pio2/ice_pio.F90 | 90 +++--- .../infrastructure/io/io_pio2/ice_restart.F90 | 135 +++++---- configuration/scripts/cice.batch.csh | 23 -- configuration/scripts/cice.launch.csh | 12 - configuration/scripts/cice.settings | 2 +- .../scripts/machines/Macros.gadi_intel | 74 ----- configuration/scripts/machines/env.gadi_intel | 58 ---- 9 files changed, 290 insertions(+), 388 deletions(-) delete mode 100644 configuration/scripts/machines/Macros.gadi_intel delete mode 100644 configuration/scripts/machines/env.gadi_intel diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index b04ca1714..e83520fa1 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -6,10 +6,6 @@ name: GHActions on: push: - branches: - - main - - 'CICE*' - - 'ghactions*' pull_request: release: types: @@ -160,6 +156,11 @@ jobs: run: | cd $HOME/cice ./cice.setup -m conda -e ${{ matrix.envdef }} --suite travis_suite --testid ${{ matrix.os }} + - name: get logs + uses: actions/download-artifact@v3 + with: + name: logs + path: $HOME/cice/testsuite.${{ matrix.os }}/*/logs/cice.runlog.* - name: write output run: | cd $HOME/cice diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index 192c7165e..27b232f7e 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -167,7 +167,6 @@ subroutine ice_write_hist (ns) call broadcast_scalar(filename, master_task) ! create file - iotype = PIO_IOTYPE_NETCDF if (history_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 @@ -192,74 +191,75 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- ! define dimensions !----------------------------------------------------------------- + call pio_seterrorhandling(File, PIO_RETURN_ERROR) - if (hist_avg(ns) .and. .not. write_ic) then - call ice_pio_check(pio_def_dim(File,'nbnd',2,boundid), & - subname//'ERROR: defining dim nbnd with len 2') - endif + if (hist_avg(ns) .and. .not. write_ic) then + call ice_pio_check(pio_def_dim(File,'nbnd',2,boundid), & + subname//' ERROR: defining dim nbnd with len 2') + endif - call ice_pio_check(pio_def_dim(File,'ni',nx_global,imtid), & - subname//'ERROR: defining dim ni') + call ice_pio_check(pio_def_dim(File,'ni',nx_global,imtid), & + subname//' ERROR: defining dim ni') - call ice_pio_check(pio_def_dim(File,'nj',ny_global,jmtid), & - subname//'ERROR: defining dim nj') + call ice_pio_check(pio_def_dim(File,'nj',ny_global,jmtid), & + subname//' ERROR: defining dim nj') - call ice_pio_check(pio_def_dim(File,'nc',ncat_hist,cmtid), & - subname//'ERROR: defining dim nc') + call ice_pio_check(pio_def_dim(File,'nc',ncat_hist,cmtid), & + subname//' ERROR: defining dim nc') - call ice_pio_check(pio_def_dim(File,'nkice',nzilyr,kmtidi), & - subname//'ERROR: defining dim nkice') + call ice_pio_check(pio_def_dim(File,'nkice',nzilyr,kmtidi), & + subname//' ERROR: defining dim nkice') - call ice_pio_check(pio_def_dim(File,'nksnow',nzslyr,kmtids), & - subname//'ERROR: defining dim nksnow') + call ice_pio_check(pio_def_dim(File,'nksnow',nzslyr,kmtids), & + subname//' ERROR: defining dim nksnow') - call ice_pio_check(pio_def_dim(File,'nkbio',nzblyr,kmtidb), & - subname//'ERROR: defining dim nkbio') + call ice_pio_check(pio_def_dim(File,'nkbio',nzblyr,kmtidb), & + subname//' ERROR: defining dim nkbio') - call ice_pio_check(pio_def_dim(File,'nkaer',nzalyr,kmtida), & - subname//'ERROR: defining dim nkaer') + call ice_pio_check(pio_def_dim(File,'nkaer',nzalyr,kmtida), & + subname//' ERROR: defining dim nkaer') - call ice_pio_check(pio_def_dim(File,'time',PIO_UNLIMITED,timid), & - subname//'ERROR: defining dim time') - - call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & - subname//'ERROR: defining dim nverticies') + call ice_pio_check(pio_def_dim(File,'time',PIO_UNLIMITED,timid), & + subname//' ERROR: defining dim time') + + call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & + subname//' ERROR: defining dim nverticies') - call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & - subname//'ERROR: defining dim nf') + call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & + subname//' ERROR: defining dim nf') !----------------------------------------------------------------- ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- call ice_pio_check(pio_def_var(File,'time',pio_double,(/timid/),varid), & - subname//'ERROR: defining var time') + subname//' ERROR: defining var time') call ice_pio_check(pio_put_att(File,varid,'long_name','time'), & - subname//'ERROR: defining attribute "long_name" as "time"') + subname//' ERROR: defining attribute "long_name" as "time"') write(cdate,'(i8.8)') idate0 write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & hh_init,':',mm_init,':',ss_init call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & - subname//'ERROR: defining attribute "units" as '//trim(title)) + subname//' ERROR: defining attribute "units" as '//trim(title)) if (days_per_year == 360) then call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//'ERROR: defining calendar') + subname//' ERROR: defining calendar') elseif (days_per_year == 365 .and. .not.use_leap_years ) then call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//'ERROR: defining calendar') + subname//' ERROR: defining calendar') elseif (use_leap_years) then call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//'ERROR: defining calendar') + subname//' ERROR: defining calendar') else - call abort_ice(subname//'ERROR: invalid calendar settings') + call abort_ice(subname//' ERROR: invalid calendar settings') endif if (hist_avg(ns) .and. .not. write_ic) then call ice_pio_check(pio_put_att(File,varid,'bounds','time_bounds'), & - subname//'ERROR: defining attribute "bounds" as "time_bounds"') + subname//' ERROR: defining attribute "bounds" as "time_bounds"') endif ! Define attributes for time_bounds if hist_avg is true @@ -267,21 +267,21 @@ subroutine ice_write_hist (ns) dimid2(1) = boundid dimid2(2) = timid call ice_pio_check(pio_def_var(File,'time_bounds',pio_double,dimid2,varid), & - subname//'ERROR: defining var time_bounds') + subname//' ERROR: defining var time_bounds') call ice_pio_check(pio_put_att(File,varid,'long_name', 'time interval endpoints'), & - subname//'ERROR: defining attribute "long_name" as "time interval endpoints"') + subname//' ERROR: defining attribute "long_name" as "time interval endpoints"') if (days_per_year == 360) then call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//'ERROR: defining calendar for time_bounds') + subname//' ERROR: defining calendar for time_bounds') elseif (days_per_year == 365 .and. .not.use_leap_years ) then call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//'ERROR: defining calendar for time_bounds') + subname//' ERROR: defining calendar for time_bounds') elseif (use_leap_years) then call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//'ERROR: defining calendar for time_bounds') + subname//' ERROR: defining calendar for time_bounds') else - call abort_ice(subname//'ERROR: invalid calendar settings') + call abort_ice(subname//' ERROR: invalid calendar settings') endif write(cdate,'(i8.8)') idate0 @@ -289,7 +289,8 @@ subroutine ice_write_hist (ns) cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & hh_init,':',mm_init,':',ss_init call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & - subname//'ERROR: defining attribute "units" as '//trim(title)) + subname//' ERROR: defining attribute "units" as '//trim(title)) + endif !----------------------------------------------------------------- @@ -440,20 +441,20 @@ subroutine ice_write_hist (ns) do i = 1, ncoord call ice_pio_check(pio_def_var(File, trim(var_coord(i)%short_name), lprecision, & dimid2, varid), & - subname//'ERROR: defining var'//trim(var_coord(i)%short_name)) + subname//' ERROR: defining var'//trim(var_coord(i)%short_name)) call ice_pio_check(pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)), & - subname//'ERROR: putting attribute "long_name" as '//trim(var_coord(i)%long_name)) + subname//' ERROR: defining attribute "long_name" as '//trim(var_coord(i)%long_name)) call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_coord(i)%units)), & - subname//'ERROR: putting attribute "units" as '//trim(var_coord(i)%units)) + subname//' ERROR: defining attribute "units" as '//trim(var_coord(i)%units)) call ice_write_hist_fill(File,varid,var_coord(i)%short_name,history_precision) if (var_coord(i)%short_name == 'ULAT') then call ice_pio_check(pio_put_att(File,varid,'comment', & trim('Latitude of NE corner of T grid cell')), & - subname//'ERROR: putting attribute "comment"') + subname//' ERROR: defining attribute "comment"') endif if (f_bounds) then call ice_pio_check(pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))), & - subname//'ERROR: putting attribute "bounds" as '//trim(coord_bounds(i))) + subname//' ERROR: defining attribute "bounds" as '//trim(coord_bounds(i))) endif enddo @@ -469,11 +470,11 @@ subroutine ice_write_hist (ns) if (igrdz(i)) then call ice_pio_check(pio_def_var(File, trim(var_grdz(i)%short_name), lprecision, & (/dimidex(i)/), varid), & - subname//'ERROR: defining var'//trim(var_grdz(i)%short_name)) + subname//' ERROR: defining var'//trim(var_grdz(i)%short_name)) call ice_pio_check(pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name), & - subname//'ERROR: putting attribute "long_name" as '//trim(var_grdz(i)%long_name)) + subname//' ERROR: defining attribute "long_name" as '//trim(var_grdz(i)%long_name)) call ice_pio_check(pio_put_att(File, varid, 'units' , var_grdz(i)%units), & - subname//'ERROR: putting attribute "units" as '//trim(var_grdz(i)%units)) + subname//' ERROR: defining attribute "units" as '//trim(var_grdz(i)%units)) endif enddo @@ -481,13 +482,13 @@ subroutine ice_write_hist (ns) if (igrd(i)) then call ice_pio_check(pio_def_var(File, trim(var_grd(i)%req%short_name), & lprecision, dimid2, varid), & - subname//'ERROR: defining var'//trim(var_grd(i)%req%short_name)) + subname//' ERROR: defining var'//trim(var_grd(i)%req%short_name)) call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)), & - subname//'ERROR: putting attribute "long_name" as '//trim(var_grd(i)%req%long_name)) + subname//' ERROR: defining attribute "long_name" as '//trim(var_grd(i)%req%long_name)) call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)), & - subname//'ERROR: putting attribute "units" as '//trim(var_grd(i)%req%units)) + subname//' ERROR: defining attribute "units" as '//trim(var_grd(i)%req%units)) call ice_pio_check(pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)), & - subname//'ERROR: putting attribute "coordinates" as '//trim(var_grd(i)%coordinates)) + subname//' ERROR: defining attribute "coordinates" as '//trim(var_grd(i)%coordinates)) call ice_write_hist_fill(File,varid,var_grd(i)%req%short_name,history_precision) endif enddo @@ -500,11 +501,11 @@ subroutine ice_write_hist (ns) if (f_bounds) then call ice_pio_check(pio_def_var(File, trim(var_nverts(i)%short_name), & lprecision,dimid_nverts, varid), & - subname//'ERROR: defining var'//trim(var_nverts(i)%short_name)) + subname//' ERROR: defining var'//trim(var_nverts(i)%short_name)) call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)), & - subname//'ERROR: putting attribute "long_name" as '//trim(var_nverts(i)%long_name)) + subname//' ERROR: defining attribute "long_name" as '//trim(var_nverts(i)%long_name)) call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)), & - subname//'ERROR: putting attribute "units" as '//trim(var_nverts(i)%units)) + subname//' ERROR: defining attribute "units" as '//trim(var_nverts(i)%units)) call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) endif enddo @@ -525,7 +526,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimid3, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_2D @@ -543,7 +544,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Dc @@ -561,7 +562,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Dz @@ -579,7 +580,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Db @@ -597,7 +598,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Da @@ -615,7 +616,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_3Df @@ -639,7 +640,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidcz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_4Di @@ -658,7 +659,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidcz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_4Ds @@ -678,7 +679,7 @@ subroutine ice_write_hist (ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & lprecision, dimidcz, varid), & - subname//'ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) endif enddo ! num_avail_hist_fields_4Df @@ -690,19 +691,19 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- #ifdef CESMCOUPLED call ice_pio_check(pio_put_att(File,pio_global,'title',runid), & - subname//'ERROR: putting attribute "title" as '//runid) + subname//' ERROR: defining attribute "title" as '//runid) #else title = 'sea ice model output for CICE' call ice_pio_check(pio_put_att(File,pio_global,'title',trim(title)), & - subname//'ERROR: putting attribute "title" as '//trim(title)) + subname//' ERROR: defining attribute "title" as '//trim(title)) #endif title = 'Diagnostic and Prognostic Variables' call ice_pio_check(pio_put_att(File,pio_global,'contents',trim(title)), & - subname//'ERROR: putting attribute "contents" as '//trim(title)) + subname//' ERROR: defining attribute "contents" as '//trim(title)) write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) call ice_pio_check(pio_put_att(File,pio_global,'source',trim(title)), & - subname//'ERROR: putting attribute "source" as '//trim(title)) + subname//' ERROR: defining attribute "source" as '//trim(title)) if (use_leap_years) then write(title,'(a,i3,a)') 'This year has ',dayyr,' days' @@ -710,15 +711,15 @@ subroutine ice_write_hist (ns) write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' endif call ice_pio_check(pio_put_att(File,pio_global,'comment',trim(title)), & - subname//'ERROR: putting attribute "comment" as '//trim(title)) + subname//' ERROR: defining attribute "comment" as '//trim(title)) write(title,'(a,i8.8)') 'File written on model date ',idate call ice_pio_check(pio_put_att(File,pio_global,'comment2',trim(title)), & - subname//'ERROR: putting attribute '//trim(title)) + subname//' ERROR: defining attribute '//trim(title)) write(title,'(a,i6)') 'seconds elapsed into model date: ',msec call ice_pio_check(pio_put_att(File,pio_global,'comment3',trim(title)), & - subname//'ERROR: putting attribute '//trim(title)) + subname//' ERROR: defining attribute '//trim(title)) select case (histfreq(ns)) case ("y", "Y") @@ -735,16 +736,16 @@ subroutine ice_write_hist (ns) if (.not.write_ic .and. trim(time_period_freq) /= 'none') then call ice_pio_check(pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)), & - subname//'ERROR: putting attribute "time_period_freq" as '//trim(time_period_freq)) + subname//' ERROR: defining attribute "time_period_freq" as '//trim(time_period_freq)) endif if (hist_avg(ns)) & call ice_pio_check(pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)), & - subname//'ERROR: putting attribute "time_axis_position" as '//trim(hist_time_axis)) + subname//' ERROR: defining attribute "time_axis_position" as '//trim(hist_time_axis)) title = 'CF-1.0' call ice_pio_check(pio_put_att(File,pio_global,'conventions',trim(title)), & - subname//'ERROR: putting attribute "conventions" as '//trim(title)) + subname//' ERROR: defining attribute "conventions" as '//trim(title)) call date_and_time(date=current_date, time=current_time) write(start_time,1000) current_date(1:4), current_date(5:6), & @@ -753,14 +754,14 @@ subroutine ice_write_hist (ns) 1000 format('This dataset was created on ', & a,'-',a,'-',a,' at ',a,':',a) call ice_pio_check(pio_put_att(File,pio_global,'history',trim(start_time)), & - subname//'ERROR: putting attribute "history" as '//trim(start_time)) + subname//' ERROR: defining attribute "history" as '//trim(start_time)) if (history_format == 'pio_pnetcdf') then call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf'), & - subname//'ERROR: putting attribute "io_flavor"' ) + subname//' ERROR: defining attribute "io_flavor"' ) else call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio netcdf'), & - subname//'ERROR: putting attribute "io_flavor"' ) + subname//' ERROR: defining attribute "io_flavor"' ) endif !----------------------------------------------------------------- @@ -768,7 +769,7 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- call ice_pio_check(pio_enddef(File), & - subname//'ERROR: ending pio definitions') + subname//' ERROR: ending pio definitions') !----------------------------------------------------------------- ! write time variable @@ -784,9 +785,9 @@ subroutine ice_write_hist (ns) endif call ice_pio_check(pio_inq_varid(File,'time',varid), & - subname//'ERROR: getting var "time"') + subname//' ERROR: getting var "time"') call ice_pio_check(pio_put_var(File,varid,(/1/),ltime2), & - subname//'ERROR: setting var "time"') + subname//' ERROR: setting var "time"') !----------------------------------------------------------------- ! write time_bounds info @@ -794,13 +795,13 @@ subroutine ice_write_hist (ns) if (hist_avg(ns) .and. .not. write_ic) then call ice_pio_check(pio_inq_varid(File,'time_bounds',varid), & - subname//'ERROR: getting "time_bounds"' ) + subname//' ERROR: getting "time_bounds"' ) time_bounds=(/time_beg(ns),time_end(ns)/) bnd_start = (/1,1/) bnd_length = (/2,1/) call ice_pio_check(pio_put_var(File,varid,ival=time_bounds, & start=bnd_start(:),count=bnd_length(:)), & - subname//'ERROR: setting "time_bounds"' ) + subname//' ERROR: setting "time_bounds"' ) endif !----------------------------------------------------------------- @@ -812,7 +813,7 @@ subroutine ice_write_hist (ns) do i = 1,ncoord call ice_pio_check(pio_inq_varid(File, var_coord(i)%short_name, varid), & - subname//'ERROR: getting '//var_coord(i)%short_name ) + subname//' ERROR: getting '//var_coord(i)%short_name ) SELECT CASE (var_coord(i)%short_name) CASE ('TLON') ! Convert T grid longitude from -180 -> 180 to 0 to 360 @@ -840,6 +841,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc2d, & workr2, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? enddo ! Extra dimensions (NCAT, NFSD, VGRD*) @@ -847,26 +850,26 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grdz if (igrdz(i)) then call ice_pio_check(pio_inq_varid(File, var_grdz(i)%short_name, varid), & - subname//'ERROR: getting '//var_grdz(i)%short_name ) + subname//' ERROR: getting '//var_grdz(i)%short_name ) SELECT CASE (var_grdz(i)%short_name) CASE ('NCAT') call ice_pio_check(pio_put_var(File, varid, hin_max(1:ncat_hist)), & - subname//'ERROR: setting '//var_grdz(i)%short_name ) + subname//' ERROR: setting '//var_grdz(i)%short_name ) CASE ('NFSD') call ice_pio_check(pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)), & - subname//'ERROR: setting '//var_grdz(i)%short_name ) + subname//' ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDi') call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzilyr)/)), & - subname//'ERROR: setting '//var_grdz(i)%short_name ) + subname//' ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDs') call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzslyr)/)), & - subname//'ERROR: setting '//var_grdz(i)%short_name ) + subname//' ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDb') call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzblyr)/)), & - subname//'ERROR: setting '//var_grdz(i)%short_name ) + subname//' ERROR: setting '//var_grdz(i)%short_name ) CASE ('VGRDa') call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzalyr)/)), & - subname//'ERROR: setting '//var_grdz(i)%short_name ) + subname//' ERROR: setting '//var_grdz(i)%short_name ) END SELECT endif enddo @@ -922,7 +925,7 @@ subroutine ice_write_hist (ns) workd2 = ANGLET(:,:,1:nblocks) END SELECT call ice_pio_check(pio_inq_varid(File, var_grd(i)%req%short_name, varid), & - subname//'ERROR: getting '//var_grd(i)%req%short_name ) + subname//' ERROR: getting '//var_grd(i)%req%short_name ) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc2d, & workd2, status, fillval=spval_dbl) @@ -931,6 +934,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc2d, & workr2, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo @@ -979,7 +984,7 @@ subroutine ice_write_hist (ns) END SELECT call ice_pio_check(pio_inq_varid(File, var_nverts(i)%short_name, varid), & - subname//'ERROR: getting '//var_nverts(i)%short_name ) + subname//' ERROR: getting '//var_nverts(i)%short_name ) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3dv, & workd3v, status, fillval=spval_dbl) @@ -988,6 +993,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3dv, & workr3v, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? enddo deallocate(workd3v) deallocate(workr3v) @@ -1004,11 +1011,13 @@ subroutine ice_write_hist (ns) call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & 'ERROR getting varid for '//avail_hist_fields(n)%vname) workd2(:,:,:) = a2D(:,:,n,1:nblocks) + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc2d,& workd2, status, fillval=spval_dbl) @@ -1017,6 +1026,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc2d,& workr2, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_2D @@ -1036,11 +1047,13 @@ subroutine ice_write_hist (ns) workd3(:,:,j,i) = a3Dc(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3dc,& workd3, status, fillval=spval_dbl) @@ -1049,6 +1062,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3dc,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_3Dc deallocate(workd3) @@ -1067,11 +1082,13 @@ subroutine ice_write_hist (ns) workd3(:,:,j,i) = a3Dz(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3di,& workd3, status, fillval=spval_dbl) @@ -1080,6 +1097,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3di,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_3Dz deallocate(workd3) @@ -1098,11 +1117,13 @@ subroutine ice_write_hist (ns) workd3(:,:,j,i) = a3Db(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3db,& workd3, status, fillval=spval_dbl) @@ -1111,6 +1132,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3db,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1129,11 +1152,13 @@ subroutine ice_write_hist (ns) workd3(:,:,j,i) = a3Da(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3da,& workd3, status, fillval=spval_dbl) @@ -1142,6 +1167,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3da,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1160,11 +1187,13 @@ subroutine ice_write_hist (ns) workd3(:,:,j,i) = a3Df(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3df,& workd3, status, fillval=spval_dbl) @@ -1173,6 +1202,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3df,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_3Df deallocate(workd3) @@ -1193,11 +1224,13 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc4di,& workd4, status, fillval=spval_dbl) @@ -1206,6 +1239,7 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4di,& workr4, status, fillval=spval) endif + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_4Di deallocate(workd4) @@ -1226,11 +1260,13 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc4ds,& workd4, status, fillval=spval_dbl) @@ -1239,6 +1275,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4ds,& workr4, status, fillval=spval) endif + + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? endif enddo ! num_avail_hist_fields_4Ds deallocate(workd4) @@ -1259,11 +1297,13 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc4df,& workd4, status, fillval=spval_dbl) @@ -1272,6 +1312,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4df,& workr4, status, fillval=spval) endif + call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname)! maybe we don't actually want to abort here? + endif enddo ! num_avail_hist_fields_4Df deallocate(workd4) @@ -1279,10 +1321,11 @@ subroutine ice_write_hist (ns) ! similarly for num_avail_hist_fields_4Db (define workd4b, iodesc4db) - + !----------------------------------------------------------------- ! clean-up PIO descriptors !----------------------------------------------------------------- + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) call pio_freedecomp(File,iodesc2d) call pio_freedecomp(File,iodesc3dv) @@ -1328,21 +1371,21 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) integer (kind=int_kind) :: status character(len=*), parameter :: subname = '(ice_write_hist_attrs)' - call ice_pio_check(pio_put_att(File,varid,'units', trim(hfield%vunit)), & - 'ERROR: setting "units" as '//trim(hfield%vunit)) + call ice_pio_check(pio_put_att(File,varid,'units', trim(hfield%vunit)), & + 'ERROR: defining "units" as '//trim(hfield%vunit)) - call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)), & - 'ERROR: setting "long_name" as '//trim(hfield%vdesc)) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)), & + 'ERROR: defining "long_name" as '//trim(hfield%vdesc)) - call ice_pio_check(pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)), & - 'ERROR: setting "coordinates" as '//trim(hfield%vdesc)) + call ice_pio_check(pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)), & + 'ERROR: defining "coordinates" as '//trim(hfield%vdesc)) - call ice_pio_check(pio_put_att(File,varid,'cell_measures', trim(hfield%vcellmeas)), & - 'ERROR: setting "cell_measures" as '//trim(hfield%vcoord)) + call ice_pio_check(pio_put_att(File,varid,'cell_measures',trim(hfield%vcellmeas)), & + 'ERROR: defining "cell_measures" as '//trim(hfield%vcoord)) if (hfield%vcomment /= "none") then - call ice_pio_check(pio_put_att(File,varid,'comment', trim(hfield%vcomment)), & - 'ERROR: setting "comment" as '//trim(hfield%vcomment)) + call ice_pio_check(pio_put_att(File,varid,'comment', trim(hfield%vcomment)), & + 'ERROR: defining "comment" as '//trim(hfield%vcomment)) endif call ice_write_hist_fill(File,varid,hfield%vname,history_precision) @@ -1355,7 +1398,7 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then call ice_pio_check(pio_put_att(File,varid,'cell_methods','time: mean'), & - 'ERROR: setting "cell_methods"') + 'ERROR: defining "cell_methods"') endif endif @@ -1375,10 +1418,10 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .or.TRIM(hfield%vname(1:6))=='hisnap' & .or.TRIM(hfield%vname(1:6))=='aisnap') then call ice_pio_check(pio_put_att(File,varid,'time_rep','instantaneous'), & - 'ERROR: setting "time_rep"') + 'ERROR: defining "time_rep"') else call ice_pio_check(pio_put_att(File,varid,'time_rep','averaged'), & - 'ERROR: setting "time_rep"') + 'ERROR: defining "time_rep"') endif end subroutine ice_write_hist_attrs @@ -1387,14 +1430,14 @@ end subroutine ice_write_hist_attrs subroutine ice_write_hist_fill(File,varid,vname,precision) - use ice_kinds_mod - use ice_pio - use pio + ! use ice_kinds_mod, only: int_kind + use ice_pio, only: ice_pio_check + use pio, only: pio_put_att, file_desc_t, var_desc_t type(file_desc_t) , intent(inout) :: File type(var_desc_t) , intent(in) :: varid - character(len=*), intent(in) :: vname ! var name - integer (kind=int_kind), intent(in) :: precision ! precision + character(len=*), intent(in) :: vname + integer (kind=int_kind), intent(in) :: precision ! local variables @@ -1403,14 +1446,14 @@ subroutine ice_write_hist_fill(File,varid,vname,precision) if (precision == 8) then call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval_dbl), & - 'ERROR: setting "missing_value"') + 'ERROR: defining "missing_value"') call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval_dbl), & - 'ERROR: setting "_FillValue"') + 'ERROR: defining "_FillValue"') else call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval), & - 'ERROR: setting "missing_value"') + 'ERROR: defining "missing_value"') call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval), & - 'ERROR: setting "_FillValue"') + 'ERROR: defining "_FillValue"') endif end subroutine ice_write_hist_fill diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index 491337c5f..9dd5f2bd4 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -25,10 +25,10 @@ module ice_pio module procedure ice_pio_initdecomp_3d_inner end interface - public ice_pio_check public ice_pio_init public ice_pio_initdecomp - + public ice_pio_check + #ifdef CESMCOUPLED type(iosystem_desc_t), pointer :: ice_pio_subsystem #else @@ -41,19 +41,6 @@ module ice_pio !=============================================================================== - ! check status code returned from pio function, and abort on error - subroutine ice_pio_check(status, msg) - integer, intent (in) :: status - integer :: strerror_status - character (len=*), intent (in) :: msg - character (len=:), allocatable :: err_str - - if(status /= PIO_NOERR) then - strerror_status = pio_strerror(status, err_str) - call abort_ice('ice: ParallelIO error '//trim(err_str)//' '//trim(msg)) - end if - end subroutine ice_pio_check - ! Initialize the io subsystem ! 2009-Feb-17 - J. Edwards - initial version @@ -80,16 +67,8 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) integer (int_kind) :: & nml_error ! namelist read error flag - integer :: nprocs - integer :: istride - integer :: basetask - integer :: numiotasks - integer :: rearranger - integer :: pio_iotype - logical :: exists - logical :: lclobber - logical :: lcdf64 - integer :: nmode + integer :: nprocs , istride, basetask, numiotasks, rearranger, pio_iotype, status, nmode + logical :: lclobber, lcdf64, exists character(len=*), parameter :: subname = '(ice_pio_init)' logical, save :: first_call = .true. @@ -111,9 +90,9 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) !pio_iotype = PIO_IOTYPE_NETCDF4C pio_iotype = PIO_IOTYPE_NETCDF4P !pio_iotype = PIO_IOTYPE_NETCDF - !if (present(iotype)) then - ! pio_iotype = iotype - !endif + if (present(iotype)) then + pio_iotype = iotype + endif !--- initialize ice_pio_subsystem nprocs = get_num_procs() @@ -134,7 +113,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & rearranger, ice_pio_subsystem, base=basetask) - call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) + call pio_seterrorhandling(ice_pio_subsystem, PIO_BCAST_ERROR) !--- initialize rearranger options !pio_rearr_opt_comm_type = integer (PIO_REARR_COMM_[P2P,COLL]) @@ -164,7 +143,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) if (present(clobber)) lclobber=clobber lcdf64 = .false. - !if (present(cdf64)) lcdf64=cdf64 + if (present(cdf64)) lcdf64=cdf64 if (File%fh<0) then ! filename not open @@ -172,31 +151,25 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) if (exists) then if (lclobber) then nmode = pio_clobber - !if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) - call ice_pio_check(& - pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode), & - subname//'ERROR: Failed to create file '//trim(filename) & - ) + if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) + status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check(status, subname//' ERROR: Failed to create file '//trim(filename)) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if else nmode = pio_write - call ice_pio_check( & - pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode), & - subname//'ERROR: Failed to open file '//trim(filename) & - ) + status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename) ) if (my_task == master_task) then write(nu_diag,*) subname,' open file ',trim(filename) end if endif else nmode = pio_noclobber - !if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) - call ice_pio_check( & - pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) ,& - subname//'ERROR: Failed to create file '//trim(filename) & - ) + if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) + status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check( status, subname//' ERROR: Failed to create file '//trim(filename) ) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if @@ -208,10 +181,11 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) if (trim(mode) == 'read') then inquire(file=trim(filename),exist=exists) if (exists) then - call ice_pio_check( & - pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite),& - subname//'ERROR: Failed to open file '//trim(filename) & - ) + if (my_task == master_task) then + write(nu_diag,*) subname,' opening file for reading' + endif + status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite) + call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename)) else if(my_task==master_task) then write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename) @@ -222,6 +196,8 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) end if + call pio_seterrorhandling(ice_pio_subsystem, PIO_INTERNAL_ERROR) + end subroutine ice_pio_init !================================================================================ @@ -494,6 +470,24 @@ subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc, precision) end subroutine ice_pio_initdecomp_4d + +!================================================================================ + + ! PIO Error handling + ! Author: Anton Steketee, ACCESS-NRI + + subroutine ice_pio_check(status, abort_msg) + integer, intent (in) :: status + integer :: strerror_status + character (len=*), intent (in) :: abort_msg + character(len=pio_max_name) :: err_msg + + if(status /= PIO_NOERR) then + strerror_status = pio_strerror(status, err_msg) + call abort_ice('ParallelIO error: '//err_msg, abort_msg) + end if + end subroutine ice_pio_check + !================================================================================ end module ice_pio diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index 44b0ec110..809661b80 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -55,9 +55,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status, status1 - - integer (kind=int_kind) :: iotype + integer (kind=int_kind) :: status, iotype character(len=*), parameter :: subname = '(init_restart_read)' @@ -78,38 +76,43 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) end if -! if (restart_format(1:3) == 'pio') then + ! if (restart_format(1:3) == 'pio') then iotype = PIO_IOTYPE_NETCDF if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true., precision=8) if (use_restart_time) then - status1 = PIO_noerr - status = pio_get_att(File, pio_global, 'istep1', istep0) -! status = pio_get_att(File, pio_global, 'time', time) -! status = pio_get_att(File, pio_global, 'time_forc', time_forc) - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - status = pio_get_att(File, pio_global, 'myear', myear) - if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'nyr', myear) - if (status /= PIO_noerr) status1 = status - status = pio_get_att(File, pio_global, 'mmonth', mmonth) - if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'month', mmonth) - if (status /= PIO_noerr) status1 = status - status = pio_get_att(File, pio_global, 'mday', mday) - if (status /= PIO_noerr) status1 = status - status = pio_get_att(File, pio_global, 'msec', msec) - if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'sec', msec) - if (status /= PIO_noerr) status1 = status - if (status1 /= PIO_noerr) & - call abort_ice(subname//"ERROR: reading restart time ") - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + call ice_pio_check(pio_get_att(File, pio_global, 'istep1', istep0), & + subname//" ERROR: reading restart time ") +! call ice_pio_check(pio_get_att(File, pio_global, 'time', time), & + ! subname//" ERROR: reading restart time ") +! call ice_pio_check(pio_get_att(File, pio_global, 'time_forc', time_forc), & + ! subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'myear', myear), & + subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'nyr', myear), & + subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'mmonth', mmonth), & + subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'month', mmonth), & + subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'mday', mday), & + subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'msec', msec), & + subname//" ERROR: reading restart time ") + call ice_pio_check(pio_get_att(File, pio_global, 'sec', msec), & + subname//" ERROR: reading restart time ") endif ! use namelist values if use_restart_time = F ! endif + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + if (my_task == master_task) then write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read at istep=',istep0,myear,'-',mmonth,'-',mday,'-',msec endif @@ -221,6 +224,8 @@ subroutine init_restart_write(filename_spec) close(nu_rst_pointer) endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + ! if (restart_format(1:3) == 'pio') then iotype = PIO_IOTYPE_NETCDF4P @@ -229,17 +234,27 @@ subroutine init_restart_write(filename_spec) call ice_pio_init(mode='write',filename=trim(filename), File=File, & clobber=.true., cdf64=lcdf64, iotype=iotype) - status = pio_put_att(File,pio_global,'istep1',istep1) -! status = pio_put_att(File,pio_global,'time',time) -! status = pio_put_att(File,pio_global,'time_forc',time_forc) - status = pio_put_att(File,pio_global,'myear',myear) - status = pio_put_att(File,pio_global,'mmonth',mmonth) - status = pio_put_att(File,pio_global,'mday',mday) - status = pio_put_att(File,pio_global,'msec',msec) - - status = pio_def_dim(File,'ni',nx_global,dimid_ni) - status = pio_def_dim(File,'nj',ny_global,dimid_nj) - status = pio_def_dim(File,'ncat',ncat,dimid_ncat) + call ice_pio_check(pio_put_att(File,pio_global,'istep1',istep1), & + subname//' ERROR writing restart time') +! call ice_pio_check(pio_put_att(File,pio_global,'time',time), & + ! subname//' ERROR writing restart time') +! call ice_pio_check(pio_put_att(File,pio_global,'time_forc',time_forc), & + ! subname//' ERROR writing restart time') + call ice_pio_check(pio_put_att(File,pio_global,'myear',myear), & + subname//' ERROR writing restart time') + call ice_pio_check(pio_put_att(File,pio_global,'mmonth',mmonth), & + subname//' ERROR writing restart time') + call ice_pio_check(pio_put_att(File,pio_global,'mday',mday), & + subname//' ERROR writing restart time') + call ice_pio_check(pio_put_att(File,pio_global,'msec',msec), & + subname//' ERROR writing restart time') + + call ice_pio_check(pio_def_dim(File,'ni',nx_global,dimid_ni), & + subname//' ERROR defining restart dim ni') + call ice_pio_check(pio_def_dim(File,'nj',ny_global,dimid_nj), & + subname//' ERROR defining restart dim nj') + call ice_pio_check(pio_def_dim(File,'ncat',ncat,dimid_ncat), & + subname//' ERROR defining restart dim ncat') !----------------------------------------------------------------- ! 2D restart fields @@ -660,6 +675,8 @@ subroutine init_restart_write(filename_spec) deallocate(dims) status = pio_enddef(File) + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) @@ -719,26 +736,21 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & character(len=*), parameter :: subname = '(read_restart_field)' + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + ! if (restart_format(1:3) == "pio") then if (my_task == master_task) & write(nu_diag,*)'Parallel restart file read: ',vname - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - - status = pio_inq_varid(File,trim(vname),vardesc) - - if (status /= PIO_noerr) then - call abort_ice(subname// & - "ERROR: CICE restart? Missing variable: "//trim(vname)) - endif - - status = pio_inq_varndims(File, vardesc, ndims) - - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & + subname// "ERROR: CICE restart? Missing variable: "//trim(vname)) + + call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & + subname// "ERROR reading ndims for "//trim(vname)) ! if (ndim3 == ncat .and. ncat>1) then if (ndim3 == ncat .and. ndims == 3) then - call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) + call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) #ifdef CESMCOUPLED where (work == PIO_FILL_DOUBLE) work = c0 #endif @@ -762,6 +774,11 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & write(nu_diag,*) "ndim3 not supported ",ndim3 endif + call ice_pio_check(status, & + subname//" ERROR reading distributed array for "//trim(vname)) + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + if (diag) then if (ndim3 > 1) then do n=1,ndim3 @@ -783,7 +800,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & endif ! else -! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) +! call abort_ice(subname//" ERROR: Invalid restart_format: "//trim(restart_format)) ! endif ! restart_format end subroutine read_restart_field @@ -830,13 +847,17 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) character(len=*), parameter :: subname = '(write_restart_field)' + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + ! if (restart_format(1:3) == "pio") then if (my_task == master_task) & write(nu_diag,*)'Parallel restart file write: ',vname - status = pio_inq_varid(File,trim(vname),vardesc) + call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & + subname// "ERROR reading "//trim(vname)) - status = pio_inq_varndims(File, vardesc, ndims) + call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & + subname// "ERROR reading "//trim(vname)) if (ndims==3) then call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & @@ -847,6 +868,11 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) else write(nu_diag,*) "ndims not supported",ndims,ndim3 endif + + call ice_pio_check(status, & + subname//" ERROR writing distributed array for "//trim(vname)) + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) if (diag) then if (ndim3 > 1) then @@ -868,7 +894,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) endif endif ! else -! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) +! call abort_ice(subname//" ERROR: Invalid restart_format: "//trim(restart_format)) ! endif end subroutine write_restart_field @@ -910,7 +936,8 @@ subroutine define_rest_field(File, vname, dims) character(len=*), parameter :: subname = '(define_rest_field)' - status = pio_def_var(File,trim(vname),pio_double,dims,vardesc) + call ice_pio_check(pio_def_var(File,trim(vname),pio_double,dims,vardesc), & + subname//' ERROR defining restart field '//trim(vname)) end subroutine define_rest_field @@ -931,9 +958,13 @@ logical function query_field(nu,vname) query_field = .false. + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + status = pio_inq_varid(File,trim(vname),vardesc) if (status == PIO_noerr) query_field = .true. + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + end function query_field !======================================================================= diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 1a9377f0a..33b27cbf8 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -48,29 +48,6 @@ cat >> ${jobfile} << EOFB ###PBS -m be EOFB -else if (${ICE_MACHINE} =~ gadi*) then -if (${queue} =~ *sr) then #sapphire rapids - @ memuse = ( $ncores * 481 / 100 ) -else if (${queue} =~ *bw) then #broadwell - @ memuse = ( $ncores * 457 / 100 ) -else if (${queue} =~ *sl) then - @ memuse = ( $ncores * 6 ) -else #normal queues - @ memuse = ( $ncores * 395 / 100 ) -endif -cat >> ${jobfile} << EOFB -#PBS -q ${queue} -#PBS -P ${ICE_MACHINE_PROJ} -#PBS -N ${ICE_CASENAME} -#PBS -l storage=gdata/${ICE_MACHINE_PROJ}+scratch/${ICE_MACHINE_PROJ}+gdata/ik11 -#PBS -l ncpus=${ncores} -#PBS -l mem=${memuse}gb -#PBS -l walltime=${batchtime} -#PBS -j oe -#PBS -W umask=022 -#PBS -o ${ICE_CASEDIR} -EOFB - else if (${ICE_MACHINE} =~ gust*) then cat >> ${jobfile} << EOFB #PBS -q ${queue} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index f8a177b46..f8347e101 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -46,18 +46,6 @@ mpiexec --cpu-bind depth -n ${ntasks} -ppn ${taskpernodelimit} -d ${nthrds} ./ci EOFR endif -#======= -else if (${ICE_MACHCOMP} =~ gadi*) then -if (${ICE_COMMDIR} =~ serial*) then -cat >> ${jobfile} << EOFR -./cice >&! \$ICE_RUNLOG_FILE -EOFR -else -cat >> ${jobfile} << EOFR -mpirun -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE -EOFR -endif - #======= else if (${ICE_MACHCOMP} =~ hobart* || ${ICE_MACHCOMP} =~ izumi*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index 92ce8d006..ee4709940 100644 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -14,7 +14,7 @@ setenv ICE_HSTDIR ${ICE_RUNDIR}/history setenv ICE_LOGDIR ${ICE_CASEDIR}/logs setenv ICE_DRVOPT standalone/cice setenv ICE_TARGET cice -setenv ICE_IOTYPE pio2 # binary, netcdf, pio1, pio2 +setenv ICE_IOTYPE netcdf # binary, netcdf, pio1, pio2 setenv ICE_CLEANBUILD true setenv ICE_CPPDEFS "" setenv ICE_QUIETMODE false diff --git a/configuration/scripts/machines/Macros.gadi_intel b/configuration/scripts/machines/Macros.gadi_intel deleted file mode 100644 index f0301d711..000000000 --- a/configuration/scripts/machines/Macros.gadi_intel +++ /dev/null @@ -1,74 +0,0 @@ -#============================================================================== -# Makefile macros for NCI Gadi, intel compiler -#============================================================================== - -CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise - -FIXEDFLAGS := -132 -FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -FFLAGS_NOOPT:= -O0 - -ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 -else - FFLAGS += -O2 -endif - -SCC := icx -SFC := ifort -MPICC := mpicc -MPIFC := mpifort - -ifeq ($(ICE_COMMDIR), mpi) - FC := $(MPIFC) - CC := $(MPICC) -else - FC := $(SFC) - CC := $(SCC) -endif -LD:= $(FC) - -PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs - -SLIBS := $(SLIBS) -INCLDIR := $(INCLDIR) - -ifndef SPACK_NETCDF_FORTRAN_ROOT - SLIBS += -L$(NETCDF)/lib -lnetcdf -lnetcdff -else - SLIBS += -L$(SPACK_NETCDF_C_ROOT)/lib64 -lnetcdf - SLIBS += -L$(SPACK_NETCDF_FORTRAN_ROOT)/lib -lnetcdff - INCLDIR += -I $(SPACK_NETCDF_C_ROOT)/include - INCLDIR += -I $(SPACK_NETCDF_FORTRAN_ROOT)/include -endif - -#LIB_MPI := $(IMPILIBDIR) -#LIB_PNETCDF := $(PNETCDF)/lib -#SLIBS += L$(LIB_PNETCDF) -lpnetcdf - -ifeq ($(ICE_THREADED), true) - LDFLAGS += -qopenmp - CFLAGS += -qopenmp - FFLAGS += -qopenmp -endif - -ifeq ($(ICE_IOTYPE), pio1) - LIB_PIO := $(PIO_LIBDIR) - SLIBS += -L$(LIB_PIO) -lpio -endif - -ifeq ($(ICE_IOTYPE), pio2) - ifndef SPACK_PARALLELIO_ROOT - SLIBS += -L$(PARALLELIO_ROOT)/lib -lpioc -lpiof - else - SLIBS += -L$(SPACK_PARALLELIO_ROOT)/lib -lpioc -lpiof - INCLDIR += -I $(SPACK_PARALLELIO_ROOT)/include - endif - - SLIBS += $(SLIBS) -L$(OMPI_BASE)/lib -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh - -endif - diff --git a/configuration/scripts/machines/env.gadi_intel b/configuration/scripts/machines/env.gadi_intel deleted file mode 100644 index f4fd2da71..000000000 --- a/configuration/scripts/machines/env.gadi_intel +++ /dev/null @@ -1,58 +0,0 @@ -#!/bin/csh -f - -set inp = "undefined" -if ($#argv == 1) then - set inp = $1 -endif - -if ("$inp" != "-nomodules") then - - source /etc/profile.d/modules.csh - - module purge - module load intel-compiler - module load openmpi - - if ($?ICE_IOTYPE) then - if ($ICE_IOTYPE =~ pio*) then - if ($ICE_IOTYPE == "pio1") then - # we don't have pio1 installed anywhere - module load pnetcdf - module load netcdf - module load pio - else - module use /g/data/ik11/spack/0.20.1/modules/access-om3/0.x.0/linux-rocky8-cascadelake #this path is not stable, is there a better way to do this?? - module load parallelio - endif - else - module load netcdf - endif - endif - - if ($?ICE_BFBTYPE) then - if ($ICE_BFBTYPE =~ qcchk*) then - # conda/analysis has the required librarys, skip building from cice yaml file - module use /g/data/hh5/public/modules - module load conda/analysis - # conda env create -f ../../configuration/scripts/tests/qctest.yml - # conda activate qctest - endif - endif - -endif - -setenv ICE_MACHINE_MACHNAME gadi -setenv ICE_MACHINE_MACHINFO "Intel Xeon Scalable" -setenv ICE_MACHINE_ENVNAME intel -# setenv ICE_MACHINE_ENVINFO ${module list} -setenv ICE_MACHINE_MAKE gmake -setenv ICE_MACHINE_WKDIR /scratch/$PROJECT/$USER/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /g/data/tm70/as2285 -setenv ICE_MACHINE_BASELINE /scratch/$PROJECT/$USER/CICE_BASELINE -setenv ICE_MACHINE_SUBMIT "qsub" -setenv ICE_MACHINE_PROJ $PROJECT -setenv ICE_MACHINE_ACCT $USER -setenv ICE_MACHINE_QUEUE "normal" -setenv ICE_MACHINE_TPNODE 48 -setenv ICE_MACHINE_BLDTHRDS 4 -setenv ICE_MACHINE_QSTAT "qstat " From 6b55fc2a2d087f8e250ad71685c66d60c4d48c54 Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Tue, 19 Dec 2023 11:18:01 +1100 Subject: [PATCH 18/32] tidyup --- .github/workflows/test-cice.yml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index e83520fa1..b04ca1714 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -6,6 +6,10 @@ name: GHActions on: push: + branches: + - main + - 'CICE*' + - 'ghactions*' pull_request: release: types: @@ -156,11 +160,6 @@ jobs: run: | cd $HOME/cice ./cice.setup -m conda -e ${{ matrix.envdef }} --suite travis_suite --testid ${{ matrix.os }} - - name: get logs - uses: actions/download-artifact@v3 - with: - name: logs - path: $HOME/cice/testsuite.${{ matrix.os }}/*/logs/cice.runlog.* - name: write output run: | cd $HOME/cice From dc14ce98d71a742d9132d7ed8b7ecad3a39bd0a1 Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 12 Jan 2024 17:31:51 -0700 Subject: [PATCH 19/32] Update pio and netcdf error checking - add ice_check_nc subroutine to check netcdf status, update netcdf checks - update pio error checks - add USE_PIO1 cpp, pio_strerror does not exist in pio1 - fix a couple of minor IO bugs detected by new checks, nothing significant - update some abort_ice calls to add file and line - update indentation --- cicecore/cicedyn/analysis/ice_history.F90 | 2 +- .../cicedyn/analysis/ice_history_shared.F90 | 2 +- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 2 +- .../cicedyn/dynamics/ice_transport_remap.F90 | 2 +- cicecore/cicedyn/general/ice_forcing.F90 | 10 +- .../cicedyn/infrastructure/ice_domain.F90 | 63 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 79 +- .../cicedyn/infrastructure/ice_read_write.F90 | 1273 +++++----- .../io/io_netcdf/ice_history_write.F90 | 2046 ++++++++--------- .../io/io_netcdf/ice_restart.F90 | 365 +-- .../io/io_pio2/ice_history_write.F90 | 1008 ++++---- .../infrastructure/io/io_pio2/ice_pio.F90 | 56 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 1081 +++++---- configuration/scripts/options/set_env.iopio1 | 1 + configuration/scripts/options/set_env.iopio1p | 1 + 15 files changed, 2990 insertions(+), 3001 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 0243d9861..87a339529 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -3,7 +3,7 @@ ! ! The following variables are currently hard-wired as snapshots ! (instantaneous rather than time-averages): -! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, +! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, ! frz_onset, hisnap, aisnap ! ! Options for histfreq: '1','h','d','m','y','x', where x means that diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 2c64bb021..36f7f9131 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -4,7 +4,7 @@ ! ! The following variables are currently hard-wired as snapshots ! (instantaneous rather than time-averages): -! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, +! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, ! frz_onset, hisnap, aisnap ! ! Options for histfreq: '1','h','d','m','y','x', where x means that diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 015c925a6..84edea237 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -1742,7 +1742,7 @@ subroutine deformations (nx_block, ny_block, & tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - vort , & ! vorticity (1/s) + vort , & ! vorticity (1/s) shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) rdg_conv , & ! convergence term for ridging (1/s) diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index 11521a0fa..8916c359d 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -1177,7 +1177,7 @@ subroutine construct_fields (nx_block, ny_block, & ! center of mass (mxav,myav) for each cell - mxav(i,j) = mx(i,j)*xxav / mm(i,j) + mxav(i,j) = mx(i,j)*xxav / mm(i,j) myav(i,j) = my(i,j)*yyav / mm(i,j) enddo diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 496e342f1..05899d646 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -29,7 +29,7 @@ module ice_forcing daymo, days_per_year, compute_days_between use ice_fileunits, only: nu_diag, nu_forcing use ice_exit, only: abort_ice - use ice_read_write, only: ice_open, ice_read, & + use ice_read_write, only: ice_open, ice_read, ice_check_nc, & ice_get_ncvarsize, ice_read_vec_nc, & ice_open_nc, ice_read_nc, ice_close_nc use ice_timers, only: ice_timer_start, ice_timer_stop, timer_readwrite, & @@ -3701,11 +3701,15 @@ subroutine ocn_data_ncar_init ! status = nf90_inq_dimid(fid,'nlon',dimid) status = nf90_inq_dimid(fid,'ni',dimid) + call ice_check_nc(status, subname//'ERROR: inq dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlon) + call ice_check_nc(status, subname//'ERROR: inq dim ni', file=__FILE__, line=__LINE__) ! status = nf90_inq_dimid(fid,'nlat',dimid) status = nf90_inq_dimid(fid,'nj',dimid) + call ice_check_nc(status, subname//'ERROR: inq dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlat) + call ice_check_nc(status, subname//'ERROR: inq dim nj', file=__FILE__, line=__LINE__) if( nlon .ne. nx_global ) then call abort_ice (error_message=subname//'ice: ocn frc file nlon ne nx_global', & @@ -3862,11 +3866,15 @@ subroutine ocn_data_ncar_init_3D ! status = nf90_inq_dimid(fid,'nlon',dimid) status = nf90_inq_dimid(fid,'ni',dimid) + call ice_check_nc(status, subname//'ERROR: inq dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlon) + call ice_check_nc(status, subname//'ERROR: inq dim ni', file=__FILE__, line=__LINE__) ! status = nf90_inq_dimid(fid,'nlat',dimid) status = nf90_inq_dimid(fid,'nj',dimid) + call ice_check_nc(status, subname//'ERROR: inq dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlat) + call ice_check_nc(status, subname//'ERROR: inq dim nj', file=__FILE__, line=__LINE__) if( nlon .ne. nx_global ) then call abort_ice (error_message=subname//'ice: ocn frc file nlon ne nx_global', & diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 06d0d8ae1..12b7d93aa 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -177,8 +177,7 @@ subroutine init_domain_blocks open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then call abort_ice(subname//'ERROR: domain_nml open file '// & - trim(nml_filename), & - file=__FILE__, line=__LINE__) + trim(nml_filename), file=__FILE__, line=__LINE__) endif call goto_nml(nu_nml,trim(nml_name),nml_error) @@ -242,7 +241,7 @@ subroutine init_domain_blocks !*** !*** domain size zero or negative !*** - call abort_ice(subname//'ERROR: Invalid domain: size < 1') ! no domain + call abort_ice(subname//'ERROR: Invalid domain: size < 1', file=__FILE__, line=__LINE__) ! no domain else if (nprocs /= get_num_procs()) then !*** !*** input nprocs does not match system (eg MPI) request @@ -251,13 +250,13 @@ subroutine init_domain_blocks nprocs = get_num_procs() #else write(nu_diag,*) subname,'ERROR: nprocs, get_num_procs = ',nprocs,get_num_procs() - call abort_ice(subname//'ERROR: Input nprocs not same as system request') + call abort_ice(subname//'ERROR: Input nprocs not same as system request', file=__FILE__, line=__LINE__) #endif else if (nghost < 1) then !*** !*** must have at least 1 layer of ghost cells !*** - call abort_ice(subname//'ERROR: Not enough ghost cells allocated') + call abort_ice(subname//'ERROR: Not enough ghost cells allocated', file=__FILE__, line=__LINE__) endif !---------------------------------------------------------------------- @@ -385,7 +384,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) file=__FILE__, line=__LINE__) if (trim(ns_boundary_type) == 'closed') then - call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported') + call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported', file=__FILE__, line=__LINE__) allocate(nocn(nblocks_tot)) nocn = 0 do n=1,nblocks_tot @@ -418,13 +417,13 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif if (nocn(n) > 0) then write(nu_diag,*) subname,'ns closed, Not enough land cells along ns edge' - call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed') + call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed', file=__FILE__, line=__LINE__) endif enddo deallocate(nocn) endif if (trim(ew_boundary_type) == 'closed') then - call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported') + call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported', file=__FILE__, line=__LINE__) allocate(nocn(nblocks_tot)) nocn = 0 do n=1,nblocks_tot @@ -457,7 +456,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif if (nocn(n) > 0) then write(nu_diag,*) subname,'ew closed, Not enough land cells along ew edge' - call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed') + call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed', file=__FILE__, line=__LINE__) endif enddo deallocate(nocn) @@ -487,11 +486,20 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) #ifdef USE_NETCDF status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid) if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot open '//trim(distribution_wght_file)) + call abort_ice(subname//'ERROR: Cannot open '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) endif status = nf90_inq_varid(fid, 'wght', varid) + if (status /= nf90_noerr) then + call abort_ice(subname//'ERROR: Cannot find wght '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + endif status = nf90_get_var(fid, varid, wght) + if (status /= nf90_noerr) then + call abort_ice(subname//'ERROR: Cannot get wght '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + endif status = nf90_close(fid) + if (status /= nf90_noerr) then + call abort_ice(subname//'ERROR: Cannot close '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + endif write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & @@ -581,11 +589,11 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) allocate(work_per_block(nblocks_tot)) where (nocn > 1) - work_per_block = nocn/work_unit + 2 + work_per_block = nocn/work_unit + 2 elsewhere (nocn == 1) - work_per_block = nocn/work_unit + 1 + work_per_block = nocn/work_unit + 1 elsewhere - work_per_block = 0 + work_per_block = 0 end where if (my_task == master_task) then write(nu_diag,*) 'ice_domain work_unit, max_work_unit = ',work_unit, max_work_unit @@ -701,10 +709,10 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) nblocks_max = 0 tblocks_tmp = 0 do n=0,distrb_info%nprocs - 1 - nblocks_tmp = nblocks - call broadcast_scalar(nblocks_tmp, n) - nblocks_max = max(nblocks_max,nblocks_tmp) - tblocks_tmp = tblocks_tmp + nblocks_tmp + nblocks_tmp = nblocks + call broadcast_scalar(nblocks_tmp, n) + nblocks_max = max(nblocks_max,nblocks_tmp) + tblocks_tmp = tblocks_tmp + nblocks_tmp end do if (my_task == master_task) then @@ -713,19 +721,16 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif if (nblocks_max > max_blocks) then - write(outstring,*) & - 'ERROR: num blocks exceed max: increase max to', nblocks_max - call abort_ice(subname//trim(outstring), & - file=__FILE__, line=__LINE__) + write(outstring,*) 'ERROR: num blocks exceed max: increase max to', nblocks_max + call abort_ice(subname//trim(outstring), file=__FILE__, line=__LINE__) else if (nblocks_max < max_blocks) then - write(outstring,*) & - 'WARNING: ice no. blocks too large: decrease max to', nblocks_max - if (my_task == master_task) then - write(nu_diag,*) ' ********WARNING***********' - write(nu_diag,*) subname,trim(outstring) - write(nu_diag,*) ' **************************' - write(nu_diag,*) ' ' - endif + write(outstring,*) 'WARNING: ice no. blocks too large: decrease max to', nblocks_max + if (my_task == master_task) then + write(nu_diag,*) ' ********WARNING***********' + write(nu_diag,*) subname,trim(outstring) + write(nu_diag,*) ' **************************' + write(nu_diag,*) ' ' + endif endif !---------------------------------------------------------------------- diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 1cc3540ca..815821c10 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -39,7 +39,7 @@ module ice_grid get_fileunit, release_fileunit, flush_fileunit use ice_gather_scatter, only: gather_global, scatter_global use ice_read_write, only: ice_read, ice_read_nc, ice_read_global, & - ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc + ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc, ice_check_nc use ice_timers, only: timer_bound, ice_timer_start, ice_timer_stop use ice_exit, only: abort_ice use ice_global_reductions, only: global_minval, global_maxval @@ -245,7 +245,7 @@ subroutine alloc_grid lone_bounds(4,nx_block,ny_block,max_blocks), & ! longitude of gridbox corners for E point late_bounds(4,nx_block,ny_block,max_blocks), & ! latitude of gridbox corners for E point stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1') + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1', file=__FILE__, line=__LINE__) if (save_ghte_ghtn) then if (my_task == master_task) then @@ -259,7 +259,7 @@ subroutine alloc_grid G_HTN(1,1), & ! never used in code stat=ierr) endif - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory3') + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory3', file=__FILE__, line=__LINE__) endif end subroutine alloc_grid @@ -277,7 +277,7 @@ subroutine dealloc_grid if (save_ghte_ghtn) then deallocate(G_HTE, G_HTN, stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Dealloc error1') + if (ierr/=0) call abort_ice(subname//'ERROR: Dealloc error1', file=__FILE__, line=__LINE__) endif end subroutine dealloc_grid @@ -1071,9 +1071,13 @@ subroutine latlongrid call ice_open_nc(kmt_file, ncid) status = nf90_inq_dimid (ncid, 'ni', dimid) + call ice_check_nc(status, subname//' inq_dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(ncid, dimid, len=ni) + call ice_check_nc(status, subname//' inq dim ni', file=__FILE__, line=__LINE__) status = nf90_inq_dimid (ncid, 'nj', dimid) + call ice_check_nc(status, subname//' inq_dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(ncid, dimid, len=nj) + call ice_check_nc(status, subname//' inq dim nj', file=__FILE__, line=__LINE__) end if ! Determine start/count to read in for either single column or global lat-lon grid @@ -1086,7 +1090,7 @@ subroutine latlongrid write(nu_diag,*) 'Because you have selected the column model flag' write(nu_diag,*) 'Please set nx_global=ny_global=1 in file' write(nu_diag,*) 'ice_domain_size.F and recompile' - call abort_ice (subname//'ERROR: check nx_global, ny_global') + call abort_ice (subname//'ERROR: check nx_global, ny_global', file=__FILE__, line=__LINE__) endif end if @@ -1099,17 +1103,17 @@ subroutine latlongrid start3=(/1,1,1/) count3=(/ni,nj,1/) status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') + call ice_check_nc(status, subname//' inq_varid xc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') + call ice_check_nc(status, subname//' get_var xc', file=__FILE__, line=__LINE__) do i = 1,ni lons(i) = glob_grid(i,1) end do status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') + call ice_check_nc(status, subname//' inq_varid yc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') + call ice_check_nc(status, subname//' get_var yc', file=__FILE__, line=__LINE__) do j = 1,nj lats(j) = glob_grid(1,j) end do @@ -1128,29 +1132,29 @@ subroutine latlongrid deallocate(glob_grid) status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') + call ice_check_nc(status, subname//' inq_varid xc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') + call ice_check_nc(status, subname//' get_var xc', file=__FILE__, line=__LINE__) TLON = scamdata status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') + call ice_check_nc(status, subname//' inq_varid yc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') + call ice_check_nc(status, subname//' get_var yc', file=__FILE__, line=__LINE__) TLAT = scamdata status = nf90_inq_varid(ncid, 'area' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid area') + call ice_check_nc(status, subname//' inq_varid area', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var are') + call ice_check_nc(status, subname//' get_var are', file=__FILE__, line=__LINE__) tarea = scamdata status = nf90_inq_varid(ncid, 'mask' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid mask') + call ice_check_nc(status, subname//' inq_varid mask', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var mask') + call ice_check_nc(status, subname//' get_var mask', file=__FILE__, line=__LINE__) hm = scamdata status = nf90_inq_varid(ncid, 'frac' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid frac') + call ice_check_nc(status, subname//' inq_varid frac', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var frac') + call ice_check_nc(status, subname//' get_var frac', file=__FILE__, line=__LINE__) ocn_gridcell_frac = scamdata else ! Check for consistency @@ -1158,7 +1162,7 @@ subroutine latlongrid if (nx_global /= ni .and. ny_global /= nj) then write(nu_diag,*) 'latlongrid: ni,nj = ',ni,nj write(nu_diag,*) 'latlongrid: nx_g,ny_g = ',nx_global, ny_global - call abort_ice (subname//'ERROR: ni,nj not equal to nx_global,ny_global') + call abort_ice (subname//'ERROR: ni,nj not equal to nx_global,ny_global', file=__FILE__, line=__LINE__) end if end if @@ -1450,7 +1454,8 @@ subroutine rectgrid else - call abort_ice(subname//'ERROR: unknown kmt_type '//trim(kmt_type)) + call abort_ice(subname//'ERROR: unknown kmt_type '//trim(kmt_type), & + file=__FILE__, line=__LINE__) endif ! kmt_type @@ -1652,7 +1657,8 @@ subroutine grid_boxislands_kmt (work) nyb = int(real(ny_global, dbl_kind) / c20, int_kind) if (nxb < 1 .or. nyb < 1) & - call abort_ice(subname//'ERROR: requires larger grid size') + call abort_ice(subname//'ERROR: requires larger grid size', & + file=__FILE__, line=__LINE__) ! initialize work area as all ocean (c1). work(:,:) = c1 @@ -2717,7 +2723,7 @@ subroutine grid_average_X2Y_NEversion(type,work1a,grid1a,work1b,grid1b,work2,gri call grid_average_X2Y_2('NE2TA',work1b,narea,npm,work1a,earea,epm,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y)) + call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_NEversion @@ -2826,7 +2832,7 @@ subroutine grid_average_X2Y_1(X2Y,work1,work2) call grid_average_X2YA('SE',work1,narea,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y)) + call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_1 @@ -2938,7 +2944,7 @@ subroutine grid_average_X2Y_1f(X2Y,work1,wght1,mask1,work2) call grid_average_X2YA('SE',work1,wght1,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y)) + call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_1f @@ -3167,7 +3173,7 @@ subroutine grid_average_X2YS(dir,work1,wght1,mask1,work2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YS @@ -3395,7 +3401,7 @@ subroutine grid_average_X2YA(dir,work1,wght1,work2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YA @@ -3597,7 +3603,7 @@ subroutine grid_average_X2YF(dir,work1,wght1,work2,wght2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YF @@ -3742,7 +3748,7 @@ subroutine grid_average_X2Y_2(dir,work1a,wght1a,mask1a,work1b,wght1b,mask1b,work !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_2 @@ -3772,7 +3778,7 @@ real(kind=dbl_kind) function grid_neighbor_min(field, i, j, grid_location) resul case('N') mini = min(field(i,j), field(i,j+1)) case default - call abort_ice(subname // ' unknown grid_location: ' // grid_location) + call abort_ice(subname // ' unknown grid_location: ' // grid_location, file=__FILE__, line=__LINE__) end select end function grid_neighbor_min @@ -3803,7 +3809,7 @@ real(kind=dbl_kind) function grid_neighbor_max(field, i, j, grid_location) resul case('N') maxi = max(field(i,j), field(i,j+1)) case default - call abort_ice(subname // ' unknown grid_location: ' // grid_location) + call abort_ice(subname // ' unknown grid_location: ' // grid_location, file=__FILE__, line=__LINE__) end select end function grid_neighbor_max @@ -4478,7 +4484,8 @@ subroutine get_bathymetry do j = 1, ny_block do i = 1, nx_block k = min(nint(kmt(i,j,iblk)),nlevel) - if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error', & + file=__FILE__, line=__LINE__) if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo @@ -4537,10 +4544,10 @@ subroutine get_bathymetry_popfile if (my_task == master_task) then call get_fileunit(fid) open(fid,file=bathymetry_file,form='formatted',iostat=ierr) - if (ierr/=0) call abort_ice(subname//' open error') + if (ierr/=0) call abort_ice(subname//' open error', file=__FILE__, line=__LINE__) do k = 1,nlevel read(fid,*,iostat=ierr) thick(k) - if (ierr/=0) call abort_ice(subname//' read error') + if (ierr/=0) call abort_ice(subname//' read error', file=__FILE__, line=__LINE__) enddo call release_fileunit(fid) endif @@ -4567,7 +4574,7 @@ subroutine get_bathymetry_popfile depth(1) = thick(1) do k = 2, nlevel depth(k) = depth(k-1) + thick(k) - if (depth(k) < 0.) call abort_ice(subname//' negative depth error') + if (depth(k) < 0.) call abort_ice(subname//' negative depth error', file=__FILE__, line=__LINE__) enddo if (my_task==master_task) then @@ -4581,7 +4588,7 @@ subroutine get_bathymetry_popfile do j = 1, ny_block do i = 1, nx_block k = nint(kmt(i,j,iblk)) - if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error', file=__FILE__, line=__LINE__) if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo diff --git a/cicecore/cicedyn/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index 041f3516b..3d0e9dc25 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -33,8 +33,8 @@ module ice_read_write private integer (kind=int_kind), parameter, private :: & - bits_per_byte = 8 ! number of bits per byte. - ! used to determine RecSize in ice_open + bits_per_byte = 8 ! number of bits per byte. + ! used to determine RecSize in ice_open public :: ice_open, & ice_open_ext, & @@ -51,32 +51,33 @@ module ice_read_write ice_write_ext, & ice_read_vec_nc, & ice_get_ncvarsize, & + ice_check_nc, & ice_close_nc interface ice_write - module procedure ice_write_xyt, & - ice_write_xyzt + module procedure ice_write_xyt, & + ice_write_xyzt end interface interface ice_read - module procedure ice_read_xyt, & - ice_read_xyzt + module procedure ice_read_xyt, & + ice_read_xyzt end interface interface ice_read_nc - module procedure ice_read_nc_xy, & - ice_read_nc_xyz, & - !ice_read_nc_xyf, & - ice_read_nc_point, & - ice_read_nc_1D, & - ice_read_nc_2D, & - ice_read_nc_3D, & - ice_read_nc_z + module procedure ice_read_nc_xy, & + ice_read_nc_xyz, & + !ice_read_nc_xyf, & + ice_read_nc_point, & + ice_read_nc_1D, & + ice_read_nc_2D, & + ice_read_nc_3D, & + ice_read_nc_z end interface interface ice_write_nc - module procedure ice_write_nc_xy, & - ice_write_nc_xyz + module procedure ice_write_nc_xy, & + ice_write_nc_xyz end interface !======================================================================= @@ -93,8 +94,8 @@ module ice_read_write subroutine ice_open(nu, filename, nbits, algn) integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nbits ! no. of bits per variable (0 for sequential access) + nu , & ! unit number + nbits ! no. of bits per variable (0 for sequential access) integer (kind=int_kind), intent(in), optional :: algn integer (kind=int_kind) :: RecSize, Remnant, nbytes @@ -146,15 +147,15 @@ end subroutine ice_open subroutine ice_open_ext(nu, filename, nbits) integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nbits ! no. of bits per variable (0 for sequential access) + nu , & ! unit number + nbits ! no. of bits per variable (0 for sequential access) integer (kind=int_kind) :: RecSize, nbytes character (*) :: filename integer (kind=int_kind) :: & - nx, ny ! grid dimensions including ghost cells + nx, ny ! grid dimensions including ghost cells character(len=*), parameter :: subname = '(ice_open_ext)' @@ -200,22 +201,22 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & use ice_gather_scatter, only: scatter_global integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -225,7 +226,7 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & integer (kind=int_kind) :: i, j, ios real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -251,9 +252,10 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -280,7 +282,7 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & ignore_eof_use = .false. endif if (ignore_eof_use) then - ! Read line from file, checking for end-of-file + ! Read line from file, checking for end-of-file read(nu, iostat=ios) ((work_g1(i,j),i=1,nx_global), & j=1,ny_global) if (present(hit_eof)) hit_eof = ios < 0 @@ -300,9 +302,10 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & endif endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task==master_task .and. diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -310,10 +313,10 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(field_loc)) then call scatter_global(work, work_g1, master_task, distrb_info, & @@ -345,22 +348,22 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & use ice_domain_size, only: nblyr integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -370,7 +373,7 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & integer (kind=int_kind) :: i, j, k, ios real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -397,9 +400,10 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -426,7 +430,7 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & ignore_eof_use = .false. endif if (ignore_eof_use) then - ! Read line from file, checking for end-of-file + ! Read line from file, checking for end-of-file read(nu, iostat=ios) (((work_g4(i,j,k),i=1,nx_global), & j=1,ny_global), & k=1,nblyr+2) @@ -448,9 +452,10 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & endif endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task==master_task .and. diag) then amin = minval(work_g4) amax = maxval(work_g4, mask = work_g4 /= spval_dbl) @@ -458,27 +463,27 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- - do k = 1, nblyr+2 + do k = 1, nblyr+2 - if (present(field_loc)) then - call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & - field_loc, field_type) + if (present(field_loc)) then + call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & + field_loc, field_type) - else + else - call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & - field_loc_noupdate, field_type_noupdate) - endif + call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & + field_loc_noupdate, field_type_noupdate) + endif - enddo !k - deallocate(work_g4) + enddo !k + deallocate(work_g4) - end subroutine ice_read_xyzt + end subroutine ice_read_xyzt !======================================================================= @@ -492,18 +497,18 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & ignore_eof, hit_eof) integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_global,ny_global), intent(out) :: & - work_g ! output array (real, 8-byte) + work_g ! output array (real, 8-byte) character (len=4) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -513,7 +518,7 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & integer (kind=int_kind) :: i, j, ios real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -532,9 +537,10 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -578,9 +584,10 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & if (hit_eof) return endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task == master_task .and. diag) then amin = minval(work_g) amax = maxval(work_g, mask = work_g /= spval_dbl) @@ -602,18 +609,18 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & use ice_gather_scatter, only: scatter_global_ext integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -623,7 +630,7 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & integer (kind=int_kind) :: i, j, ios, nx, ny real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -652,9 +659,10 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -681,7 +689,7 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & ignore_eof_use = .false. endif if (ignore_eof_use) then - ! Read line from file, checking for end-of-file + ! Read line from file, checking for end-of-file read(nu, iostat=ios) ((work_g1(i,j),i=1,nx), & j=1,ny) if (present(hit_eof)) hit_eof = ios < 0 @@ -701,9 +709,10 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & endif endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task==master_task .and. diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -711,10 +720,10 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are always updated - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are always updated + !------------------------------------------------------------------- call scatter_global_ext(work, work_g1, master_task, distrb_info) @@ -732,25 +741,25 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) use ice_gather_scatter, only: gather_global integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables integer (kind=int_kind) :: i, j real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -766,9 +775,9 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) character(len=*), parameter :: subname = '(ice_write_xyt)' - !------------------------------------------------------------------- - ! Gather data from individual processors - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Gather data from individual processors + !------------------------------------------------------------------- if (my_task == master_task) then allocate(work_g1(nx_global,ny_global)) @@ -780,9 +789,10 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) if (my_task == master_task) then - !------------------------------------------------------------------- - ! Write global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Write global array according to format atype + !------------------------------------------------------------------- + if (atype == 'ida4') then allocate(work_gi4(nx_global,ny_global)) work_gi4 = nint(work_g1) @@ -806,9 +816,10 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif - !------------------------------------------------------------------- - ! diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! diagnostics + !------------------------------------------------------------------- + if (diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -833,26 +844,25 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) use ice_domain_size, only: nblyr integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) - real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), & - intent(in) :: & - work ! input array (real, 8-byte) + real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), intent(in) :: & + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables integer (kind=int_kind) :: i, j, k real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g4 @@ -868,9 +878,9 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) character(len=*), parameter :: subname = '(ice_write_xyzt)' - !------------------------------------------------------------------- - ! Gather data from individual processors - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Gather data from individual processors + !------------------------------------------------------------------- if (my_task == master_task) then allocate(work_g4(nx_global,ny_global,nblyr+2)) @@ -878,15 +888,16 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) allocate(work_g4(1,1,nblyr+2)) ! to save memory endif do k = 1,nblyr+2 - call gather_global(work_g4(:,:,k), work(:,:,k,:), master_task, & - distrb_info, spc_val=c0) + call gather_global(work_g4(:,:,k), work(:,:,k,:), master_task, & + distrb_info, spc_val=c0) enddo !k if (my_task == master_task) then - !------------------------------------------------------------------- - ! Write global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Write global array according to format atype + !------------------------------------------------------------------- + if (atype == 'ida4') then allocate(work_gi5(nx_global,ny_global,nblyr+2)) work_gi5 = nint(work_g4) @@ -911,9 +922,10 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif - !------------------------------------------------------------------- - ! diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! diagnostics + !------------------------------------------------------------------- + if (diag) then amin = minval(work_g4) amax = maxval(work_g4, mask = work_g4 /= spval_dbl) @@ -939,26 +951,25 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) use ice_gather_scatter, only: gather_global_ext integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) - real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), & - intent(in) :: & - work ! input array (real, 8-byte) + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: & + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables integer (kind=int_kind) :: i, j, nx, ny real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -974,9 +985,9 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) character(len=*), parameter :: subname = '(ice_write_ext)' - !------------------------------------------------------------------- - ! Gather data from individual processors - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Gather data from individual processors + !------------------------------------------------------------------- nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -991,9 +1002,10 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) if (my_task == master_task) then - !------------------------------------------------------------------- - ! Write global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Write global array according to format atype + !------------------------------------------------------------------- + if (atype == 'ida4') then allocate(work_gi4(nx,ny)) work_gi4 = nint(work_g1) @@ -1017,9 +1029,10 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif - !------------------------------------------------------------------- - ! diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! diagnostics + !------------------------------------------------------------------- + if (diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -1041,10 +1054,10 @@ end subroutine ice_write_ext subroutine ice_open_nc(filename, fid) character (char_len_long), intent(in) :: & - filename ! netCDF filename + filename ! netCDF filename integer (kind=int_kind), intent(out) :: & - fid ! unit number + fid ! unit number ! local variables @@ -1052,16 +1065,13 @@ subroutine ice_open_nc(filename, fid) #ifdef USE_NETCDF integer (kind=int_kind) :: & - status ! status variable from netCDF routine + status ! status variable from netCDF routine if (my_task == master_task) then status = nf90_open(filename, NF90_NOWRITE, fid) - if (status /= nf90_noerr) then - !write(nu_diag,*) subname,' NF90_STRERROR = ',trim(nf90_strerror(status)) - call abort_ice(subname//' ERROR: Cannot open '//trim(filename), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot open '//trim(filename), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task @@ -1088,24 +1098,24 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables @@ -1114,17 +1124,17 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid , & ! variable id - status , & ! status output from netcdf routines - ndims , & ! number of dimensions - dimlen ! dimension size + varid , & ! variable id + status , & ! status output from netcdf routines + ndims , & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind) :: & missingvalue, & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1167,67 +1177,54 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 2) then status = nf90_inquire_dimension(fid, dimids(3), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 3 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 3 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,lnrec/), & - count=(/nx_global+2,ny_global+1,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + start=(/1,1,lnrec/), count=(/nx_global+2,ny_global+1,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & file=__FILE__, line=__LINE__) - endif work_g1 = work_g2(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,lnrec/), & - count=(/nx,ny,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,lnrec/), count=(/nx,ny,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif - status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1239,16 +1236,22 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo + ! optional + missingvalue = 1.234e30 + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) +! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & +! file=__FILE__, line=__LINE__) + write(nu_diag,*) subname,' missingvalue= ',missingvalue amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= missingvalue) asum = sum (work_g1, mask = work_g1 /= missingvalue) write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -1294,24 +1297,24 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output real (kind=dbl_kind), dimension(nx_block,ny_block,ncat,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables @@ -1320,21 +1323,21 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - n, & ! ncat index - varid , & ! variable id - status , & ! status output from netcdf routines - ndims , & ! number of dimensions - dimlen ! dimension size + n, & ! ncat index + varid , & ! variable id + status , & ! status output from netcdf routines + ndims , & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind) :: & - missingvalue, & ! missing value - amin, amax, asum ! min, max values and sum of input array + missingvalue, & ! missing value + amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1375,67 +1378,54 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 3) then status = nf90_inquire_dimension(fid, dimids(4), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 4 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,1,lnrec/), & - count=(/nx_global+2,ny_global+1,ncat,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx_global+2,ny_global+1,ncat,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) work_g1 = work_g2(2:nx_global+1,1:ny_global,:) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,lnrec/), & - count=(/nx,ny,ncat,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx,ny,ncat,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif - status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1447,6 +1437,12 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo + ! optional + missingvalue = 1.234e30 + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) +! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & +! file=__FILE__, line=__LINE__) + write(nu_diag,*) subname,' missingvalue= ',missingvalue do n=1,ncat amin = minval(work_g1(:,:,n)) amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) @@ -1455,10 +1451,10 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & enddo endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -1511,47 +1507,46 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output - real (kind=dbl_kind), dimension(nx_block,ny_block,nfreq,1,max_blocks), & - intent(out) :: & - work ! output array (real, 8-byte) + real (kind=dbl_kind), dimension(nx_block,ny_block,nfreq,1,max_blocks), intent(out) :: & + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! variable id - status, & ! status output from netcdf routines - ndim, nvar, & ! sizes of netcdf file - id, & ! dimension index - n, & ! ncat index - ndims, & ! number of dimensions - dimlen ! dimension size + varid, & ! variable id + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + id, & ! dimension index + n, & ! ncat index + ndims, & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind) :: & - missingvalue, & ! missing value - amin, amax, asum ! min, max values and sum of input array + missingvalue, & ! missing value + amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - dimname ! dimension name + dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1595,67 +1590,54 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 3) then status = nf90_inquire_dimension(fid, dimids(4), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 4 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,1,lnrec/), & - count=(/nx_global+2,ny_global+1,nfreq,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx_global+2,ny_global+1,nfreq,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) work_g1 = work_g2(2:nx_global+1,1:ny_global,:) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,lnrec/), & - count=(/nx,ny,nfreq,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx,ny,nfreq,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif - status = nf90_get_att(fid, varid, "missing_value", missingvalue) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1667,6 +1649,11 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen enddo + ! optional + missingvalue = 1.234e30 + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) +! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & +! file=__FILE__, line=__LINE__) write(nu_diag,*) subname,' missingvalue= ',missingvalue do n = 1, nfreq amin = minval(work_g1(:,:,n)) @@ -1676,10 +1663,10 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & enddo endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -1725,21 +1712,21 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & field_loc, field_type) integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) real (kind=dbl_kind), intent(out) :: & - work ! output variable (real, 8-byte) + work ! output variable (real, 8-byte) ! local variables @@ -1748,76 +1735,67 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar, & ! sizes of netcdf file - id, & ! dimension index - ndims, & ! number of dimensions - dimlen ! dimension size + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + id, & ! dimension index + ndims, & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind), dimension(1) :: & - workg ! temporary work variable + workg ! temporary work variable integer (kind=int_kind) :: lnrec ! local value of nrec character (char_len) :: & - dimname ! dimension name + dimname ! dimension name lnrec = nrec if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 0) then status = nf90_inquire_dimension(fid, dimids(1), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 1 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 1 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read point variable - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read point variable + !-------------------------------------------------------------- status = nf90_get_var(fid, varid, workg, & - start= (/ lnrec /), & - count=(/ 1 /)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start= (/ lnrec /), count=(/ 1 /)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1850,17 +1828,17 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & use ice_fileunits, only: nu_diag integer (kind=int_kind), intent(in) :: & - fid , & ! file id - xdim ! field dimensions + fid , & ! file id + xdim ! field dimensions logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(:), intent(out) :: & - work ! output array + work ! output array ! local variables @@ -1869,12 +1847,12 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar ! sizes of netcdf file + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar ! sizes of netcdf file real (kind=dbl_kind), dimension(xdim) :: & - workg ! output array (real, 8-byte) + workg ! output array (real, 8-byte) !-------------------------------------------------------------- @@ -1885,23 +1863,23 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & file=__FILE__, line=__LINE__ ) endif + !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) !-------------------------------------------------------------- ! Read array !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & - start=(/1/), & - count=(/xdim/) ) + start=(/1/), count=(/xdim/) ) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) work(1:xdim) = workg(1:xdim) !------------------------------------------------------------------- @@ -1934,17 +1912,17 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & use ice_fileunits, only: nu_diag integer (kind=int_kind), intent(in) :: & - fid , & ! file id - xdim, ydim ! field dimensions + fid , & ! file id + xdim, ydim ! field dimensions logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(:,:), intent(out) :: & - work ! output array + work ! output array ! local variables @@ -1953,12 +1931,12 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar ! sizes of netcdf file + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar ! sizes of netcdf file real (kind=dbl_kind), dimension(xdim,ydim) :: & - workg ! output array (real, 8-byte) + workg ! output array (real, 8-byte) !-------------------------------------------------------------- @@ -1971,23 +1949,23 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & file=__FILE__, line=__LINE__ ) endif + !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status,subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) !-------------------------------------------------------------- ! Read array !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & - start=(/1,1/), & - count=(/xdim,ydim/) ) + start=(/1,1/), count=(/xdim,ydim/) ) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) work(1:xdim,1:ydim) = workg(1:xdim, 1:ydim) !------------------------------------------------------------------- @@ -2011,7 +1989,6 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & end subroutine ice_read_nc_2D !======================================================================= -!======================================================================= ! Written by T. Craig @@ -2021,17 +1998,17 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & use ice_fileunits, only: nu_diag integer (kind=int_kind), intent(in) :: & - fid , & ! file id - xdim, ydim,zdim ! field dimensions + fid , & ! file id + xdim, ydim,zdim ! field dimensions logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(:,:,:), intent(out) :: & - work ! output array + work ! output array ! local variables @@ -2040,12 +2017,12 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar ! sizes of netcdf file + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar ! sizes of netcdf file real (kind=dbl_kind), dimension(xdim,ydim,zdim) :: & - workg ! output array (real, 8-byte) + workg ! output array (real, 8-byte) !-------------------------------------------------------------- @@ -2060,23 +2037,23 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & file=__FILE__, line=__LINE__ ) endif + !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) !-------------------------------------------------------------- ! Read array !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & - start=(/1,1,1/), & - count=(/xdim,ydim,zdim/) ) + start=(/1,1,1/), count=(/xdim,ydim,zdim/) ) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) work(1:xdim,1:ydim,1:zdim) = workg(1:xdim, 1:ydim, 1:zdim) !------------------------------------------------------------------- @@ -2109,42 +2086,42 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & use ice_domain_size, only: nilyr integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) real (kind=dbl_kind), dimension(nilyr), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) ! local variables #ifdef USE_NETCDF real (kind=dbl_kind), dimension(:), allocatable :: & - work_z + work_z ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar, & ! sizes of netcdf file - id, & ! dimension index - ndims, & ! number of dimensions - dimlen ! dimension size + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + id, & ! dimension index + ndims, & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids character (char_len) :: & - dimname ! dimension name + dimname ! dimension name integer (kind=int_kind) :: lnrec ! local value of nrec @@ -2160,54 +2137,45 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 1) then status = nf90_inquire_dimension(fid, dimids(2), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 2 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 2 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_z, & - start=(/1,lnrec/), & - count=(/nilyr,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,lnrec/), count=(/nilyr,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -2243,21 +2211,21 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & use ice_gather_scatter, only: gather_global, gather_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - varid , & ! variable id - nrec ! record number + fid , & ! file id + varid , & ! variable id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, write extended grid + restart_ext ! if true, write extended grid real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=*), optional, intent(in) :: & - varname ! variable name + varname ! variable name ! local variables @@ -2266,17 +2234,17 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + status ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - lvarname ! variable name -! dimname ! dimension name + lvarname ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -2315,19 +2283,19 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & if (my_task == master_task) then - !-------------------------------------------------------------- - ! Write global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Write global array + !-------------------------------------------------------------- status = nf90_put_var( fid, varid, work_g1, & - start=(/1,1,nrec/), & - count=(/nx,ny,1/)) - + start=(/1,1,nrec/), count=(/nx,ny,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot put variable ', & + file=__FILE__, line=__LINE__ ) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then ! write(nu_diag,*) & @@ -2366,21 +2334,21 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & use ice_gather_scatter, only: gather_global, gather_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - varid , & ! variable id - nrec ! record number + fid , & ! file id + varid , & ! variable id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid real (kind=dbl_kind), dimension(nx_block,ny_block,ncat,max_blocks), intent(in) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=*), optional, intent(in) :: & - varname ! variable name + varname ! variable name ! local variables @@ -2389,18 +2357,18 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - n, & ! ncat index - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + n, & ! ncat index + status ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - lvarname ! variable name -! dimname ! dimension name + lvarname ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2445,19 +2413,19 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & if (my_task == master_task) then - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Write global array + !-------------------------------------------------------------- status = nf90_put_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,ncat,1/)) - + start=(/1,1,1,nrec/), count=(/nx,ny,ncat,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot put variable ', & + file=__FILE__, line=__LINE__ ) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then ! write(nu_diag,*) & @@ -2500,17 +2468,17 @@ end subroutine ice_write_nc_xyz subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number - character (char_len), intent(in) :: & - varname ! field name in netcdf file + character (char_len), intent(in) :: & + varname ! field name in netcdf file real (kind=dbl_kind), dimension(nx_global,ny_global), intent(out) :: & - work_g ! output array (real, 8-byte) + work_g ! output array (real, 8-byte) logical (kind=log_kind) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables @@ -2519,17 +2487,17 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + varid, & ! netcdf id for field + status ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name ! real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2547,43 +2515,35 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid) then status = nf90_get_var( fid, varid, work_g3, & - start=(/1,1,nrec/), & - count=(/nx_global+2,ny_global+1,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,nrec/), count=(/nx_global+2,ny_global+1,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) work_g=work_g3(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g, & - start=(/1,1,nrec/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,nrec/), count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task == master_task .and. diag) then ! write(nu_diag,*) & @@ -2613,13 +2573,47 @@ end subroutine ice_read_global_nc !======================================================================= +! Report a netcdf error +! author: T. Craig + + subroutine ice_check_nc(status, abort_msg, file, line) + integer(kind=int_kind), intent (in) :: status + character (len=*) , intent (in) :: abort_msg + character (len=*) , intent (in), optional :: file + integer(kind=int_kind), intent (in), optional :: line + + ! local variables + + character(len=*), parameter :: subname = '(ice_check_nc)' + +#ifdef USE_NETCDF + if (status /= nf90_noerr) then + if (present(file) .and. present(line)) then + call abort_ice(subname//trim(nf90_strerror(status))//':'//trim(abort_msg), & + file=file, line=line) + elseif (present(file)) then + call abort_ice(subname//trim(nf90_strerror(status))//':'//trim(abort_msg), & + file=file) + else + call abort_ice(subname//trim(nf90_strerror(status))//':'//trim(abort_msg)) + endif + endif +#else + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + + end subroutine ice_check_nc + +!======================================================================= + ! Closes a netCDF file ! author: Alison McLaren, Met Office subroutine ice_close_nc(fid) integer (kind=int_kind), intent(in) :: & - fid ! unit number + fid ! unit number ! local variables @@ -2631,6 +2625,8 @@ subroutine ice_close_nc(fid) if (my_task == master_task) then status = nf90_close(fid) + call ice_check_nc(status, subname//' ERROR: Cannot close file ', & + file=__FILE__, line=__LINE__ ) endif #else call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & @@ -2655,25 +2651,25 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec , & ! record number - nzlev ! z level + fid , & ! file id + nrec , & ! record number + nzlev ! z level logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables @@ -2682,17 +2678,17 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid , & ! variable id - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + varid , & ! variable id + status ! status output from netcdf routines +! ndim, nvar , & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -2717,33 +2713,28 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,nzlev,nrec/), & - count=(/nx,ny,1,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,nzlev,nrec/), count=(/nx,ny,1,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then amin = minval(work_g1) @@ -2752,10 +2743,10 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -2792,18 +2783,17 @@ end subroutine ice_read_nc_uv subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file - real (kind=dbl_kind), dimension(nrec), & - intent(out) :: & - work_g ! output array (real, 8-byte) + real (kind=dbl_kind), dimension(nrec), intent(out) :: & + work_g ! output array (real, 8-byte) logical (kind=log_kind) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables @@ -2812,37 +2802,32 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status ! status output from netcdf routines + varid, & ! netcdf id for field + status ! status output from netcdf routines real (kind=dbl_kind) :: & - amin, amax ! min, max values of input vector + amin, amax ! min, max values of input vector work_g(:) = c0 if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_g, & - start=(/1/), & - count=(/nrec/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1/), count=(/nrec/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task @@ -2888,26 +2873,22 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) #ifdef USE_NETCDF if (my_task == master_task) then status=nf90_inquire(fid, nDimensions = nDims) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire nDimensions', & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status, subname//' ERROR: inquire nDimensions', & + file=__FILE__, line=__LINE__ ) do i=1,nDims status = nf90_inquire_dimension(fid,i,name=cvar,len=recsize) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire len for variable '//trim(cvar), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire len for variable '//trim(cvar), & + file=__FILE__, line=__LINE__) if (trim(cvar) == trim(varname)) exit enddo if (trim(cvar) .ne. trim(varname)) then call abort_ice(subname//' ERROR: Did not find variable '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif #else call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) recsize = 0 ! to satisfy intent(out) attribute #endif diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index 4a0e86233..cba629a64 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -24,6 +24,7 @@ module ice_history_write use ice_constants, only: c0, c360, p5, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice + use ice_read_write, only: ice_check_nc use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters @@ -137,654 +138,654 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then - call construct_filename(ncfile(ns),'nc',ns) + call construct_filename(ncfile(ns),'nc',ns) - ! add local directory path name to ncfile - if (write_ic) then - ncfile(ns) = trim(incond_dir)//ncfile(ns) - else - ncfile(ns) = trim(history_dir)//ncfile(ns) - endif - - ! create file - iflag = nf90_clobber - if (lcdf64) iflag = ior(iflag,nf90_64bit_offset) - status = nf90_create(ncfile(ns), iflag, ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: creating history ncfile '//ncfile(ns)) - - !----------------------------------------------------------------- - ! define dimensions - !----------------------------------------------------------------- - - if (hist_avg(ns) .and. .not. write_ic) then - status = nf90_def_dim(ncid,'nbnd',2,boundid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nbnd') - endif - - status = nf90_def_dim(ncid,'ni',nx_global,imtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim ni') - - status = nf90_def_dim(ncid,'nj',ny_global,jmtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nj') - - status = nf90_def_dim(ncid,'nc',ncat_hist,cmtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nc') - - status = nf90_def_dim(ncid,'nkice',nzilyr,kmtidi) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nki') - - status = nf90_def_dim(ncid,'nksnow',nzslyr,kmtids) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nks') - - status = nf90_def_dim(ncid,'nkbio',nzblyr,kmtidb) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nkb') - - status = nf90_def_dim(ncid,'nkaer',nzalyr,kmtida) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nka') - - status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim time') - - status = nf90_def_dim(ncid,'nvertices',nverts,nvertexid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nverts') - - status = nf90_def_dim(ncid,'nf',nfsd_hist,fmtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nf') - - !----------------------------------------------------------------- - ! define coordinate variables - !----------------------------------------------------------------- - - status = nf90_def_var(ncid,'time',nf90_double,timid,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining var time') - - status = nf90_put_att(ncid,varid,'long_name','time') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ice Error: time long_name') - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - status = nf90_put_att(ncid,varid,'units',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time units') - - if (days_per_year == 360) then - status = nf90_put_att(ncid,varid,'calendar','360_day') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = nf90_put_att(ncid,varid,'calendar','noleap') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (use_leap_years) then - status = nf90_put_att(ncid,varid,'calendar','Gregorian') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif - - if (hist_avg(ns) .and. .not. write_ic) then - status = nf90_put_att(ncid,varid,'bounds','time_bounds') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time bounds') - endif - - !----------------------------------------------------------------- - ! Define attributes for time bounds if hist_avg is true - !----------------------------------------------------------------- - - if (hist_avg(ns) .and. .not. write_ic) then - dimid(1) = boundid - dimid(2) = timid - status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining var time_bounds') - status = nf90_put_att(ncid,varid,'long_name', & - 'time interval endpoints') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time_bounds long_name') - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - status = nf90_put_att(ncid,varid,'units',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time_bounds units') - if (days_per_year == 360) then - status = nf90_put_att(ncid,varid,'calendar','360_day') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = nf90_put_att(ncid,varid,'calendar','noleap') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (use_leap_years) then - status = nf90_put_att(ncid,varid,'calendar','Gregorian') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif - - endif + ! add local directory path name to ncfile + if (write_ic) then + ncfile(ns) = trim(incond_dir)//ncfile(ns) + else + ncfile(ns) = trim(history_dir)//ncfile(ns) + endif - !----------------------------------------------------------------- - ! define information for required time-invariant variables - !----------------------------------------------------------------- + ! create file + iflag = nf90_clobber + if (lcdf64) iflag = ior(iflag,nf90_64bit_offset) + status = nf90_create(ncfile(ns), iflag, ncid) + call ice_check_nc(status, subname// ' ERROR: creating history ncfile '//ncfile(ns), & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! define dimensions + !----------------------------------------------------------------- + + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_def_dim(ncid,'nbnd',2,boundid) + call ice_check_nc(status, subname// ' ERROR: defining dim nbnd', & + file=__FILE__, line=__LINE__) + endif - ind = 0 - ind = ind + 1 - var_coord(ind) = coord_attributes('TLON', & - 'T grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lont_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('TLAT', & - 'T grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latt_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ULON', & - 'U grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lonu_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ULAT', & - 'U grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latu_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('NLON', & - 'N grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lonn_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('NLAT', & - 'N grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latn_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ELON', & - 'E grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lone_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ELAT', & - 'E grid center latitude', 'degrees_north') - coord_bounds(ind) = 'late_bounds' - - var_grdz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') - var_grdz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') - var_grdz(3) = coord_attributes('VGRDs', 'vertical snow levels', '1') - var_grdz(4) = coord_attributes('VGRDb', 'vertical ice-bio levels', '1') - var_grdz(5) = coord_attributes('VGRDa', 'vertical snow-ice-bio levels', '1') - var_grdz(6) = coord_attributes('NFSD', 'category floe size (center)', 'm') + status = nf90_def_dim(ncid,'ni',nx_global,imtid) + call ice_check_nc(status, subname// ' ERROR: defining dim ni', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nj',ny_global,jmtid) + call ice_check_nc(status, subname// ' ERROR: defining dim nj', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nc',ncat_hist,cmtid) + call ice_check_nc(status, subname// ' ERROR: defining dim nc', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nkice',nzilyr,kmtidi) + call ice_check_nc(status, subname// ' ERROR: defining dim nki', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nksnow',nzslyr,kmtids) + call ice_check_nc(status, subname// ' ERROR: defining dim nks', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nkbio',nzblyr,kmtidb) + call ice_check_nc(status, subname// ' ERROR: defining dim nkb', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nkaer',nzalyr,kmtida) + call ice_check_nc(status, subname// ' ERROR: defining dim nka', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid) + call ice_check_nc(status, subname// ' ERROR: defining dim time', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nvertices',nverts,nvertexid) + call ice_check_nc(status, subname// ' ERROR: defining dim nverts', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nf',nfsd_hist,fmtid) + call ice_check_nc(status, subname// ' ERROR: defining dim nf', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! define coordinate variables + !----------------------------------------------------------------- + + status = nf90_def_var(ncid,'time',nf90_double,timid,varid) + call ice_check_nc(status, subname// ' ERROR: defining var time', & + file=__FILE__, line=__LINE__) + + status = nf90_put_att(ncid,varid,'long_name','time') + call ice_check_nc(status, subname// ' ERROR: time long_name', & + file=__FILE__, line=__LINE__) + + write(cdate,'(i8.8)') idate0 + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init + status = nf90_put_att(ncid,varid,'units',title) + call ice_check_nc(status, subname// ' ERROR: time units', & + file=__FILE__, line=__LINE__) + + if (days_per_year == 360) then + status = nf90_put_att(ncid,varid,'calendar','360_day') + call ice_check_nc(status, subname// ' ERROR: time calendar', & + file=__FILE__, line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + status = nf90_put_att(ncid,varid,'calendar','noleap') + call ice_check_nc(status, subname// ' ERROR: time calendar', & + file=__FILE__, line=__LINE__) + elseif (use_leap_years) then + status = nf90_put_att(ncid,varid,'calendar','Gregorian') + call ice_check_nc(status, subname// ' ERROR: time calendar', & + file=__FILE__, line=__LINE__) + else + call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! define information for optional time-invariant variables - !----------------------------------------------------------------- + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_put_att(ncid,varid,'bounds','time_bounds') + call ice_check_nc(status, subname// ' ERROR: time bounds', & + file=__FILE__, line=__LINE__) + endif - var_grd(n_tmask)%req = coord_attributes('tmask', & - 'mask of T grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_tmask)%coordinates = 'TLON TLAT' - var_grd(n_umask)%req = coord_attributes('umask', & - 'mask of U grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_umask)%coordinates = 'ULON ULAT' - var_grd(n_nmask)%req = coord_attributes('nmask', & - 'mask of N grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_nmask)%coordinates = 'NLON NLAT' - var_grd(n_emask)%req = coord_attributes('emask', & - 'mask of E grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_emask)%coordinates = 'ELON ELAT' - - var_grd(n_tarea)%req = coord_attributes('tarea', & - 'area of T grid cells', 'm^2') - var_grd(n_tarea)%coordinates = 'TLON TLAT' - var_grd(n_uarea)%req = coord_attributes('uarea', & - 'area of U grid cells', 'm^2') - var_grd(n_uarea)%coordinates = 'ULON ULAT' - var_grd(n_narea)%req = coord_attributes('narea', & - 'area of N grid cells', 'm^2') - var_grd(n_narea)%coordinates = 'NLON NLAT' - var_grd(n_earea)%req = coord_attributes('earea', & - 'area of E grid cells', 'm^2') - var_grd(n_earea)%coordinates = 'ELON ELAT' - - var_grd(n_blkmask)%req = coord_attributes('blkmask', & - 'block id of T grid cells, mytask + iblk/100', 'unitless') - var_grd(n_blkmask)%coordinates = 'TLON TLAT' - - var_grd(n_dxt)%req = coord_attributes('dxt', & - 'T cell width through middle', 'm') - var_grd(n_dxt)%coordinates = 'TLON TLAT' - var_grd(n_dyt)%req = coord_attributes('dyt', & - 'T cell height through middle', 'm') - var_grd(n_dyt)%coordinates = 'TLON TLAT' - var_grd(n_dxu)%req = coord_attributes('dxu', & - 'U cell width through middle', 'm') - var_grd(n_dxu)%coordinates = 'ULON ULAT' - var_grd(n_dyu)%req = coord_attributes('dyu', & - 'U cell height through middle', 'm') - var_grd(n_dyu)%coordinates = 'ULON ULAT' - var_grd(n_dxn)%req = coord_attributes('dxn', & - 'N cell width through middle', 'm') - var_grd(n_dxn)%coordinates = 'NLON NLAT' - var_grd(n_dyn)%req = coord_attributes('dyn', & - 'N cell height through middle', 'm') - var_grd(n_dyn)%coordinates = 'NLON NLAT' - var_grd(n_dxe)%req = coord_attributes('dxe', & - 'E cell width through middle', 'm') - var_grd(n_dxe)%coordinates = 'ELON ELAT' - var_grd(n_dye)%req = coord_attributes('dye', & - 'E cell height through middle', 'm') - var_grd(n_dye)%coordinates = 'ELON ELAT' - - var_grd(n_HTN)%req = coord_attributes('HTN', & - 'T cell width on North side','m') - var_grd(n_HTN)%coordinates = 'TLON TLAT' - var_grd(n_HTE)%req = coord_attributes('HTE', & - 'T cell width on East side', 'm') - var_grd(n_HTE)%coordinates = 'TLON TLAT' - var_grd(n_ANGLE)%req = coord_attributes('ANGLE', & - 'angle grid makes with latitude line on U grid', & - 'radians') - var_grd(n_ANGLE)%coordinates = 'ULON ULAT' - var_grd(n_ANGLET)%req = coord_attributes('ANGLET', & - 'angle grid makes with latitude line on T grid', & - 'radians') - var_grd(n_ANGLET)%coordinates = 'TLON TLAT' - - ! These fields are required for CF compliance - ! dimensions (nx,ny,nverts) - var_nverts(n_lont_bnds) = coord_attributes('lont_bounds', & - 'longitude boundaries of T cells', 'degrees_east') - var_nverts(n_latt_bnds) = coord_attributes('latt_bounds', & - 'latitude boundaries of T cells', 'degrees_north') - var_nverts(n_lonu_bnds) = coord_attributes('lonu_bounds', & - 'longitude boundaries of U cells', 'degrees_east') - var_nverts(n_latu_bnds) = coord_attributes('latu_bounds', & - 'latitude boundaries of U cells', 'degrees_north') - var_nverts(n_lonn_bnds) = coord_attributes('lonn_bounds', & - 'longitude boundaries of N cells', 'degrees_east') - var_nverts(n_latn_bnds) = coord_attributes('latn_bounds', & - 'latitude boundaries of N cells', 'degrees_north') - var_nverts(n_lone_bnds) = coord_attributes('lone_bounds', & - 'longitude boundaries of E cells', 'degrees_east') - var_nverts(n_late_bnds) = coord_attributes('late_bounds', & - 'latitude boundaries of E cells', 'degrees_north') + !----------------------------------------------------------------- + ! Define attributes for time bounds if hist_avg is true + !----------------------------------------------------------------- + + if (hist_avg(ns) .and. .not. write_ic) then + dimid(1) = boundid + dimid(2) = timid + status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) + call ice_check_nc(status, subname// ' ERROR: defining var time_bounds', & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid,'long_name', 'time interval endpoints') + call ice_check_nc(status, subname// ' ERROR: time_bounds long_name', & + file=__FILE__, line=__LINE__) + write(cdate,'(i8.8)') idate0 + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init + status = nf90_put_att(ncid,varid,'units',title) + call ice_check_nc(status, subname// ' ERROR: time_bounds units', & + file=__FILE__, line=__LINE__) + if (days_per_year == 360) then + status = nf90_put_att(ncid,varid,'calendar','360_day') + call ice_check_nc(status, subname// ' ERROR: time calendar1', & + file=__FILE__, line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + status = nf90_put_att(ncid,varid,'calendar','noleap') + call ice_check_nc(status, subname// ' ERROR: time calendar2', & + file=__FILE__, line=__LINE__) + elseif (use_leap_years) then + status = nf90_put_att(ncid,varid,'calendar','Gregorian') + call ice_check_nc(status, subname// ' ERROR: time calendar3', & + file=__FILE__, line=__LINE__) + else + call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! define attributes for time-invariant variables - !----------------------------------------------------------------- - - dimid(1) = imtid - dimid(2) = jmtid - dimid(3) = timid - - do i = 1, ncoord - status = nf90_def_var(ncid, var_coord(i)%short_name, lprecision, & - dimid(1:2), varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining short_name for '//var_coord(i)%short_name) - status = nf90_put_att(ncid,varid,'long_name',var_coord(i)%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_coord(i)%short_name) - status = nf90_put_att(ncid, varid, 'units', var_coord(i)%units) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_coord(i)%short_name) - call ice_write_hist_fill(ncid,varid,var_coord(i)%short_name,history_precision) - if (var_coord(i)%short_name == 'ULAT') then - status = nf90_put_att(ncid,varid,'comment', & - 'Latitude of NE corner of T grid cell') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining comment for '//var_coord(i)%short_name) - endif - if (f_bounds) then - status = nf90_put_att(ncid, varid, 'bounds', coord_bounds(i)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining bounds for '//var_coord(i)%short_name) - endif - enddo - - ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) - dimidex(1)=cmtid - dimidex(2)=kmtidi - dimidex(3)=kmtids - dimidex(4)=kmtidb - dimidex(5)=kmtida - dimidex(6)=fmtid - - do i = 1, nvar_grdz - if (igrdz(i)) then - status = nf90_def_var(ncid, var_grdz(i)%short_name, & - lprecision, dimidex(i), varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining short_name for '//var_grdz(i)%short_name) - status = nf90_put_att(ncid,varid,'long_name',var_grdz(i)%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_grdz(i)%short_name) - status = nf90_put_att(ncid, varid, 'units', var_grdz(i)%units) - if (Status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_grdz(i)%short_name) - endif - enddo - - do i = 1, nvar_grd - if (igrd(i)) then - status = nf90_def_var(ncid, var_grd(i)%req%short_name, & - lprecision, dimid(1:2), varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//var_grd(i)%req%short_name) - status = nf90_put_att(ncid,varid, 'long_name', var_grd(i)%req%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_grd(i)%req%short_name) - status = nf90_put_att(ncid, varid, 'units', var_grd(i)%req%units) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_grd(i)%req%short_name) - status = nf90_put_att(ncid, varid, 'coordinates', var_grd(i)%coordinates) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining coordinates for '//var_grd(i)%req%short_name) - call ice_write_hist_fill(ncid,varid,var_grd(i)%req%short_name,history_precision) - endif - enddo - - ! Fields with dimensions (nverts,nx,ny) - dimid_nverts(1) = nvertexid - dimid_nverts(2) = imtid - dimid_nverts(3) = jmtid - do i = 1, nvar_verts - if (f_bounds) then - status = nf90_def_var(ncid, var_nverts(i)%short_name, & - lprecision,dimid_nverts, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//var_nverts(i)%short_name) - status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_nverts(i)%short_name) - status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_nverts(i)%short_name) - call ice_write_hist_fill(ncid,varid,var_nverts(i)%short_name,history_precision) - endif - enddo - - do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimid, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_2D - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = cmtid - dimidz(4) = timid - - do n = n2D + 1, n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dc - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidi - dimidz(4) = timid - - do n = n3Dccum + 1, n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dz - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidb - dimidz(4) = timid - - do n = n3Dzcum + 1, n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Db - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtida - dimidz(4) = timid - - do n = n3Dbcum + 1, n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Da - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = fmtid - dimidz(4) = timid - - do n = n3Dacum + 1, n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Df - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtidi - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n3Dfcum + 1, n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! lprecision, dimidcz, varid) - lprecision, dimidcz(1:4), varid) ! ferret - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Di - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtids - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dicum + 1, n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! lprecision, dimidcz, varid) - lprecision, dimidcz(1:4), varid) ! ferret - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Ds - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = fmtid - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dscum + 1, n4Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! lprecision, dimidcz, varid) - lprecision, dimidcz(1:4), varid) ! ferret - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Df + endif - !----------------------------------------------------------------- - ! global attributes - !----------------------------------------------------------------- - ! ... the user should change these to something useful ... - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! define information for required time-invariant variables + !----------------------------------------------------------------- + + ind = 0 + ind = ind + 1 + var_coord(ind) = coord_attributes('TLON', & + 'T grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lont_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('TLAT', & + 'T grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latt_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ULON', & + 'U grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonu_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ULAT', & + 'U grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latu_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('NLON', & + 'N grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonn_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('NLAT', & + 'N grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latn_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ELON', & + 'E grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lone_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ELAT', & + 'E grid center latitude', 'degrees_north') + coord_bounds(ind) = 'late_bounds' + + var_grdz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') + var_grdz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') + var_grdz(3) = coord_attributes('VGRDs', 'vertical snow levels', '1') + var_grdz(4) = coord_attributes('VGRDb', 'vertical ice-bio levels', '1') + var_grdz(5) = coord_attributes('VGRDa', 'vertical snow-ice-bio levels', '1') + var_grdz(6) = coord_attributes('NFSD', 'category floe size (center)', 'm') + + !----------------------------------------------------------------- + ! define information for optional time-invariant variables + !----------------------------------------------------------------- + + var_grd(n_tmask)%req = coord_attributes('tmask', & + 'mask of T grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_tmask)%coordinates = 'TLON TLAT' + var_grd(n_umask)%req = coord_attributes('umask', & + 'mask of U grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_umask)%coordinates = 'ULON ULAT' + var_grd(n_nmask)%req = coord_attributes('nmask', & + 'mask of N grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_nmask)%coordinates = 'NLON NLAT' + var_grd(n_emask)%req = coord_attributes('emask', & + 'mask of E grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_emask)%coordinates = 'ELON ELAT' + + var_grd(n_tarea)%req = coord_attributes('tarea', & + 'area of T grid cells', 'm^2') + var_grd(n_tarea)%coordinates = 'TLON TLAT' + var_grd(n_uarea)%req = coord_attributes('uarea', & + 'area of U grid cells', 'm^2') + var_grd(n_uarea)%coordinates = 'ULON ULAT' + var_grd(n_narea)%req = coord_attributes('narea', & + 'area of N grid cells', 'm^2') + var_grd(n_narea)%coordinates = 'NLON NLAT' + var_grd(n_earea)%req = coord_attributes('earea', & + 'area of E grid cells', 'm^2') + var_grd(n_earea)%coordinates = 'ELON ELAT' + + var_grd(n_blkmask)%req = coord_attributes('blkmask', & + 'block id of T grid cells, mytask + iblk/100', 'unitless') + var_grd(n_blkmask)%coordinates = 'TLON TLAT' + + var_grd(n_dxt)%req = coord_attributes('dxt', & + 'T cell width through middle', 'm') + var_grd(n_dxt)%coordinates = 'TLON TLAT' + var_grd(n_dyt)%req = coord_attributes('dyt', & + 'T cell height through middle', 'm') + var_grd(n_dyt)%coordinates = 'TLON TLAT' + var_grd(n_dxu)%req = coord_attributes('dxu', & + 'U cell width through middle', 'm') + var_grd(n_dxu)%coordinates = 'ULON ULAT' + var_grd(n_dyu)%req = coord_attributes('dyu', & + 'U cell height through middle', 'm') + var_grd(n_dyu)%coordinates = 'ULON ULAT' + var_grd(n_dxn)%req = coord_attributes('dxn', & + 'N cell width through middle', 'm') + var_grd(n_dxn)%coordinates = 'NLON NLAT' + var_grd(n_dyn)%req = coord_attributes('dyn', & + 'N cell height through middle', 'm') + var_grd(n_dyn)%coordinates = 'NLON NLAT' + var_grd(n_dxe)%req = coord_attributes('dxe', & + 'E cell width through middle', 'm') + var_grd(n_dxe)%coordinates = 'ELON ELAT' + var_grd(n_dye)%req = coord_attributes('dye', & + 'E cell height through middle', 'm') + var_grd(n_dye)%coordinates = 'ELON ELAT' + + var_grd(n_HTN)%req = coord_attributes('HTN', & + 'T cell width on North side','m') + var_grd(n_HTN)%coordinates = 'TLON TLAT' + var_grd(n_HTE)%req = coord_attributes('HTE', & + 'T cell width on East side', 'm') + var_grd(n_HTE)%coordinates = 'TLON TLAT' + var_grd(n_ANGLE)%req = coord_attributes('ANGLE', & + 'angle grid makes with latitude line on U grid', & + 'radians') + var_grd(n_ANGLE)%coordinates = 'ULON ULAT' + var_grd(n_ANGLET)%req = coord_attributes('ANGLET', & + 'angle grid makes with latitude line on T grid', & + 'radians') + var_grd(n_ANGLET)%coordinates = 'TLON TLAT' + + ! These fields are required for CF compliance + ! dimensions (nx,ny,nverts) + var_nverts(n_lont_bnds) = coord_attributes('lont_bounds', & + 'longitude boundaries of T cells', 'degrees_east') + var_nverts(n_latt_bnds) = coord_attributes('latt_bounds', & + 'latitude boundaries of T cells', 'degrees_north') + var_nverts(n_lonu_bnds) = coord_attributes('lonu_bounds', & + 'longitude boundaries of U cells', 'degrees_east') + var_nverts(n_latu_bnds) = coord_attributes('latu_bounds', & + 'latitude boundaries of U cells', 'degrees_north') + var_nverts(n_lonn_bnds) = coord_attributes('lonn_bounds', & + 'longitude boundaries of N cells', 'degrees_east') + var_nverts(n_latn_bnds) = coord_attributes('latn_bounds', & + 'latitude boundaries of N cells', 'degrees_north') + var_nverts(n_lone_bnds) = coord_attributes('lone_bounds', & + 'longitude boundaries of E cells', 'degrees_east') + var_nverts(n_late_bnds) = coord_attributes('late_bounds', & + 'latitude boundaries of E cells', 'degrees_north') + + !----------------------------------------------------------------- + ! define attributes for time-invariant variables + !----------------------------------------------------------------- + + dimid(1) = imtid + dimid(2) = jmtid + dimid(3) = timid + + do i = 1, ncoord + status = nf90_def_var(ncid, var_coord(i)%short_name, lprecision, & + dimid(1:2), varid) + call ice_check_nc(status, subname// ' ERROR: defining short_name for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid,'long_name',var_coord(i)%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_coord(i)%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + call ice_write_hist_fill(ncid,varid,var_coord(i)%short_name,history_precision) + if (var_coord(i)%short_name == 'ULAT') then + status = nf90_put_att(ncid,varid,'comment', & + 'Latitude of NE corner of T grid cell') + call ice_check_nc(status, subname// ' ERROR: defining comment for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + if (f_bounds) then + status = nf90_put_att(ncid, varid, 'bounds', coord_bounds(i)) + call ice_check_nc(status, subname// ' ERROR: defining bounds for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + + ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) + dimidex(1)=cmtid + dimidex(2)=kmtidi + dimidex(3)=kmtids + dimidex(4)=kmtidb + dimidex(5)=kmtida + dimidex(6)=fmtid + + do i = 1, nvar_grdz + if (igrdz(i)) then + status = nf90_def_var(ncid, var_grdz(i)%short_name, & + lprecision, dimidex(i), varid) + call ice_check_nc(status, subname// ' ERROR: defining short_name for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid,'long_name',var_grdz(i)%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_grdz(i)%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + + do i = 1, nvar_grd + if (igrd(i)) then + status = nf90_def_var(ncid, var_grd(i)%req%short_name, & + lprecision, dimid(1:2), varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid, 'long_name', var_grd(i)%req%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_grd(i)%req%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'coordinates', var_grd(i)%coordinates) + call ice_check_nc(status, subname// ' ERROR: defining coordinates for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + call ice_write_hist_fill(ncid,varid,var_grd(i)%req%short_name,history_precision) + endif + enddo + + ! Fields with dimensions (nverts,nx,ny) + dimid_nverts(1) = nvertexid + dimid_nverts(2) = imtid + dimid_nverts(3) = jmtid + do i = 1, nvar_verts + if (f_bounds) then + status = nf90_def_var(ncid, var_nverts(i)%short_name, & + lprecision,dimid_nverts, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + call ice_write_hist_fill(ncid,varid,var_nverts(i)%short_name,history_precision) + endif + enddo + + do n=1,num_avail_hist_fields_2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & + lprecision, dimid, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_2D + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = cmtid + dimidz(4) = timid + + do n = n2D + 1, n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & + lprecision, dimidz, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_3Dc + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidi + dimidz(4) = timid + + do n = n3Dccum + 1, n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & + lprecision, dimidz, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_3Dz + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidb + dimidz(4) = timid + + do n = n3Dzcum + 1, n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & + lprecision, dimidz, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_3Db + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtida + dimidz(4) = timid + + do n = n3Dbcum + 1, n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & + lprecision, dimidz, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_3Da + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = fmtid + dimidz(4) = timid + + do n = n3Dacum + 1, n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & + lprecision, dimidz, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_3Df + + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtidi + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n3Dfcum + 1, n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_4Di + + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtids + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n4Dicum + 1, n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_4Ds + + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = fmtid + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n4Dscum + 1, n4Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_4Df + + !----------------------------------------------------------------- + ! global attributes + !----------------------------------------------------------------- + ! ... the user should change these to something useful ... + !----------------------------------------------------------------- #ifdef CESMCOUPLED - status = nf90_put_att(ncid,nf90_global,'title',runid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: in global attribute title') + status = nf90_put_att(ncid,nf90_global,'title',runid) + call ice_check_nc(status, subname// ' ERROR: in global attribute title', & + file=__FILE__, line=__LINE__) #else - title = 'sea ice model output for CICE' - status = nf90_put_att(ncid,nf90_global,'title',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: in global attribute title') + title = 'sea ice model output for CICE' + status = nf90_put_att(ncid,nf90_global,'title',title) + call ice_check_nc(status, subname// ' ERROR: in global attribute title', & + file=__FILE__, line=__LINE__) #endif - title = 'Diagnostic and Prognostic Variables' - status = nf90_put_att(ncid,nf90_global,'contents',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute contents') - - write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) - status = nf90_put_att(ncid,nf90_global,'source',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute source') - - if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',dayyr,' days' - else - write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' - endif - status = nf90_put_att(ncid,nf90_global,'comment',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute comment') - - write(title,'(a,i8.8)') 'File written on model date ',idate - status = nf90_put_att(ncid,nf90_global,'comment2',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute date1') - - write(title,'(a,i6)') 'seconds elapsed into model date: ',msec - status = nf90_put_att(ncid,nf90_global,'comment3',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute date2') - - select case (histfreq(ns)) - case ("y", "Y") - write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) - case ("m", "M") - write(time_period_freq,'(a,i0)') 'month_',histfreq_n(ns) - case ("d", "D") - write(time_period_freq,'(a,i0)') 'day_',histfreq_n(ns) - case ("h", "H") - write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) - case ("1") - write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) - end select - - if (.not.write_ic .and. trim(time_period_freq) /= 'none') then - status = nf90_put_att(ncid,nf90_global,'time_period_freq',trim(time_period_freq)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute time_period_freq') - endif - - if (hist_avg(ns)) then - status = nf90_put_att(ncid,nf90_global,'time_axis_position',trim(hist_time_axis)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute time axis position') - endif - - title = 'CF-1.0' - status = & - nf90_put_att(ncid,nf90_global,'conventions',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: in global attribute conventions') - - call date_and_time(date=current_date, time=current_time) - write(start_time,1000) current_date(1:4), current_date(5:6), & - current_date(7:8), current_time(1:2), & - current_time(3:4), current_time(5:8) -1000 format('This dataset was created on ', & - a,'-',a,'-',a,' at ',a,':',a,':',a) - - status = nf90_put_att(ncid,nf90_global,'history',start_time) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute history') - - status = nf90_put_att(ncid,nf90_global,'io_flavor','io_netcdf') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute io_flavor') - - !----------------------------------------------------------------- - ! end define mode - !----------------------------------------------------------------- - - status = nf90_enddef(ncid) - if (status /= nf90_noerr) call abort_ice(subname//'ERROR in nf90_enddef') - - !----------------------------------------------------------------- - ! write time variable - !----------------------------------------------------------------- - - ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) - - ! Some coupled models require the time axis "stamp" to be in the middle - ! or even beginning of averaging interval. - if (hist_avg(ns)) then - if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) - if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) - endif + title = 'Diagnostic and Prognostic Variables' + status = nf90_put_att(ncid,nf90_global,'contents',title) + call ice_check_nc(status, subname// ' ERROR: global attribute contents', & + file=__FILE__, line=__LINE__) + + write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) + status = nf90_put_att(ncid,nf90_global,'source',title) + call ice_check_nc(status, subname// ' ERROR: global attribute source', & + file=__FILE__, line=__LINE__) + + if (use_leap_years) then + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' + else + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' + endif + status = nf90_put_att(ncid,nf90_global,'comment',title) + call ice_check_nc(status, subname// ' ERROR: global attribute comment', & + file=__FILE__, line=__LINE__) + + write(title,'(a,i8.8)') 'File written on model date ',idate + status = nf90_put_att(ncid,nf90_global,'comment2',title) + call ice_check_nc(status, subname// ' ERROR: global attribute date1', & + file=__FILE__, line=__LINE__) + + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec + status = nf90_put_att(ncid,nf90_global,'comment3',title) + call ice_check_nc(status, subname// ' ERROR: global attribute date2', & + file=__FILE__, line=__LINE__) + + select case (histfreq(ns)) + case ("y", "Y") + write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) + case ("m", "M") + write(time_period_freq,'(a,i0)') 'month_',histfreq_n(ns) + case ("d", "D") + write(time_period_freq,'(a,i0)') 'day_',histfreq_n(ns) + case ("h", "H") + write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) + case ("1") + write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) + end select + + if (.not.write_ic .and. trim(time_period_freq) /= 'none') then + status = nf90_put_att(ncid,nf90_global,'time_period_freq',trim(time_period_freq)) + call ice_check_nc(status, subname// ' ERROR: global attribute time_period_freq', & + file=__FILE__, line=__LINE__) + endif - status = nf90_inq_varid(ncid,'time',varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting time varid') - status = nf90_put_var(ncid,varid,ltime2) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing time variable') + if (hist_avg(ns)) then + status = nf90_put_att(ncid,nf90_global,'time_axis_position',trim(hist_time_axis)) + call ice_check_nc(status, subname// ' ERROR: global attribute time axis position', & + file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! write time_bounds info - !----------------------------------------------------------------- + title = 'CF-1.0' + status = & + nf90_put_att(ncid,nf90_global,'conventions',title) + call ice_check_nc(status, subname// ' ERROR: in global attribute conventions', & + file=__FILE__, line=__LINE__) + + call date_and_time(date=current_date, time=current_time) + write(start_time,1000) current_date(1:4), current_date(5:6), & + current_date(7:8), current_time(1:2), & + current_time(3:4), current_time(5:8) +1000 format('This dataset was created on ', & + a,'-',a,'-',a,' at ',a,':',a,':',a) + + status = nf90_put_att(ncid,nf90_global,'history',start_time) + call ice_check_nc(status, subname// ' ERROR: global attribute history', & + file=__FILE__, line=__LINE__) + + status = nf90_put_att(ncid,nf90_global,'io_flavor','io_netcdf') + call ice_check_nc(status, subname// ' ERROR: global attribute io_flavor', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! end define mode + !----------------------------------------------------------------- + + status = nf90_enddef(ncid) + call ice_check_nc(status, subname// ' ERROR in nf90_enddef', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! write time variable + !----------------------------------------------------------------- + + ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) + + ! Some coupled models require the time axis "stamp" to be in the middle + ! or even beginning of averaging interval. + if (hist_avg(ns)) then + if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) + if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) + endif - if (hist_avg(ns) .and. .not. write_ic) then - status = nf90_inq_varid(ncid,'time_bounds',varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting time_bounds id') - status = nf90_put_var(ncid,varid,time_beg(ns),start=(/1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing time_beg') - status = nf90_put_var(ncid,varid,time_end(ns),start=(/2/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing time_end') - endif + status = nf90_inq_varid(ncid,'time',varid) + call ice_check_nc(status, subname// ' ERROR: getting time varid', & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,ltime2) + call ice_check_nc(status, subname// ' ERROR: writing time variable', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! write time_bounds info + !----------------------------------------------------------------- + + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_inq_varid(ncid,'time_bounds',varid) + call ice_check_nc(status, subname// ' ERROR: getting time_bounds id', & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,time_beg(ns),start=(/1/)) + call ice_check_nc(status, subname// ' ERROR: writing time_beg', & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,time_end(ns),start=(/2/)) + call ice_check_nc(status, subname// ' ERROR: writing time_end', & + file=__FILE__, line=__LINE__) + endif endif ! master_task @@ -800,138 +801,138 @@ subroutine ice_write_hist (ns) ! write coordinate variables !----------------------------------------------------------------- - do i = 1,ncoord - call broadcast_scalar(var_coord(i)%short_name,master_task) - SELECT CASE (var_coord(i)%short_name) + do i = 1,ncoord + call broadcast_scalar(var_coord(i)%short_name,master_task) + SELECT CASE (var_coord(i)%short_name) CASE ('TLON') - ! Convert T grid longitude from -180 -> 180 to 0 to 360 - work1 = TLON*rad_to_deg + c360 - where (work1 > c360) work1 = work1 - c360 - where (work1 < c0 ) work1 = work1 + c360 - call gather_global(work_g1,work1,master_task,distrb_info) + ! Convert T grid longitude from -180 -> 180 to 0 to 360 + work1 = TLON*rad_to_deg + c360 + where (work1 > c360) work1 = work1 - c360 + where (work1 < c0 ) work1 = work1 + c360 + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('TLAT') - work1 = TLAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = TLAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ULON') - work1 = ULON*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = ULON*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ULAT') - work1 = ULAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = ULAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('NLON') - work1 = NLON*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = NLON*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('NLAT') - work1 = NLAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = NLAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ELON') - work1 = ELON*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = ELON*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ELAT') - work1 = ELAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) - END SELECT - - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_coord(i)%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_coord(i)%short_name) - status = nf90_put_var(ncid,varid,work_g1) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing'//var_coord(i)%short_name) - endif - enddo - - ! Extra dimensions (NCAT, NFSD, VGRD*) - - do i = 1, nvar_grdz - if (igrdz(i)) then - call broadcast_scalar(var_grdz(i)%short_name,master_task) - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_grdz(i)%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_grdz(i)%short_name) - SELECT CASE (var_grdz(i)%short_name) - CASE ('NCAT') - status = nf90_put_var(ncid,varid,hin_max(1:ncat_hist)) - CASE ('NFSD') - status = nf90_put_var(ncid,varid,floe_rad_c(1:nfsd_hist)) - CASE ('VGRDi') ! index - needed for Met Office analysis code - status = nf90_put_var(ncid,varid,(/(k, k=1,nzilyr)/)) - CASE ('VGRDs') ! index - needed for Met Office analysis code - status = nf90_put_var(ncid,varid,(/(k, k=1,nzslyr)/)) - CASE ('VGRDb') - status = nf90_put_var(ncid,varid,(/(k, k=1,nzblyr)/)) - CASE ('VGRDa') - status = nf90_put_var(ncid,varid,(/(k, k=1,nzalyr)/)) - END SELECT - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing'//var_grdz(i)%short_name) - endif - endif - enddo + work1 = ELAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) + END SELECT + + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_coord(i)%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1) + call ice_check_nc(status, subname// ' ERROR: writing'//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + + ! Extra dimensions (NCAT, NFSD, VGRD*) + + do i = 1, nvar_grdz + if (igrdz(i)) then + call broadcast_scalar(var_grdz(i)%short_name,master_task) + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_grdz(i)%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + SELECT CASE (var_grdz(i)%short_name) + CASE ('NCAT') + status = nf90_put_var(ncid,varid,hin_max(1:ncat_hist)) + CASE ('NFSD') + status = nf90_put_var(ncid,varid,floe_rad_c(1:nfsd_hist)) + CASE ('VGRDi') ! index - needed for Met Office analysis code + status = nf90_put_var(ncid,varid,(/(k, k=1,nzilyr)/)) + CASE ('VGRDs') ! index - needed for Met Office analysis code + status = nf90_put_var(ncid,varid,(/(k, k=1,nzslyr)/)) + CASE ('VGRDb') + status = nf90_put_var(ncid,varid,(/(k, k=1,nzblyr)/)) + CASE ('VGRDa') + status = nf90_put_var(ncid,varid,(/(k, k=1,nzalyr)/)) + END SELECT + call ice_check_nc(status, subname// ' ERROR: put var '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + endif + enddo !----------------------------------------------------------------- ! write grid masks, area and rotation angle !----------------------------------------------------------------- do i = 1, nvar_grd - if (igrd(i)) then - call broadcast_scalar(var_grd(i)%req%short_name,master_task) - SELECT CASE (var_grd(i)%req%short_name) - CASE ('tmask') - call gather_global(work_g1, hm, master_task, distrb_info) - CASE ('umask') - call gather_global(work_g1, uvm, master_task, distrb_info) - CASE ('nmask') - call gather_global(work_g1, npm, master_task, distrb_info) - CASE ('emask') - call gather_global(work_g1, epm, master_task, distrb_info) - CASE ('tarea') - call gather_global(work_g1, tarea, master_task, distrb_info) - CASE ('uarea') - call gather_global(work_g1, uarea, master_task, distrb_info) - CASE ('narea') - call gather_global(work_g1, narea, master_task, distrb_info) - CASE ('earea') - call gather_global(work_g1, earea, master_task, distrb_info) - CASE ('blkmask') - call gather_global(work_g1, bm, master_task, distrb_info) - CASE ('dxu') - call gather_global(work_g1, dxU, master_task, distrb_info) - CASE ('dyu') - call gather_global(work_g1, dyU, master_task, distrb_info) - CASE ('dxt') - call gather_global(work_g1, dxT, master_task, distrb_info) - CASE ('dyt') - call gather_global(work_g1, dyT, master_task, distrb_info) - CASE ('dxn') - call gather_global(work_g1, dxN, master_task, distrb_info) - CASE ('dyn') - call gather_global(work_g1, dyN, master_task, distrb_info) - CASE ('dxe') - call gather_global(work_g1, dxE, master_task, distrb_info) - CASE ('dye') - call gather_global(work_g1, dyE, master_task, distrb_info) - CASE ('HTN') - call gather_global(work_g1, HTN, master_task, distrb_info) - CASE ('HTE') - call gather_global(work_g1, HTE, master_task, distrb_info) - CASE ('ANGLE') - call gather_global(work_g1, ANGLE, master_task, distrb_info) - CASE ('ANGLET') - call gather_global(work_g1, ANGLET,master_task, distrb_info) - END SELECT - - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_grd(i)%req%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_grd(i)%req%short_name) - status = nf90_put_var(ncid,varid,work_g1) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//var_grd(i)%req%short_name) - endif - endif + if (igrd(i)) then + call broadcast_scalar(var_grd(i)%req%short_name,master_task) + SELECT CASE (var_grd(i)%req%short_name) + CASE ('tmask') + call gather_global(work_g1, hm, master_task, distrb_info) + CASE ('umask') + call gather_global(work_g1, uvm, master_task, distrb_info) + CASE ('nmask') + call gather_global(work_g1, npm, master_task, distrb_info) + CASE ('emask') + call gather_global(work_g1, epm, master_task, distrb_info) + CASE ('tarea') + call gather_global(work_g1, tarea, master_task, distrb_info) + CASE ('uarea') + call gather_global(work_g1, uarea, master_task, distrb_info) + CASE ('narea') + call gather_global(work_g1, narea, master_task, distrb_info) + CASE ('earea') + call gather_global(work_g1, earea, master_task, distrb_info) + CASE ('blkmask') + call gather_global(work_g1, bm, master_task, distrb_info) + CASE ('dxu') + call gather_global(work_g1, dxU, master_task, distrb_info) + CASE ('dyu') + call gather_global(work_g1, dyU, master_task, distrb_info) + CASE ('dxt') + call gather_global(work_g1, dxT, master_task, distrb_info) + CASE ('dyt') + call gather_global(work_g1, dyT, master_task, distrb_info) + CASE ('dxn') + call gather_global(work_g1, dxN, master_task, distrb_info) + CASE ('dyn') + call gather_global(work_g1, dyN, master_task, distrb_info) + CASE ('dxe') + call gather_global(work_g1, dxE, master_task, distrb_info) + CASE ('dye') + call gather_global(work_g1, dyE, master_task, distrb_info) + CASE ('HTN') + call gather_global(work_g1, HTN, master_task, distrb_info) + CASE ('HTE') + call gather_global(work_g1, HTE, master_task, distrb_info) + CASE ('ANGLE') + call gather_global(work_g1, ANGLE, master_task, distrb_info) + CASE ('ANGLET') + call gather_global(work_g1, ANGLET,master_task, distrb_info) + END SELECT + + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_grd(i)%req%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1) + call ice_check_nc(status, subname// ' ERROR: writing variable '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + endif + endif enddo !---------------------------------------------------------------- @@ -939,78 +940,78 @@ subroutine ice_write_hist (ns) !---------------------------------------------------------------- if (f_bounds) then - if (my_task==master_task) then - allocate(work1_3(nverts,nx_global,ny_global)) - else - allocate(work1_3(1,1,1)) ! to save memory - endif + if (my_task==master_task) then + allocate(work1_3(nverts,nx_global,ny_global)) + else + allocate(work1_3(1,1,1)) ! to save memory + endif - work1_3(:,:,:) = c0 - work1 (:,:,:) = c0 - - do i = 1, nvar_verts - call broadcast_scalar(var_nverts(i)%short_name,master_task) - SELECT CASE (var_nverts(i)%short_name) - CASE ('lont_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lont_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('latt_bounds') - do ivertex = 1, nverts - work1(:,:,:) = latt_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('lonu_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lonu_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('latu_bounds') - do ivertex = 1, nverts - work1(:,:,:) = latu_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('lonn_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lonn_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('latn_bounds') - do ivertex = 1, nverts - work1(:,:,:) = latn_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('lone_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lone_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('late_bounds') - do ivertex = 1, nverts - work1(:,:,:) = late_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - END SELECT - - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_nverts(i)%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_nverts(i)%short_name) - status = nf90_put_var(ncid,varid,work1_3) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//var_nverts(i)%short_name) - endif - enddo - deallocate(work1_3) + work1_3(:,:,:) = c0 + work1 (:,:,:) = c0 + + do i = 1, nvar_verts + call broadcast_scalar(var_nverts(i)%short_name,master_task) + SELECT CASE (var_nverts(i)%short_name) + CASE ('lont_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lont_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('latt_bounds') + do ivertex = 1, nverts + work1(:,:,:) = latt_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('lonu_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lonu_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('latu_bounds') + do ivertex = 1, nverts + work1(:,:,:) = latu_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('lonn_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lonn_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('latn_bounds') + do ivertex = 1, nverts + work1(:,:,:) = latn_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('lone_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lone_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('late_bounds') + do ivertex = 1, nverts + work1(:,:,:) = late_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + END SELECT + + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_nverts(i)%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work1_3) + call ice_check_nc(status, subname// ' ERROR: writing variable '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + deallocate(work1_3) endif !----------------------------------------------------------------- @@ -1020,223 +1021,223 @@ subroutine ice_write_hist (ns) work_g1(:,:) = c0 do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call gather_global(work_g1, a2D(:,:,n,:), & - master_task, distrb_info) - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_g1, & - count=(/nx_global,ny_global/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - - endif + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call gather_global(work_g1, a2D(:,:,n,:), & + master_task, distrb_info) + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1, & + count=(/nx_global,ny_global/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + + endif enddo ! num_avail_hist_fields_2D work_g1(:,:) = c0 do n = n2D + 1, n3Dccum - nn = n - n2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, ncat_hist - call gather_global(work_g1, a3Dc(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, ncat_hist + call gather_global(work_g1, a3Dc(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Dc work_g1(:,:) = c0 do n = n3Dccum+1, n3Dzcum - nn = n - n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nzilyr - call gather_global(work_g1, a3Dz(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nzilyr + call gather_global(work_g1, a3Dz(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Dz work_g1(:,:) = c0 - do n = n3Dzcum+1, n3Dbcum - nn = n - n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nzblyr - call gather_global(work_g1, a3Db(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + do n = n3Dzcum+1, n3Dbcum + nn = n - n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nzblyr + call gather_global(work_g1, a3Db(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Db work_g1(:,:) = c0 do n = n3Dbcum+1, n3Dacum - nn = n - n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nzalyr - call gather_global(work_g1, a3Da(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nzalyr + call gather_global(work_g1, a3Da(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Da work_g1(:,:) = c0 do n = n3Dacum+1, n3Dfcum - nn = n - n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nfsd_hist - call gather_global(work_g1, a3Df(:,:,k,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nfsd_hist + call gather_global(work_g1, a3Df(:,:,k,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Df work_g1(:,:) = c0 do n = n3Dfcum+1, n4Dicum - nn = n - n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do ic = 1, ncat_hist - do k = 1, nzilyr - call gather_global(work_g1, a4Di(:,:,k,ic,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then + nn = n - n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do ic = 1, ncat_hist + do k = 1, nzilyr + call gather_global(work_g1, a4Di(:,:,k,ic,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - enddo ! ic - endif + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + enddo ! ic + endif enddo ! num_avail_hist_fields_4Di work_g1(:,:) = c0 do n = n4Dicum+1, n4Dscum - nn = n - n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do ic = 1, ncat_hist - do k = 1, nzslyr - call gather_global(work_g1, a4Ds(:,:,k,ic,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then + nn = n - n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do ic = 1, ncat_hist + do k = 1, nzslyr + call gather_global(work_g1, a4Ds(:,:,k,ic,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - enddo ! ic - endif + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + enddo ! ic + endif enddo ! num_avail_hist_fields_4Ds do n = n4Dscum+1, n4Dfcum - nn = n - n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do ic = 1, ncat_hist - do k = 1, nfsd_hist - call gather_global(work_g1, a4Df(:,:,k,ic,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then + nn = n - n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do ic = 1, ncat_hist + do k = 1, nfsd_hist + call gather_global(work_g1, a4Df(:,:,k,ic,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - enddo ! ic - endif + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + enddo ! ic + endif enddo ! num_avail_hist_fields_4Df deallocate(work_g1) @@ -1247,15 +1248,14 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then status = nf90_close(ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: closing netCDF history file') + call ice_check_nc(status, subname// ' ERROR: closing netCDF history file', & + file=__FILE__, line=__LINE__) write(nu_diag,*) ' ' write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist @@ -1284,25 +1284,25 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) #ifdef USE_NETCDF status = nf90_put_att(ncid,varid,'units', hfield%vunit) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining units for '//hfield%vname, & + file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,varid, 'long_name', hfield%vdesc) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//hfield%vname, & + file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,varid,'coordinates', hfield%vcoord) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining coordinates for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining coordinates for '//hfield%vname, & + file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,varid,'cell_measures', hfield%vcellmeas) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining cell measures for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining cell measures for '//hfield%vname, & + file=__FILE__, line=__LINE__) - if (hfield%vcomment /= "none") then - status = nf90_put_att(ncid,varid,'comment', hfield%vcomment) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining comment for '//hfield%vname) + if (hfield%vcomment /= "none") then + status = nf90_put_att(ncid,varid,'comment', hfield%vcomment) + call ice_check_nc(status, subname// ' ERROR: defining comment for '//hfield%vname, & + file=__FILE__, line=__LINE__) endif call ice_write_hist_fill(ncid,varid,hfield%vname,history_precision) @@ -1314,9 +1314,9 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) .and.TRIM(hfield%vname(1:9))/='sistreave' & .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then - status = nf90_put_att(ncid,varid,'cell_methods','time: mean') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining cell methods for '//hfield%vname) + status = nf90_put_att(ncid,varid,'cell_methods','time: mean') + call ice_check_nc(status, subname// ' ERROR: defining cell methods for '//hfield%vname, & + file=__FILE__, line=__LINE__) endif endif @@ -1340,12 +1340,11 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) else status = nf90_put_att(ncid,varid,'time_rep','averaged') endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining time rep for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining time rep for '//hfield%vname, & + file=__FILE__, line=__LINE__) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist_attrs @@ -1375,19 +1374,18 @@ subroutine ice_write_hist_fill(ncid,varid,vname,precision) else status = nf90_put_att(ncid,varid,'missing_value',spval) endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//trim(vname)) + call ice_check_nc(status, subname// ' ERROR: defining missing_value for '//trim(vname), & + file=__FILE__, line=__LINE__) if (precision == 8) then status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) else status = nf90_put_att(ncid,varid,'_FillValue',spval) endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//trim(vname)) + call ice_check_nc(status, subname// ' ERROR: defining _FillValue for '//trim(vname), & + file=__FILE__, line=__LINE__) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR : USE_NETCDF cpp not defined', file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist_fill diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 84fcbe5b7..994ef9665 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -15,6 +15,7 @@ module ice_restart #ifdef USE_NETCDF use netcdf #endif + use ice_read_write, only: ice_check_nc use ice_restart_shared, only: & restart_ext, restart_dir, restart_file, pointer_file, & runid, use_restart_time, lcdf64, lenstr, restart_coszen @@ -76,8 +77,7 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) status = nf90_open(trim(filename), nf90_nowrite, ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: reading restart ncfile '//trim(filename)) + call ice_check_nc(status, subname//' ERROR: open '//trim(filename), file=__FILE__, line=__LINE__) if (use_restart_time) then status1 = nf90_noerr @@ -97,18 +97,16 @@ subroutine init_restart_read(ice_ic) if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'sec', msec) if (status /= nf90_noerr) status1 = status if (status1 /= nf90_noerr) call abort_ice(subname// & - 'ERROR: reading restart time '//trim(filename)) + 'ERROR: reading restart time '//trim(filename), file=__FILE__, line=__LINE__) endif ! use namelist values if use_restart_time = F endif call broadcast_scalar(istep0,master_task) -! call broadcast_scalar(time,master_task) call broadcast_scalar(myear,master_task) call broadcast_scalar(mmonth,master_task) call broadcast_scalar(mday,master_task) call broadcast_scalar(msec,master_task) -! call broadcast_scalar(time_forc,master_task) istep1 = istep0 @@ -214,16 +212,18 @@ subroutine init_restart_write(filename_spec) iflag = 0 if (lcdf64) iflag = nf90_64bit_offset status = nf90_create(trim(filename), iflag, ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: creating restart ncfile '//trim(filename)) + call ice_check_nc(status, subname//' ERROR: creating '//trim(filename), file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'istep1',istep1) -! status = nf90_put_att(ncid,nf90_global,'time',time) -! status = nf90_put_att(ncid,nf90_global,'time_forc',time_forc) + call ice_check_nc(status, subname//' ERROR: writing att istep', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'myear',myear) + call ice_check_nc(status, subname//' ERROR: writing att year', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'mmonth',mmonth) + call ice_check_nc(status, subname//' ERROR: writing att month', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'mday',mday) + call ice_check_nc(status, subname//' ERROR: writing att day', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'msec',msec) + call ice_check_nc(status, subname//' ERROR: writing att sec', file=__FILE__, line=__LINE__) nx = nx_global ny = ny_global @@ -232,13 +232,16 @@ subroutine init_restart_write(filename_spec) ny = ny_global + 2*nghost endif status = nf90_def_dim(ncid,'ni',nx,dimid_ni) + call ice_check_nc(status, subname//' ERROR: writing dim ni', file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nj',ny,dimid_nj) + call ice_check_nc(status, subname//' ERROR: writing dim nj', file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'ncat',ncat,dimid_ncat) + call ice_check_nc(status, subname//' ERROR: writing dim ncat', file=__FILE__, line=__LINE__) - !----------------------------------------------------------------- - ! 2D restart fields - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 2D restart fields + !----------------------------------------------------------------- allocate(dims(2)) @@ -378,9 +381,9 @@ subroutine init_restart_write(filename_spec) deallocate(dims) - !----------------------------------------------------------------- - ! 3D restart fields (ncat) - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 3D restart fields (ncat) + !----------------------------------------------------------------- allocate(dims(3)) @@ -482,9 +485,9 @@ subroutine init_restart_write(filename_spec) endif endif !skl_bgc - !----------------------------------------------------------------- - ! 4D restart fields, written as layers of 3D - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 4D restart fields, written as layers of 3D + !----------------------------------------------------------------- do k=1,nilyr write(nchar,'(i3.3)') k @@ -534,117 +537,117 @@ subroutine init_restart_write(filename_spec) if (z_tracers) then if (tr_zaero) then - do n = 1, n_zaero - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'zaero'//trim(ncharb)//trim(nchar),dims) - enddo !k - enddo !n + do n = 1, n_zaero + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'zaero'//trim(ncharb)//trim(nchar),dims) + enddo !k + enddo !n endif !tr_zaero if (tr_bgc_Nit) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Nit'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Nit'//trim(nchar),dims) + enddo endif if (tr_bgc_N) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_N'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_N'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_C) then - ! do n = 1, n_algae - ! write(ncharb,'(i3.3)') n - ! do k = 1, nblyr+3 - ! write(nchar,'(i3.3)') k - ! call define_rest_field(ncid,'bgc_C'//trim(ncharb)//trim(nchar),dims) - ! enddo - ! enddo - do n = 1, n_doc - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_dic - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + ! do n = 1, n_algae + ! write(ncharb,'(i3.3)') n + ! do k = 1, nblyr+3 + ! write(nchar,'(i3.3)') k + ! call define_rest_field(ncid,'bgc_C'//trim(ncharb)//trim(nchar),dims) + ! enddo + ! enddo + do n = 1, n_doc + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_dic + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_chl) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_chl'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_chl'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_Am) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Am'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Am'//trim(nchar),dims) + enddo endif if (tr_bgc_Sil) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Sil'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Sil'//trim(nchar),dims) + enddo endif if (tr_bgc_hum) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_hum'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_hum'//trim(nchar),dims) + enddo endif if (tr_bgc_DMS) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DMSPp'//trim(nchar),dims) - call define_rest_field(ncid,'bgc_DMSPd'//trim(nchar),dims) - call define_rest_field(ncid,'bgc_DMS'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DMSPp'//trim(nchar),dims) + call define_rest_field(ncid,'bgc_DMSPd'//trim(nchar),dims) + call define_rest_field(ncid,'bgc_DMS'//trim(nchar),dims) + enddo endif if (tr_bgc_PON) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_PON'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_PON'//trim(nchar),dims) + enddo endif if (tr_bgc_DON) then - do n = 1, n_don - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DON'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_don + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DON'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_Fe ) then - do n = 1, n_fed - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_fep - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_fed + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_fep + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif do k = 1, nbtrcr write(nchar,'(i3.3)') k @@ -654,6 +657,7 @@ subroutine init_restart_write(filename_spec) deallocate(dims) status = nf90_enddef(ncid) + call ice_check_nc(status, subname//' ERROR: enddef', file=__FILE__, line=__LINE__) write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif ! master_task @@ -678,71 +682,71 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & use ice_read_write, only: ice_read_nc integer (kind=int_kind), intent(in) :: & - nu , & ! unit number (not used for netcdf) - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number (not used for netcdf) + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(inout) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - work2 ! input array (real, 8-byte) + work2 ! input array (real, 8-byte) character(len=*), parameter :: subname = '(read_restart_field)' #ifdef USE_NETCDF - if (present(field_loc)) then - if (ndim3 == ncat) then - if (restart_ext) then - call ice_read_nc(ncid,1,vname,work,diag, & - field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) - else - call ice_read_nc(ncid,1,vname,work,diag,field_loc,field_type) - endif - elseif (ndim3 == 1) then - if (restart_ext) then - call ice_read_nc(ncid,1,vname,work2,diag, & - field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) - else - call ice_read_nc(ncid,1,vname,work2,diag,field_loc,field_type) - endif - work(:,:,1,:) = work2(:,:,:) + if (present(field_loc)) then + if (ndim3 == ncat) then + if (restart_ext) then + call ice_read_nc(ncid,1,vname,work,diag, & + field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) else - write(nu_diag,*) 'ndim3 not supported ',ndim3 + call ice_read_nc(ncid,1,vname,work,diag,field_loc,field_type) endif + elseif (ndim3 == 1) then + if (restart_ext) then + call ice_read_nc(ncid,1,vname,work2,diag, & + field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) + else + call ice_read_nc(ncid,1,vname,work2,diag,field_loc,field_type) + endif + work(:,:,1,:) = work2(:,:,:) else - if (ndim3 == ncat) then - if (restart_ext) then - call ice_read_nc(ncid, 1, vname, work, diag, restart_ext=restart_ext) - else - call ice_read_nc(ncid, 1, vname, work, diag) - endif - elseif (ndim3 == 1) then - if (restart_ext) then - call ice_read_nc(ncid, 1, vname, work2, diag, restart_ext=restart_ext) - else - call ice_read_nc(ncid, 1, vname, work2, diag) - endif - work(:,:,1,:) = work2(:,:,:) + write(nu_diag,*) 'ndim3 not supported ',ndim3 + endif + else + if (ndim3 == ncat) then + if (restart_ext) then + call ice_read_nc(ncid, 1, vname, work, diag, restart_ext=restart_ext) + else + call ice_read_nc(ncid, 1, vname, work, diag) + endif + elseif (ndim3 == 1) then + if (restart_ext) then + call ice_read_nc(ncid, 1, vname, work2, diag, restart_ext=restart_ext) else - write(nu_diag,*) 'ndim3 not supported ',ndim3 + call ice_read_nc(ncid, 1, vname, work2, diag) endif + work(:,:,1,:) = work2(:,:,:) + else + write(nu_diag,*) 'ndim3 not supported ',ndim3 endif + endif #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & @@ -763,51 +767,56 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) use ice_read_write, only: ice_write_nc integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname ! local variables integer (kind=int_kind) :: & - varid, & ! variable id - status ! status variable from netCDF routine + varid , & ! variable id + status ! status variable from netCDF routine real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - work2 ! input array (real, 8-byte) + work2 ! input array (real, 8-byte) character(len=*), parameter :: subname = '(write_restart_field)' #ifdef USE_NETCDF + varid = -99 + if (my_task == master_task) then + ! ncid is only valid on master status = nf90_inq_varid(ncid,trim(vname),varid) - if (ndim3 == ncat) then - if (restart_ext) then - call ice_write_nc(ncid, 1, varid, work, diag, restart_ext, varname=trim(vname)) - else - call ice_write_nc(ncid, 1, varid, work, diag, varname=trim(vname)) - endif - elseif (ndim3 == 1) then - work2(:,:,:) = work(:,:,1,:) - if (restart_ext) then - call ice_write_nc(ncid, 1, varid, work2, diag, restart_ext, varname=trim(vname)) - else - call ice_write_nc(ncid, 1, varid, work2, diag, varname=trim(vname)) - endif + call ice_check_nc(status, subname//' ERROR: inq varid '//trim(vname), file=__FILE__, line=__LINE__) + endif + if (ndim3 == ncat) then + if (restart_ext) then + call ice_write_nc(ncid, 1, varid, work, diag, restart_ext, varname=trim(vname)) + else + call ice_write_nc(ncid, 1, varid, work, diag, varname=trim(vname)) + endif + elseif (ndim3 == 1) then + work2(:,:,:) = work(:,:,1,:) + if (restart_ext) then + call ice_write_nc(ncid, 1, varid, work2, diag, restart_ext, varname=trim(vname)) else - write(nu_diag,*) 'ndim3 not supported',ndim3 + call ice_write_nc(ncid, 1, varid, work2, diag, varname=trim(vname)) endif + else + write(nu_diag,*) 'ndim3 not supported',ndim3 + endif #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & @@ -830,11 +839,12 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' #ifdef USE_NETCDF - status = nf90_close(ncid) - - if (my_task == master_task) & + if (my_task == master_task) then + ! ncid is only valid on master + status = nf90_close(ncid) + call ice_check_nc(status, subname//' ERROR: closing', file=__FILE__, line=__LINE__) write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec - + endif #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) @@ -856,12 +866,13 @@ subroutine define_rest_field(ncid, vname, dims) integer (kind=int_kind) :: varid integer (kind=int_kind) :: & - status ! status variable from netCDF routine + status ! status variable from netCDF routine character(len=*), parameter :: subname = '(define_rest_field)' #ifdef USE_NETCDF status = nf90_def_var(ncid,trim(vname),nf90_double,dims,varid) + call ice_check_nc(status, subname//' ERROR: def var '//trim(vname), file=__FILE__, line=__LINE__) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index cb04ae37d..5c06f2a88 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -195,103 +195,102 @@ subroutine ice_write_hist (ns) if (hist_avg(ns) .and. .not. write_ic) then call ice_pio_check(pio_def_dim(File,'nbnd',2,boundid), & - subname//' ERROR: defining dim nbnd with len 2') - endif + subname//' ERROR: defining dim nbnd with len 2',file=__FILE__,line=__LINE__) + endif + + call ice_pio_check(pio_def_dim(File,'ni',nx_global,imtid), & + subname//' ERROR: defining dim ni',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'ni',nx_global,imtid), & - subname//' ERROR: defining dim ni') + call ice_pio_check(pio_def_dim(File,'nj',ny_global,jmtid), & + subname//' ERROR: defining dim nj',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nj',ny_global,jmtid), & - subname//' ERROR: defining dim nj') + call ice_pio_check(pio_def_dim(File,'nc',ncat_hist,cmtid), & + subname//' ERROR: defining dim nc',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nc',ncat_hist,cmtid), & - subname//' ERROR: defining dim nc') + call ice_pio_check(pio_def_dim(File,'nkice',nzilyr,kmtidi), & + subname//' ERROR: defining dim nkice',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nkice',nzilyr,kmtidi), & - subname//' ERROR: defining dim nkice') + call ice_pio_check(pio_def_dim(File,'nksnow',nzslyr,kmtids), & + subname//' ERROR: defining dim nksnow',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nksnow',nzslyr,kmtids), & - subname//' ERROR: defining dim nksnow') + call ice_pio_check(pio_def_dim(File,'nkbio',nzblyr,kmtidb), & + subname//' ERROR: defining dim nkbio',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nkbio',nzblyr,kmtidb), & - subname//' ERROR: defining dim nkbio') + call ice_pio_check(pio_def_dim(File,'nkaer',nzalyr,kmtida), & + subname//' ERROR: defining dim nkaer',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nkaer',nzalyr,kmtida), & - subname//' ERROR: defining dim nkaer') + call ice_pio_check(pio_def_dim(File,'time',PIO_UNLIMITED,timid), & + subname//' ERROR: defining dim time',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'time',PIO_UNLIMITED,timid), & - subname//' ERROR: defining dim time') - - call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & - subname//' ERROR: defining dim nverticies') + call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & + subname//' ERROR: defining dim nverticies',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & - subname//' ERROR: defining dim nf') + call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & + subname//' ERROR: defining dim nf',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- - call ice_pio_check(pio_def_var(File,'time',pio_double,(/timid/),varid), & - subname//' ERROR: defining var time') - call ice_pio_check(pio_put_att(File,varid,'long_name','time'), & - subname//' ERROR: defining attribute "long_name" as "time"') - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & - subname//' ERROR: defining attribute "units" as '//trim(title)) - - if (days_per_year == 360) then - call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//' ERROR: defining calendar') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//' ERROR: defining calendar') - elseif (use_leap_years) then - call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//' ERROR: defining calendar') - else - call abort_ice(subname//' ERROR: invalid calendar settings') - endif + call ice_pio_check(pio_def_var(File,'time',pio_double,(/timid/),varid), & + subname//' ERROR: defining var time',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid,'long_name','time'), & + subname//' ERROR: defining att long_name time',file=__FILE__,line=__LINE__) + + write(cdate,'(i8.8)') idate0 + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init + call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & + subname//' ERROR: defining att units '//trim(title),file=__FILE__,line=__LINE__) + + if (days_per_year == 360) then + call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & + subname//' ERROR: defining att calendar1',file=__FILE__,line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & + subname//' ERROR: defining att calendar2',file=__FILE__,line=__LINE__) + elseif (use_leap_years) then + call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & + subname//' ERROR: defining att calendar3',file=__FILE__,line=__LINE__) + else + call abort_ice(subname//' ERROR: invalid calendar settings') + endif - if (hist_avg(ns) .and. .not. write_ic) then - call ice_pio_check(pio_put_att(File,varid,'bounds','time_bounds'), & - subname//' ERROR: defining attribute "bounds" as "time_bounds"') - endif + if (hist_avg(ns) .and. .not. write_ic) then + call ice_pio_check(pio_put_att(File,varid,'bounds','time_bounds'), & + subname//' ERROR: defining att bounds time_bounds',file=__FILE__,line=__LINE__) + endif - ! Define attributes for time_bounds if hist_avg is true - if (hist_avg(ns) .and. .not. write_ic) then - dimid2(1) = boundid - dimid2(2) = timid - call ice_pio_check(pio_def_var(File,'time_bounds',pio_double,dimid2,varid), & - subname//' ERROR: defining var time_bounds') - call ice_pio_check(pio_put_att(File,varid,'long_name', 'time interval endpoints'), & - subname//' ERROR: defining attribute "long_name" as "time interval endpoints"') - - if (days_per_year == 360) then - call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//' ERROR: defining calendar for time_bounds') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//' ERROR: defining calendar for time_bounds') - elseif (use_leap_years) then - call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//' ERROR: defining calendar for time_bounds') - else - call abort_ice(subname//' ERROR: invalid calendar settings') - endif - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & - subname//' ERROR: defining attribute "units" as '//trim(title)) - - endif + ! Define attributes for time_bounds if hist_avg is true + if (hist_avg(ns) .and. .not. write_ic) then + dimid2(1) = boundid + dimid2(2) = timid + call ice_pio_check(pio_def_var(File,'time_bounds',pio_double,dimid2,varid), & + subname//' ERROR: defining var time_bounds',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid,'long_name', 'time interval endpoints'), & + subname//' ERROR: defining att long_name time interval endpoints',file=__FILE__,line=__LINE__) + + if (days_per_year == 360) then + call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & + subname//' ERROR: defining att calendar1 tb',file=__FILE__,line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & + subname//' ERROR: defining att calendar2 tb',file=__FILE__,line=__LINE__) + elseif (use_leap_years) then + call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & + subname//' ERROR: defining att calendar3 tb',file=__FILE__,line=__LINE__) + else + call abort_ice(subname//' ERROR: invalid calendar settings') + endif + + write(cdate,'(i8.8)') idate0 + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init + call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & + subname//' ERROR: defining att units '//trim(title),file=__FILE__,line=__LINE__) + endif !----------------------------------------------------------------- ! define information for required time-invariant variables @@ -435,80 +434,76 @@ subroutine ice_write_hist (ns) ! define attributes for time-invariant variables !----------------------------------------------------------------- - dimid2(1) = imtid - dimid2(2) = jmtid - - do i = 1, ncoord - call ice_pio_check(pio_def_var(File, trim(var_coord(i)%short_name), lprecision, & - dimid2, varid), & - subname//' ERROR: defining var'//trim(var_coord(i)%short_name)) - call ice_pio_check(pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)), & - subname//' ERROR: defining attribute "long_name" as '//trim(var_coord(i)%long_name)) - call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_coord(i)%units)), & - subname//' ERROR: defining attribute "units" as '//trim(var_coord(i)%units)) - call ice_write_hist_fill(File,varid,var_coord(i)%short_name,history_precision) - if (var_coord(i)%short_name == 'ULAT') then - call ice_pio_check(pio_put_att(File,varid,'comment', & - trim('Latitude of NE corner of T grid cell')), & - subname//' ERROR: defining attribute "comment"') - endif - if (f_bounds) then - call ice_pio_check(pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))), & - subname//' ERROR: defining attribute "bounds" as '//trim(coord_bounds(i))) - endif - enddo - - ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) - dimidex(1)=cmtid - dimidex(2)=kmtidi - dimidex(3)=kmtids - dimidex(4)=kmtidb - dimidex(5)=kmtida - dimidex(6)=fmtid - - do i = 1, nvar_grdz - if (igrdz(i)) then - call ice_pio_check(pio_def_var(File, trim(var_grdz(i)%short_name), lprecision, & - (/dimidex(i)/), varid), & - subname//' ERROR: defining var'//trim(var_grdz(i)%short_name)) - call ice_pio_check(pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name), & - subname//' ERROR: defining attribute "long_name" as '//trim(var_grdz(i)%long_name)) - call ice_pio_check(pio_put_att(File, varid, 'units' , var_grdz(i)%units), & - subname//' ERROR: defining attribute "units" as '//trim(var_grdz(i)%units)) - endif - enddo - - do i = 1, nvar_grd - if (igrd(i)) then - call ice_pio_check(pio_def_var(File, trim(var_grd(i)%req%short_name), & - lprecision, dimid2, varid), & - subname//' ERROR: defining var'//trim(var_grd(i)%req%short_name)) - call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)), & - subname//' ERROR: defining attribute "long_name" as '//trim(var_grd(i)%req%long_name)) - call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)), & - subname//' ERROR: defining attribute "units" as '//trim(var_grd(i)%req%units)) - call ice_pio_check(pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)), & - subname//' ERROR: defining attribute "coordinates" as '//trim(var_grd(i)%coordinates)) - call ice_write_hist_fill(File,varid,var_grd(i)%req%short_name,history_precision) - endif - enddo - - ! Fields with dimensions (nverts,nx,ny) - dimid_nverts(1) = nvertexid - dimid_nverts(2) = imtid - dimid_nverts(3) = jmtid - do i = 1, nvar_verts - if (f_bounds) then - call ice_pio_check(pio_def_var(File, trim(var_nverts(i)%short_name), & - lprecision,dimid_nverts, varid), & - subname//' ERROR: defining var'//trim(var_nverts(i)%short_name)) - call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)), & - subname//' ERROR: defining attribute "long_name" as '//trim(var_nverts(i)%long_name)) - call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)), & - subname//' ERROR: defining attribute "units" as '//trim(var_nverts(i)%units)) - call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) - endif - enddo + dimid2(1) = imtid + dimid2(2) = jmtid + + do i = 1, ncoord + call ice_pio_check(pio_def_var(File, trim(var_coord(i)%short_name), lprecision,dimid2, varid), & + subname//' ERROR: defining var '//trim(var_coord(i)%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)), & + subname//' ERROR: defining att long_name '//trim(var_coord(i)%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_coord(i)%units)), & + subname//' ERROR: defining att units '//trim(var_coord(i)%units),file=__FILE__,line=__LINE__) + call ice_write_hist_fill(File,varid,var_coord(i)%short_name,history_precision) + if (var_coord(i)%short_name == 'ULAT') then + call ice_pio_check(pio_put_att(File,varid,'comment', & + trim('Latitude of NE corner of T grid cell')), & + subname//' ERROR: defining att comment',file=__FILE__,line=__LINE__) + endif + if (f_bounds) then + call ice_pio_check(pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))), & + subname//' ERROR: defining att bounds '//trim(coord_bounds(i)),file=__FILE__,line=__LINE__) + endif + enddo + + ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) + dimidex(1)=cmtid + dimidex(2)=kmtidi + dimidex(3)=kmtids + dimidex(4)=kmtidb + dimidex(5)=kmtida + dimidex(6)=fmtid + + do i = 1, nvar_grdz + if (igrdz(i)) then + call ice_pio_check(pio_def_var(File, trim(var_grdz(i)%short_name), lprecision,(/dimidex(i)/), varid), & + subname//' ERROR: defining var'//trim(var_grdz(i)%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name), & + subname//' ERROR: defining att long_name '//trim(var_grdz(i)%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units' , var_grdz(i)%units), & + subname//' ERROR: defining att units '//trim(var_grdz(i)%units),file=__FILE__,line=__LINE__) + endif + enddo + + do i = 1, nvar_grd + if (igrd(i)) then + call ice_pio_check(pio_def_var(File, trim(var_grd(i)%req%short_name), lprecision, dimid2, varid), & + subname//' ERROR: defining var'//trim(var_grd(i)%req%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)), & + subname//' ERROR: defining att long_name '//trim(var_grd(i)%req%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)), & + subname//' ERROR: defining att units '//trim(var_grd(i)%req%units),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)), & + subname//' ERROR: defining att coordinates '//trim(var_grd(i)%coordinates),file=__FILE__,line=__LINE__) + call ice_write_hist_fill(File,varid,var_grd(i)%req%short_name,history_precision) + endif + enddo + + ! Fields with dimensions (nverts,nx,ny) + dimid_nverts(1) = nvertexid + dimid_nverts(2) = imtid + dimid_nverts(3) = jmtid + do i = 1, nvar_verts + if (f_bounds) then + call ice_pio_check(pio_def_var(File, trim(var_nverts(i)%short_name),lprecision,dimid_nverts, varid), & + subname//' ERROR: defining var'//trim(var_nverts(i)%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)), & + subname//' ERROR: defining att long_name '//trim(var_nverts(i)%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)), & + subname//' ERROR: defining att units '//trim(var_nverts(i)%units),file=__FILE__,line=__LINE__) + call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) + endif + enddo !----------------------------------------------------------------- ! define attributes for time-variant variables @@ -518,108 +513,102 @@ subroutine ice_write_hist (ns) ! 2D !----------------------------------------------------------------- - dimid3(1) = imtid - dimid3(2) = jmtid - dimid3(3) = timid + dimid3(1) = imtid + dimid3(2) = jmtid + dimid3(3) = timid - do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimid3, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + do n=1,num_avail_hist_fields_2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimid3, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_2D + endif + enddo ! num_avail_hist_fields_2D !----------------------------------------------------------------- ! 3D (category) !----------------------------------------------------------------- - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = cmtid - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = cmtid + dimidz(4) = timid - do n = n2D + 1, n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + do n = n2D + 1, n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dc + endif + enddo ! num_avail_hist_fields_3Dc !----------------------------------------------------------------- ! 3D (ice layers) !----------------------------------------------------------------- - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidi - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidi + dimidz(4) = timid - do n = n3Dccum + 1, n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + do n = n3Dccum + 1, n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dz + endif + enddo ! num_avail_hist_fields_3Dz !----------------------------------------------------------------- ! 3D (biology ice layers) !----------------------------------------------------------------- - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidb - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidb + dimidz(4) = timid - do n = n3Dzcum + 1, n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + do n = n3Dzcum + 1, n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Db + endif + enddo ! num_avail_hist_fields_3Db !----------------------------------------------------------------- ! 3D (biology snow layers) !----------------------------------------------------------------- - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtida - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtida + dimidz(4) = timid - do n = n3Dbcum + 1, n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + do n = n3Dbcum + 1, n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Da + endif + enddo ! num_avail_hist_fields_3Da !----------------------------------------------------------------- ! 3D (fsd) !----------------------------------------------------------------- - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = fmtid - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = fmtid + dimidz(4) = timid - do n = n3Dacum + 1, n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + do n = n3Dacum + 1, n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Df + endif + enddo ! num_avail_hist_fields_3Df !----------------------------------------------------------------- ! define attributes for 4D variables @@ -630,59 +619,55 @@ subroutine ice_write_hist (ns) ! 4D (ice categories) !----------------------------------------------------------------- - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtidi - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n3Dfcum + 1, n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtidi + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n3Dfcum + 1, n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Di + endif + enddo ! num_avail_hist_fields_4Di !----------------------------------------------------------------- ! 4D (snow layers) !----------------------------------------------------------------- - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtids - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dicum + 1, n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Ds + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtids + dimidcz(4) = cmtid + dimidcz(5) = timid + do n = n4Dicum + 1, n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) + call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_4Ds !----------------------------------------------------------------- ! 4D (fsd layers) !----------------------------------------------------------------- - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = fmtid - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dscum + 1, n4Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname)) + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = fmtid + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n4Dscum + 1, n4Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Df + endif + enddo ! num_avail_hist_fields_4Df !----------------------------------------------------------------- ! global attributes @@ -690,38 +675,38 @@ subroutine ice_write_hist (ns) ! ... the user should change these to something useful ... !----------------------------------------------------------------- #ifdef CESMCOUPLED - call ice_pio_check(pio_put_att(File,pio_global,'title',runid), & - subname//' ERROR: defining attribute "title" as '//runid) + call ice_pio_check(pio_put_att(File,pio_global,'title',runid), & + subname//' ERROR: defining att title '//runid,file=__FILE__,line=__LINE__) #else - title = 'sea ice model output for CICE' - call ice_pio_check(pio_put_att(File,pio_global,'title',trim(title)), & - subname//' ERROR: defining attribute "title" as '//trim(title)) + title = 'sea ice model output for CICE' + call ice_pio_check(pio_put_att(File,pio_global,'title',trim(title)), & + subname//' ERROR: defining att title '//trim(title),file=__FILE__,line=__LINE__) #endif - title = 'Diagnostic and Prognostic Variables' - call ice_pio_check(pio_put_att(File,pio_global,'contents',trim(title)), & - subname//' ERROR: defining attribute "contents" as '//trim(title)) + title = 'Diagnostic and Prognostic Variables' + call ice_pio_check(pio_put_att(File,pio_global,'contents',trim(title)), & + subname//' ERROR: defining att contents '//trim(title),file=__FILE__,line=__LINE__) - write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) - call ice_pio_check(pio_put_att(File,pio_global,'source',trim(title)), & - subname//' ERROR: defining attribute "source" as '//trim(title)) + write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) + call ice_pio_check(pio_put_att(File,pio_global,'source',trim(title)), & + subname//' ERROR: defining att source '//trim(title),file=__FILE__,line=__LINE__) - if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',dayyr,' days' - else - write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' - endif - call ice_pio_check(pio_put_att(File,pio_global,'comment',trim(title)), & - subname//' ERROR: defining attribute "comment" as '//trim(title)) + if (use_leap_years) then + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' + else + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' + endif + call ice_pio_check(pio_put_att(File,pio_global,'comment',trim(title)), & + subname//' ERROR: defining att comment '//trim(title),file=__FILE__,line=__LINE__) - write(title,'(a,i8.8)') 'File written on model date ',idate - call ice_pio_check(pio_put_att(File,pio_global,'comment2',trim(title)), & - subname//' ERROR: defining attribute '//trim(title)) + write(title,'(a,i8.8)') 'File written on model date ',idate + call ice_pio_check(pio_put_att(File,pio_global,'comment2',trim(title)), & + subname//' ERROR: defining att comment2 '//trim(title),file=__FILE__,line=__LINE__) - write(title,'(a,i6)') 'seconds elapsed into model date: ',msec - call ice_pio_check(pio_put_att(File,pio_global,'comment3',trim(title)), & - subname//' ERROR: defining attribute '//trim(title)) + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec + call ice_pio_check(pio_put_att(File,pio_global,'comment3',trim(title)), & + subname//' ERROR: defining att comment3 '//trim(title),file=__FILE__,line=__LINE__) - select case (histfreq(ns)) + select case (histfreq(ns)) case ("y", "Y") write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) case ("m", "M") @@ -732,89 +717,88 @@ subroutine ice_write_hist (ns) write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) case ("1") write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) - end select + end select - if (.not.write_ic .and. trim(time_period_freq) /= 'none') then - call ice_pio_check(pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)), & - subname//' ERROR: defining attribute "time_period_freq" as '//trim(time_period_freq)) - endif + if (.not.write_ic .and. trim(time_period_freq) /= 'none') then + call ice_pio_check(pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)), & + subname//' ERROR: defining att time_period_freq '//trim(time_period_freq),file=__FILE__,line=__LINE__) + endif - if (hist_avg(ns)) & - call ice_pio_check(pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)), & - subname//' ERROR: defining attribute "time_axis_position" as '//trim(hist_time_axis)) - - title = 'CF-1.0' - call ice_pio_check(pio_put_att(File,pio_global,'conventions',trim(title)), & - subname//' ERROR: defining attribute "conventions" as '//trim(title)) - - call date_and_time(date=current_date, time=current_time) - write(start_time,1000) current_date(1:4), current_date(5:6), & - current_date(7:8), current_time(1:2), & - current_time(3:4) -1000 format('This dataset was created on ', & - a,'-',a,'-',a,' at ',a,':',a) - call ice_pio_check(pio_put_att(File,pio_global,'history',trim(start_time)), & - subname//' ERROR: defining attribute "history" as '//trim(start_time)) - - if (history_format == 'pio_pnetcdf') then - call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf'), & - subname//' ERROR: defining attribute "io_flavor"' ) - else - call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio netcdf'), & - subname//' ERROR: defining attribute "io_flavor"' ) - endif + if (hist_avg(ns)) & + call ice_pio_check(pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)), & + subname//' ERROR: defining att time_axis_position '//trim(hist_time_axis),file=__FILE__,line=__LINE__) + + title = 'CF-1.0' + call ice_pio_check(pio_put_att(File,pio_global,'conventions',trim(title)), & + subname//' ERROR: defining att conventions '//trim(title),file=__FILE__,line=__LINE__) + + call date_and_time(date=current_date, time=current_time) + write(start_time,1000) current_date(1:4), current_date(5:6), & + current_date(7:8), current_time(1:2), & + current_time(3:4) +1000 format('This dataset was created on ', & + a,'-',a,'-',a,' at ',a,':',a) + call ice_pio_check(pio_put_att(File,pio_global,'history',trim(start_time)), & + subname//' ERROR: defining att history '//trim(start_time),file=__FILE__,line=__LINE__) + + if (history_format == 'pio_pnetcdf') then + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf'), & + subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) + else + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio netcdf'), & + subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) + endif !----------------------------------------------------------------- ! end define mode !----------------------------------------------------------------- - call ice_pio_check(pio_enddef(File), & - subname//' ERROR: ending pio definitions') + call ice_pio_check(pio_enddef(File), & + subname//' ERROR: ending pio definitions',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! write time variable !----------------------------------------------------------------- - ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) + ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) - ! Some coupled models require the time axis "stamp" to be in the middle - ! or even beginning of averaging interval. - if (hist_avg(ns)) then - if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) - if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) - endif + ! Some coupled models require the time axis "stamp" to be in the middle + ! or even beginning of averaging interval. + if (hist_avg(ns)) then + if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) + if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) + endif - call ice_pio_check(pio_inq_varid(File,'time',varid), & - subname//' ERROR: getting var "time"') - call ice_pio_check(pio_put_var(File,varid,(/1/),ltime2), & - subname//' ERROR: setting var "time"') + call ice_pio_check(pio_inq_varid(File,'time',varid), & + subname//' ERROR: getting var time',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_var(File,varid,(/1/),ltime2), & + subname//' ERROR: setting var time',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg(ns) .and. .not. write_ic) then - call ice_pio_check(pio_inq_varid(File,'time_bounds',varid), & - subname//' ERROR: getting "time_bounds"' ) - time_bounds=(/time_beg(ns),time_end(ns)/) - bnd_start = (/1,1/) - bnd_length = (/2,1/) - call ice_pio_check(pio_put_var(File,varid,ival=time_bounds, & - start=bnd_start(:),count=bnd_length(:)), & - subname//' ERROR: setting "time_bounds"' ) - endif + if (hist_avg(ns) .and. .not. write_ic) then + call ice_pio_check(pio_inq_varid(File,'time_bounds',varid), & + subname//' ERROR: getting time_bounds' ,file=__FILE__,line=__LINE__) + time_bounds=(/time_beg(ns),time_end(ns)/) + bnd_start = (/1,1/) + bnd_length = (/2,1/) + call ice_pio_check(pio_put_var(File,varid,ival=time_bounds,start=bnd_start(:),count=bnd_length(:)), & + subname//' ERROR: setting time_bounds' ,file=__FILE__,line=__LINE__) + endif !----------------------------------------------------------------- ! write coordinate variables !----------------------------------------------------------------- - allocate(workd2(nx_block,ny_block,nblocks)) - allocate(workr2(nx_block,ny_block,nblocks)) + allocate(workd2(nx_block,ny_block,nblocks)) + allocate(workr2(nx_block,ny_block,nblocks)) - do i = 1,ncoord - call ice_pio_check(pio_inq_varid(File, var_coord(i)%short_name, varid), & - subname//' ERROR: getting '//var_coord(i)%short_name ) - SELECT CASE (var_coord(i)%short_name) + do i = 1,ncoord + call ice_pio_check(pio_inq_varid(File, var_coord(i)%short_name, varid), & + subname//' ERROR: getting '//var_coord(i)%short_name ,file=__FILE__,line=__LINE__) + SELECT CASE (var_coord(i)%short_name) CASE ('TLON') ! Convert T grid longitude from -180 -> 180 to 0 to 360 workd2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) @@ -832,47 +816,47 @@ subroutine ice_write_hist (ns) workd2(:,:,:) = elon(:,:,1:nblocks)*rad_to_deg CASE ('ELAT') workd2(:,:,:) = elat(:,:,1:nblocks)*rad_to_deg - END SELECT - if (history_precision == 8) then - call pio_write_darray(File, varid, iodesc2d, & - workd2, status, fillval=spval_dbl) - else - workr2 = workd2 - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval) - endif - - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? - enddo - - ! Extra dimensions (NCAT, NFSD, VGRD*) - - do i = 1, nvar_grdz - if (igrdz(i)) then + END SELECT + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d, & + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d, & + workr2, status, fillval=spval) + endif + + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + enddo + + ! Extra dimensions (NCAT, NFSD, VGRD*) + + do i = 1, nvar_grdz + if (igrdz(i)) then call ice_pio_check(pio_inq_varid(File, var_grdz(i)%short_name, varid), & - subname//' ERROR: getting '//var_grdz(i)%short_name ) + subname//' ERROR: getting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) SELECT CASE (var_grdz(i)%short_name) - CASE ('NCAT') - call ice_pio_check(pio_put_var(File, varid, hin_max(1:ncat_hist)), & - subname//' ERROR: setting '//var_grdz(i)%short_name ) - CASE ('NFSD') - call ice_pio_check(pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)), & - subname//' ERROR: setting '//var_grdz(i)%short_name ) - CASE ('VGRDi') - call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzilyr)/)), & - subname//' ERROR: setting '//var_grdz(i)%short_name ) - CASE ('VGRDs') - call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzslyr)/)), & - subname//' ERROR: setting '//var_grdz(i)%short_name ) - CASE ('VGRDb') - call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzblyr)/)), & - subname//' ERROR: setting '//var_grdz(i)%short_name ) - CASE ('VGRDa') - call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzalyr)/)), & - subname//' ERROR: setting '//var_grdz(i)%short_name ) - END SELECT - endif - enddo + CASE ('NCAT') + call ice_pio_check(pio_put_var(File, varid, hin_max(1:ncat_hist)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('NFSD') + call ice_pio_check(pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDi') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzilyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDs') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzslyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDb') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzblyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDa') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzalyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + END SELECT + endif + enddo !----------------------------------------------------------------- ! write grid masks, area and rotation angle @@ -881,51 +865,51 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grd if (igrd(i)) then SELECT CASE (var_grd(i)%req%short_name) - CASE ('tmask') - workd2 = hm(:,:,1:nblocks) - CASE ('umask') - workd2 = uvm(:,:,1:nblocks) - CASE ('nmask') - workd2 = npm(:,:,1:nblocks) - CASE ('emask') - workd2 = epm(:,:,1:nblocks) - CASE ('blkmask') - workd2 = bm(:,:,1:nblocks) - CASE ('tarea') - workd2 = tarea(:,:,1:nblocks) - CASE ('uarea') - workd2 = uarea(:,:,1:nblocks) - CASE ('narea') - workd2 = narea(:,:,1:nblocks) - CASE ('earea') - workd2 = earea(:,:,1:nblocks) - CASE ('dxt') - workd2 = dxT(:,:,1:nblocks) - CASE ('dyt') - workd2 = dyT(:,:,1:nblocks) - CASE ('dxu') - workd2 = dxU(:,:,1:nblocks) - CASE ('dyu') - workd2 = dyU(:,:,1:nblocks) - CASE ('dxn') - workd2 = dxN(:,:,1:nblocks) - CASE ('dyn') - workd2 = dyN(:,:,1:nblocks) - CASE ('dxe') - workd2 = dxE(:,:,1:nblocks) - CASE ('dye') - workd2 = dyE(:,:,1:nblocks) - CASE ('HTN') - workd2 = HTN(:,:,1:nblocks) - CASE ('HTE') - workd2 = HTE(:,:,1:nblocks) - CASE ('ANGLE') - workd2 = ANGLE(:,:,1:nblocks) - CASE ('ANGLET') - workd2 = ANGLET(:,:,1:nblocks) + CASE ('tmask') + workd2 = hm(:,:,1:nblocks) + CASE ('umask') + workd2 = uvm(:,:,1:nblocks) + CASE ('nmask') + workd2 = npm(:,:,1:nblocks) + CASE ('emask') + workd2 = epm(:,:,1:nblocks) + CASE ('blkmask') + workd2 = bm(:,:,1:nblocks) + CASE ('tarea') + workd2 = tarea(:,:,1:nblocks) + CASE ('uarea') + workd2 = uarea(:,:,1:nblocks) + CASE ('narea') + workd2 = narea(:,:,1:nblocks) + CASE ('earea') + workd2 = earea(:,:,1:nblocks) + CASE ('dxt') + workd2 = dxT(:,:,1:nblocks) + CASE ('dyt') + workd2 = dyT(:,:,1:nblocks) + CASE ('dxu') + workd2 = dxU(:,:,1:nblocks) + CASE ('dyu') + workd2 = dyU(:,:,1:nblocks) + CASE ('dxn') + workd2 = dxN(:,:,1:nblocks) + CASE ('dyn') + workd2 = dyN(:,:,1:nblocks) + CASE ('dxe') + workd2 = dxE(:,:,1:nblocks) + CASE ('dye') + workd2 = dyE(:,:,1:nblocks) + CASE ('HTN') + workd2 = HTN(:,:,1:nblocks) + CASE ('HTE') + workd2 = HTE(:,:,1:nblocks) + CASE ('ANGLE') + workd2 = ANGLE(:,:,1:nblocks) + CASE ('ANGLET') + workd2 = ANGLET(:,:,1:nblocks) END SELECT call ice_pio_check(pio_inq_varid(File, var_grd(i)%req%short_name, varid), & - subname//' ERROR: getting '//var_grd(i)%req%short_name ) + subname//' ERROR: getting '//var_grd(i)%req%short_name,file=__FILE__,line=__LINE__) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc2d, & workd2, status, fillval=spval_dbl) @@ -935,7 +919,7 @@ subroutine ice_write_hist (ns) workr2, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo @@ -944,63 +928,62 @@ subroutine ice_write_hist (ns) !---------------------------------------------------------------- if (f_bounds) then - allocate(workd3v(nverts,nx_block,ny_block,nblocks)) - allocate(workr3v(nverts,nx_block,ny_block,nblocks)) - workd3v (:,:,:,:) = c0 - do i = 1, nvar_verts - SELECT CASE (var_nverts(i)%short_name) - CASE ('lont_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latt_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lonu_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latu_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lonn_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lonn_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latn_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = latn_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lone_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lone_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('late_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = late_bounds(ivertex,:,:,1:nblocks) - enddo - END SELECT - - call ice_pio_check(pio_inq_varid(File, var_nverts(i)%short_name, varid), & - subname//' ERROR: getting '//var_nverts(i)%short_name ) - if (history_precision == 8) then - call pio_write_darray(File, varid, iodesc3dv, & + allocate(workd3v(nverts,nx_block,ny_block,nblocks)) + allocate(workr3v(nverts,nx_block,ny_block,nblocks)) + workd3v (:,:,:,:) = c0 + do i = 1, nvar_verts + SELECT CASE (var_nverts(i)%short_name) + CASE ('lont_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('latt_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('lonu_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('latu_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('lonn_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lonn_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('latn_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = latn_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('lone_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lone_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('late_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = late_bounds(ivertex,:,:,1:nblocks) + enddo + END SELECT + + call ice_pio_check(pio_inq_varid(File, var_nverts(i)%short_name, varid), & + subname//' ERROR: getting '//var_nverts(i)%short_name,file=__FILE__,line=__LINE__) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3dv, & workd3v, status, fillval=spval_dbl) - else - workr3v = workd3v - call pio_write_darray(File, varid, iodesc3dv, & - workr3v, status, fillval=spval) - endif + else + workr3v = workd3v + call pio_write_darray(File, varid, iodesc3dv, & + workr3v, status, fillval=spval) + endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? - enddo - deallocate(workd3v) - deallocate(workr3v) + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + enddo + deallocate(workd3v) + deallocate(workr3v) endif ! f_bounds - !----------------------------------------------------------------- ! write variable data !----------------------------------------------------------------- @@ -1009,7 +992,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) workd2(:,:,:) = a2D(:,:,n,1:nblocks) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO @@ -1027,7 +1010,7 @@ subroutine ice_write_hist (ns) workr2, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_2D @@ -1041,7 +1024,7 @@ subroutine ice_write_hist (ns) nn = n - n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist workd3(:,:,j,i) = a3Dc(:,:,i,nn,j) @@ -1063,7 +1046,7 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Dc deallocate(workd3) @@ -1076,7 +1059,7 @@ subroutine ice_write_hist (ns) nn = n - n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nzilyr workd3(:,:,j,i) = a3Dz(:,:,i,nn,j) @@ -1098,7 +1081,7 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Dz deallocate(workd3) @@ -1111,7 +1094,7 @@ subroutine ice_write_hist (ns) nn = n - n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nzblyr workd3(:,:,j,i) = a3Db(:,:,i,nn,j) @@ -1133,7 +1116,7 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1146,7 +1129,7 @@ subroutine ice_write_hist (ns) nn = n - n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nzalyr workd3(:,:,j,i) = a3Da(:,:,i,nn,j) @@ -1168,7 +1151,7 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1181,7 +1164,7 @@ subroutine ice_write_hist (ns) nn = n - n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nfsd_hist workd3(:,:,j,i) = a3Df(:,:,i,nn,j) @@ -1203,7 +1186,7 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Df deallocate(workd3) @@ -1216,7 +1199,7 @@ subroutine ice_write_hist (ns) nn = n - n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzilyr @@ -1239,7 +1222,7 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4di,& workr4, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Di deallocate(workd4) @@ -1252,7 +1235,7 @@ subroutine ice_write_hist (ns) nn = n - n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzslyr @@ -1276,7 +1259,7 @@ subroutine ice_write_hist (ns) workr4, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname) ! maybe we don't actually want to abort here? + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Ds deallocate(workd4) @@ -1289,7 +1272,7 @@ subroutine ice_write_hist (ns) nn = n - n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nfsd_hist @@ -1312,8 +1295,7 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4df,& workr4, status, fillval=spval) endif - call ice_pio_check(status,subname//" ERROR writing "//avail_hist_fields(n)%vname)! maybe we don't actually want to abort here? - + call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Df deallocate(workd4) @@ -1321,7 +1303,7 @@ subroutine ice_write_hist (ns) ! similarly for num_avail_hist_fields_4Db (define workd4b, iodesc4db) - + !----------------------------------------------------------------- ! clean-up PIO descriptors !----------------------------------------------------------------- @@ -1372,20 +1354,20 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) character(len=*), parameter :: subname = '(ice_write_hist_attrs)' call ice_pio_check(pio_put_att(File,varid,'units', trim(hfield%vunit)), & - 'ERROR: defining "units" as '//trim(hfield%vunit)) + subname//' ERROR: defining att units '//trim(hfield%vunit),file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)), & - 'ERROR: defining "long_name" as '//trim(hfield%vdesc)) + subname//' ERROR: defining att long_name '//trim(hfield%vdesc),file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)), & - 'ERROR: defining "coordinates" as '//trim(hfield%vdesc)) + subname//' ERROR: defining att coordinates '//trim(hfield%vdesc),file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,varid,'cell_measures',trim(hfield%vcellmeas)), & - 'ERROR: defining "cell_measures" as '//trim(hfield%vcoord)) + subname//' ERROR: defining att cell_measures '//trim(hfield%vcoord),file=__FILE__,line=__LINE__) if (hfield%vcomment /= "none") then call ice_pio_check(pio_put_att(File,varid,'comment', trim(hfield%vcomment)), & - 'ERROR: defining "comment" as '//trim(hfield%vcomment)) + subname//' ERROR: defining att comment '//trim(hfield%vcomment),file=__FILE__,line=__LINE__) endif call ice_write_hist_fill(File,varid,hfield%vname,history_precision) @@ -1398,7 +1380,7 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then call ice_pio_check(pio_put_att(File,varid,'cell_methods','time: mean'), & - 'ERROR: defining "cell_methods"') + subname//' ERROR: defining att cell_methods',file=__FILE__,line=__LINE__) endif endif @@ -1419,10 +1401,10 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .or.TRIM(hfield%vname(1:6))=='hisnap' & .or.TRIM(hfield%vname(1:6))=='aisnap') then call ice_pio_check(pio_put_att(File,varid,'time_rep','instantaneous'), & - 'ERROR: defining "time_rep"') + subname//' ERROR: defining att time_rep i',file=__FILE__,line=__LINE__) else call ice_pio_check(pio_put_att(File,varid,'time_rep','averaged'), & - 'ERROR: defining "time_rep"') + subname//' ERROR: defining att time_rep a',file=__FILE__,line=__LINE__) endif end subroutine ice_write_hist_attrs @@ -1437,8 +1419,8 @@ subroutine ice_write_hist_fill(File,varid,vname,precision) type(file_desc_t) , intent(inout) :: File type(var_desc_t) , intent(in) :: varid - character(len=*), intent(in) :: vname - integer (kind=int_kind), intent(in) :: precision + character(len=*), intent(in) :: vname + integer (kind=int_kind), intent(in) :: precision ! local variables @@ -1447,14 +1429,14 @@ subroutine ice_write_hist_fill(File,varid,vname,precision) if (precision == 8) then call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval_dbl), & - 'ERROR: defining "missing_value"') + subname//' ERROR: defining att missing_value',file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval_dbl), & - 'ERROR: defining "_FillValue"') + subname//' ERROR: defining att _FillValue',file=__FILE__,line=__LINE__) else call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval), & - 'ERROR: defining "missing_value"') + subname//' ERROR: defining att missing_value',file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval), & - 'ERROR: defining "_FillValue"') + subname//' ERROR: defining att _FillValue',file=__FILE__,line=__LINE__) endif end subroutine ice_write_hist_fill diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index 9dd5f2bd4..47ebf36d1 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -28,7 +28,7 @@ module ice_pio public ice_pio_init public ice_pio_initdecomp public ice_pio_check - + #ifdef CESMCOUPLED type(iosystem_desc_t), pointer :: ice_pio_subsystem #else @@ -69,14 +69,14 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) integer :: nprocs , istride, basetask, numiotasks, rearranger, pio_iotype, status, nmode logical :: lclobber, lcdf64, exists - character(len=*), parameter :: subname = '(ice_pio_init)' logical, save :: first_call = .true. + character(len=*), parameter :: subname = '(ice_pio_init)' #ifdef CESMCOUPLED ice_pio_subsystem => shr_pio_getiosys(inst_name) pio_iotype = shr_pio_getiotype(inst_name) - pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) + pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) #else #ifdef GPTL @@ -88,8 +88,8 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) !--- initialize type of io !pio_iotype = PIO_IOTYPE_PNETCDF !pio_iotype = PIO_IOTYPE_NETCDF4C - pio_iotype = PIO_IOTYPE_NETCDF4P - !pio_iotype = PIO_IOTYPE_NETCDF + !pio_iotype = PIO_IOTYPE_NETCDF4P + pio_iotype = PIO_IOTYPE_NETCDF if (present(iotype)) then pio_iotype = iotype endif @@ -113,7 +113,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & rearranger, ice_pio_subsystem, base=basetask) - call pio_seterrorhandling(ice_pio_subsystem, PIO_BCAST_ERROR) + call pio_seterrorhandling(ice_pio_subsystem, PIO_BCAST_ERROR) !--- initialize rearranger options !pio_rearr_opt_comm_type = integer (PIO_REARR_COMM_[P2P,COLL]) @@ -153,14 +153,16 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) nmode = pio_clobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) - call ice_pio_check(status, subname//' ERROR: Failed to create file '//trim(filename)) + call ice_pio_check(status, subname//' ERROR: Failed to create file '//trim(filename), & + file=__FILE__,line=__LINE__) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if else nmode = pio_write status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) - call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename) ) + call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename), & + file=__FILE__,line=__LINE__) if (my_task == master_task) then write(nu_diag,*) subname,' open file ',trim(filename) end if @@ -169,7 +171,8 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) nmode = pio_noclobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) - call ice_pio_check( status, subname//' ERROR: Failed to create file '//trim(filename) ) + call ice_pio_check( status, subname//' ERROR: Failed to create file '//trim(filename), & + file=__FILE__,line=__LINE__) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if @@ -185,7 +188,8 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) write(nu_diag,*) subname,' opening file for reading' endif status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite) - call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename)) + call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename), & + file=__FILE__,line=__LINE__) else if(my_task==master_task) then write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename) @@ -196,7 +200,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) end if - call pio_seterrorhandling(ice_pio_subsystem, PIO_INTERNAL_ERROR) + call pio_seterrorhandling(ice_pio_subsystem, PIO_INTERNAL_ERROR) end subroutine ice_pio_init @@ -476,16 +480,32 @@ end subroutine ice_pio_initdecomp_4d ! PIO Error handling ! Author: Anton Steketee, ACCESS-NRI - subroutine ice_pio_check(status, abort_msg) - integer, intent (in) :: status - integer :: strerror_status - character (len=*), intent (in) :: abort_msg + subroutine ice_pio_check(status, abort_msg, file, line) + integer(kind=int_kind), intent (in) :: status + character (len=*) , intent (in) :: abort_msg + character (len=*) , intent (in), optional :: file + integer(kind=int_kind), intent (in), optional :: line + + ! local variables + character(len=pio_max_name) :: err_msg + integer(kind=int_kind) :: strerror_status + character(len=*), parameter :: subname = '(ice_pio_check)' - if(status /= PIO_NOERR) then + if (status /= PIO_NOERR) then +#ifdef USE_PIO1 + err_msg = '' +#else strerror_status = pio_strerror(status, err_msg) - call abort_ice('ParallelIO error: '//err_msg, abort_msg) - end if +#endif + if (present(file) .and. present(line)) then + call abort_ice(subname//trim(err_msg)//':'//trim(abort_msg), file=file, line=line) + elseif (present(file)) then + call abort_ice(subname//trim(err_msg)//':'//trim(abort_msg), file=file) + else + call abort_ice(subname//trim(err_msg)//':'//trim(abort_msg)) + endif + endif end subroutine ice_pio_check !================================================================================ diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index 809661b80..d4ee7eda5 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -76,40 +76,42 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) end if - ! if (restart_format(1:3) == 'pio') then - iotype = PIO_IOTYPE_NETCDF - if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF - File%fh=-1 - call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) - - call pio_seterrorhandling(File, PIO_RETURN_ERROR) - - call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true., precision=8) - - if (use_restart_time) then - call ice_pio_check(pio_get_att(File, pio_global, 'istep1', istep0), & - subname//" ERROR: reading restart time ") -! call ice_pio_check(pio_get_att(File, pio_global, 'time', time), & - ! subname//" ERROR: reading restart time ") -! call ice_pio_check(pio_get_att(File, pio_global, 'time_forc', time_forc), & - ! subname//" ERROR: reading restart time ") - call ice_pio_check(pio_get_att(File, pio_global, 'myear', myear), & - subname//" ERROR: reading restart time ") + iotype = PIO_IOTYPE_NETCDF + if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF + File%fh=-1 + call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) + + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true., precision=8) + + if (use_restart_time) then + ! for backwards compatibility, check nyr, month, and sec as well + call ice_pio_check(pio_get_att(File, pio_global, 'istep1', istep0), & + subname//" ERROR: reading restart step ",file=__FILE__,line=__LINE__) + + status = pio_get_att(File, pio_global, 'myear', myear) + if (status /= PIO_NOERR) then call ice_pio_check(pio_get_att(File, pio_global, 'nyr', myear), & - subname//" ERROR: reading restart time ") - call ice_pio_check(pio_get_att(File, pio_global, 'mmonth', mmonth), & - subname//" ERROR: reading restart time ") + subname//" ERROR: reading restart year ",file=__FILE__,line=__LINE__) + endif + + status = pio_get_att(File, pio_global, 'mmonth', mmonth) + if (status /= PIO_NOERR) then call ice_pio_check(pio_get_att(File, pio_global, 'month', mmonth), & - subname//" ERROR: reading restart time ") - call ice_pio_check(pio_get_att(File, pio_global, 'mday', mday), & - subname//" ERROR: reading restart time ") - call ice_pio_check(pio_get_att(File, pio_global, 'msec', msec), & - subname//" ERROR: reading restart time ") + subname//" ERROR: reading restart month ",file=__FILE__,line=__LINE__) + endif + + call ice_pio_check(pio_get_att(File, pio_global, 'mday', mday), & + subname//" ERROR: reading restart day ",file=__FILE__,line=__LINE__) + + status = pio_get_att(File, pio_global, 'msec', msec) + if (status /= PIO_NOERR) then call ice_pio_check(pio_get_att(File, pio_global, 'sec', msec), & - subname//" ERROR: reading restart time ") - endif ! use namelist values if use_restart_time = F -! endif + subname//" ERROR: reading restart sec ",file=__FILE__,line=__LINE__) + endif + endif ! use namelist values if use_restart_time = F call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) @@ -122,9 +124,6 @@ subroutine init_restart_read(ice_ic) call broadcast_scalar(mmonth,master_task) call broadcast_scalar(mday,master_task) call broadcast_scalar(msec,master_task) -! call broadcast_scalar(time,master_task) -! call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(myear,master_task) istep1 = istep0 @@ -150,38 +149,36 @@ subroutine init_restart_write(filename_spec) use ice_arrays_column, only: oceanmixed_ice use ice_grid, only: grid_ice - logical (kind=log_kind) :: & - skl_bgc, z_tracers + character(len=char_len_long), intent(in), optional :: filename_spec - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & - tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & - tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & - tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & - tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & - tr_bgc_hum, tr_fsd + ! local variables - integer (kind=int_kind) :: & - nbtrcr + logical (kind=log_kind) :: & + skl_bgc, z_tracers - character(len=char_len_long), intent(in), optional :: filename_spec + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & + tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & + tr_bgc_Sil, tr_bgc_DMS, & + tr_bgc_chl, tr_bgc_Am, & + tr_bgc_PON, tr_bgc_DON, & + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum, tr_fsd - ! local variables + integer (kind=int_kind) :: nbtrcr character(len=char_len_long) :: filename - integer (kind=int_kind) :: dimid_ni, dimid_nj, dimid_ncat, & - dimid_nilyr, dimid_nslyr, dimid_naero + integer (kind=int_kind) :: & + dimid_ni, dimid_nj, dimid_ncat, & + dimid_nilyr, dimid_nslyr, dimid_naero integer (kind=int_kind), allocatable :: dims(:) integer (kind=int_kind) :: iotype - integer (kind=int_kind) :: & - k, n, & ! loop index - status ! status variable from netCDF routine + integer (kind=int_kind) :: k, n ! loop index character (len=3) :: nchar, ncharb @@ -189,30 +186,30 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & - tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_iso_out=tr_iso, tr_aero_out=tr_aero, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & - tr_snow_out=tr_snow, tr_brine_out=tr_brine, & - tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & - tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & - tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & - tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & - tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & - tr_bgc_hum_out=tr_bgc_hum, tr_fsd_out=tr_fsd) + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & + tr_iso_out=tr_iso, tr_aero_out=tr_aero, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine, & + tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & + tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & + tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & + tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & + tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & + tr_bgc_hum_out=tr_bgc_hum, tr_fsd_out=tr_fsd) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers) + z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) ! construct path/file if (present(filename_spec)) then filename = trim(filename_spec) else write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & - restart_dir(1:lenstr(restart_dir)), & - restart_file(1:lenstr(restart_file)),'.', & - myear,'-',mmonth,'-',mday,'-',msec + restart_dir(1:lenstr(restart_dir)), & + restart_file(1:lenstr(restart_file)),'.', & + myear,'-',mmonth,'-',mday,'-',msec end if if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' @@ -224,133 +221,126 @@ subroutine init_restart_write(filename_spec) close(nu_rst_pointer) endif + iotype = PIO_IOTYPE_NETCDF + if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF + File%fh=-1 + call ice_pio_init(mode='write',filename=trim(filename), File=File, & + clobber=.true., cdf64=lcdf64, iotype=iotype) + call pio_seterrorhandling(File, PIO_RETURN_ERROR) -! if (restart_format(1:3) == 'pio') then - - iotype = PIO_IOTYPE_NETCDF4P - !if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF - File%fh=-1 - call ice_pio_init(mode='write',filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64, iotype=iotype) - - call ice_pio_check(pio_put_att(File,pio_global,'istep1',istep1), & - subname//' ERROR writing restart time') -! call ice_pio_check(pio_put_att(File,pio_global,'time',time), & - ! subname//' ERROR writing restart time') -! call ice_pio_check(pio_put_att(File,pio_global,'time_forc',time_forc), & - ! subname//' ERROR writing restart time') - call ice_pio_check(pio_put_att(File,pio_global,'myear',myear), & - subname//' ERROR writing restart time') - call ice_pio_check(pio_put_att(File,pio_global,'mmonth',mmonth), & - subname//' ERROR writing restart time') - call ice_pio_check(pio_put_att(File,pio_global,'mday',mday), & - subname//' ERROR writing restart time') - call ice_pio_check(pio_put_att(File,pio_global,'msec',msec), & - subname//' ERROR writing restart time') - - call ice_pio_check(pio_def_dim(File,'ni',nx_global,dimid_ni), & - subname//' ERROR defining restart dim ni') - call ice_pio_check(pio_def_dim(File,'nj',ny_global,dimid_nj), & - subname//' ERROR defining restart dim nj') - call ice_pio_check(pio_def_dim(File,'ncat',ncat,dimid_ncat), & - subname//' ERROR defining restart dim ncat') + call ice_pio_check(pio_put_att(File,pio_global,'istep1',istep1), & + subname//' ERROR writing restart step',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'myear',myear), & + subname//' ERROR writing restart year',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'mmonth',mmonth), & + subname//' ERROR writing restart month',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'mday',mday), & + subname//' ERROR writing restart day',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'msec',msec), & + subname//' ERROR writing restart sec',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'ni',nx_global,dimid_ni), & + subname//' ERROR defining restart dim ni',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_def_dim(File,'nj',ny_global,dimid_nj), & + subname//' ERROR defining restart dim nj',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_def_dim(File,'ncat',ncat,dimid_ncat), & + subname//' ERROR defining restart dim ncat',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! 2D restart fields !----------------------------------------------------------------- - allocate(dims(2)) + allocate(dims(2)) - dims(1) = dimid_ni - dims(2) = dimid_nj + dims(1) = dimid_ni + dims(2) = dimid_nj - call define_rest_field(File,'uvel',dims) - call define_rest_field(File,'vvel',dims) + call define_rest_field(File,'uvel',dims) + call define_rest_field(File,'vvel',dims) - if (grid_ice == 'CD') then - call define_rest_field(File,'uvelE',dims) - call define_rest_field(File,'vvelE',dims) - call define_rest_field(File,'uvelN',dims) - call define_rest_field(File,'vvelN',dims) - endif + if (grid_ice == 'CD') then + call define_rest_field(File,'uvelE',dims) + call define_rest_field(File,'vvelE',dims) + call define_rest_field(File,'uvelN',dims) + call define_rest_field(File,'vvelN',dims) + endif - if (grid_ice == 'C') then - call define_rest_field(File,'uvelE',dims) - call define_rest_field(File,'vvelN',dims) - endif + if (grid_ice == 'C') then + call define_rest_field(File,'uvelE',dims) + call define_rest_field(File,'vvelN',dims) + endif + if (restart_coszen) call define_rest_field(File,'coszen',dims) + call define_rest_field(File,'scale_factor',dims) + call define_rest_field(File,'swvdr',dims) + call define_rest_field(File,'swvdf',dims) + call define_rest_field(File,'swidr',dims) + call define_rest_field(File,'swidf',dims) + + call define_rest_field(File,'strocnxT',dims) + call define_rest_field(File,'strocnyT',dims) + + call define_rest_field(File,'stressp_1',dims) + call define_rest_field(File,'stressp_2',dims) + call define_rest_field(File,'stressp_3',dims) + call define_rest_field(File,'stressp_4',dims) + + call define_rest_field(File,'stressm_1',dims) + call define_rest_field(File,'stressm_2',dims) + call define_rest_field(File,'stressm_3',dims) + call define_rest_field(File,'stressm_4',dims) + + call define_rest_field(File,'stress12_1',dims) + call define_rest_field(File,'stress12_2',dims) + call define_rest_field(File,'stress12_3',dims) + call define_rest_field(File,'stress12_4',dims) + + call define_rest_field(File,'iceumask',dims) + + if (grid_ice == 'CD' .or. grid_ice == 'C') then + call define_rest_field(File,'stresspT' ,dims) + call define_rest_field(File,'stressmT' ,dims) + call define_rest_field(File,'stress12T',dims) + call define_rest_field(File,'stresspU' ,dims) + call define_rest_field(File,'stressmU' ,dims) + call define_rest_field(File,'stress12U',dims) + call define_rest_field(File,'icenmask',dims) + call define_rest_field(File,'iceemask',dims) + endif - if (restart_coszen) call define_rest_field(File,'coszen',dims) - call define_rest_field(File,'scale_factor',dims) - call define_rest_field(File,'swvdr',dims) - call define_rest_field(File,'swvdf',dims) - call define_rest_field(File,'swidr',dims) - call define_rest_field(File,'swidf',dims) - - call define_rest_field(File,'strocnxT',dims) - call define_rest_field(File,'strocnyT',dims) - - call define_rest_field(File,'stressp_1',dims) - call define_rest_field(File,'stressp_2',dims) - call define_rest_field(File,'stressp_3',dims) - call define_rest_field(File,'stressp_4',dims) - - call define_rest_field(File,'stressm_1',dims) - call define_rest_field(File,'stressm_2',dims) - call define_rest_field(File,'stressm_3',dims) - call define_rest_field(File,'stressm_4',dims) - - call define_rest_field(File,'stress12_1',dims) - call define_rest_field(File,'stress12_2',dims) - call define_rest_field(File,'stress12_3',dims) - call define_rest_field(File,'stress12_4',dims) - - call define_rest_field(File,'iceumask',dims) - - if (grid_ice == 'CD' .or. grid_ice == 'C') then - call define_rest_field(File,'stresspT' ,dims) - call define_rest_field(File,'stressmT' ,dims) - call define_rest_field(File,'stress12T',dims) - call define_rest_field(File,'stresspU' ,dims) - call define_rest_field(File,'stressmU' ,dims) - call define_rest_field(File,'stress12U',dims) - call define_rest_field(File,'icenmask',dims) - call define_rest_field(File,'iceemask',dims) - endif + if (oceanmixed_ice) then + call define_rest_field(File,'sst',dims) + call define_rest_field(File,'frzmlt',dims) + endif - if (oceanmixed_ice) then - call define_rest_field(File,'sst',dims) - call define_rest_field(File,'frzmlt',dims) - endif + if (tr_FY) then + call define_rest_field(File,'frz_onset',dims) + end if - if (tr_FY) then - call define_rest_field(File,'frz_onset',dims) - end if - - if (kdyn == 2) then - call define_rest_field(File,'a11_1',dims) - call define_rest_field(File,'a11_2',dims) - call define_rest_field(File,'a11_3',dims) - call define_rest_field(File,'a11_4',dims) - call define_rest_field(File,'a12_1',dims) - call define_rest_field(File,'a12_2',dims) - call define_rest_field(File,'a12_3',dims) - call define_rest_field(File,'a12_4',dims) - endif + if (kdyn == 2) then + call define_rest_field(File,'a11_1',dims) + call define_rest_field(File,'a11_2',dims) + call define_rest_field(File,'a11_3',dims) + call define_rest_field(File,'a11_4',dims) + call define_rest_field(File,'a12_1',dims) + call define_rest_field(File,'a12_2',dims) + call define_rest_field(File,'a12_3',dims) + call define_rest_field(File,'a12_4',dims) + endif - if (tr_pond_lvl) then - call define_rest_field(File,'fsnow',dims) - endif + if (tr_pond_lvl) then + call define_rest_field(File,'fsnow',dims) + endif - if (nbtrcr > 0) then - if (tr_bgc_N) then + if (nbtrcr > 0) then + if (tr_bgc_N) then do k=1,n_algae write(nchar,'(i3.3)') k call define_rest_field(File,'algalN'//trim(nchar),dims) enddo - endif - if (tr_bgc_C) then + endif + if (tr_bgc_C) then do k=1,n_doc write(nchar,'(i3.3)') k call define_rest_field(File,'doc'//trim(nchar),dims) @@ -359,25 +349,25 @@ subroutine init_restart_write(filename_spec) write(nchar,'(i3.3)') k call define_rest_field(File,'dic'//trim(nchar),dims) enddo - endif - call define_rest_field(File,'nit' ,dims) - if (tr_bgc_Am) & + endif + call define_rest_field(File,'nit' ,dims) + if (tr_bgc_Am) & call define_rest_field(File,'amm' ,dims) - if (tr_bgc_Sil) & + if (tr_bgc_Sil) & call define_rest_field(File,'sil' ,dims) - if (tr_bgc_hum) & + if (tr_bgc_hum) & call define_rest_field(File,'hum' ,dims) - if (tr_bgc_DMS) then - call define_rest_field(File,'dmsp' ,dims) - call define_rest_field(File,'dms' ,dims) - endif - if (tr_bgc_DON) then + if (tr_bgc_DMS) then + call define_rest_field(File,'dmsp' ,dims) + call define_rest_field(File,'dms' ,dims) + endif + if (tr_bgc_DON) then do k=1,n_don write(nchar,'(i3.3)') k call define_rest_field(File,'don'//trim(nchar),dims) enddo - endif - if (tr_bgc_Fe ) then + endif + if (tr_bgc_Fe ) then do k=1,n_fed write(nchar,'(i3.3)') k call define_rest_field(File,'fed'//trim(nchar),dims) @@ -386,301 +376,298 @@ subroutine init_restart_write(filename_spec) write(nchar,'(i3.3)') k call define_rest_field(File,'fep'//trim(nchar),dims) enddo - endif - if (tr_zaero) then + endif + if (tr_zaero) then do k=1,n_zaero write(nchar,'(i3.3)') k call define_rest_field(File,'zaeros'//trim(nchar),dims) enddo - endif - endif !nbtrcr + endif + endif !nbtrcr - deallocate(dims) + deallocate(dims) !----------------------------------------------------------------- ! 3D restart fields (ncat) !----------------------------------------------------------------- - allocate(dims(3)) - - dims(1) = dimid_ni - dims(2) = dimid_nj - dims(3) = dimid_ncat - - call define_rest_field(File,'aicen',dims) - call define_rest_field(File,'vicen',dims) - call define_rest_field(File,'vsnon',dims) - call define_rest_field(File,'Tsfcn',dims) - - if (tr_iage) then - call define_rest_field(File,'iage',dims) - end if - - if (tr_FY) then - call define_rest_field(File,'FY',dims) - end if - - if (tr_lvl) then - call define_rest_field(File,'alvl',dims) - call define_rest_field(File,'vlvl',dims) - end if - - if (tr_pond_topo) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - call define_rest_field(File,'ipnd',dims) - end if - - if (tr_pond_lvl) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - call define_rest_field(File,'ipnd',dims) - call define_rest_field(File,'dhs',dims) - call define_rest_field(File,'ffrac',dims) - end if - - if (tr_brine) then - call define_rest_field(File,'fbrn',dims) - call define_rest_field(File,'first_ice',dims) - endif + allocate(dims(3)) + + dims(1) = dimid_ni + dims(2) = dimid_nj + dims(3) = dimid_ncat + + call define_rest_field(File,'aicen',dims) + call define_rest_field(File,'vicen',dims) + call define_rest_field(File,'vsnon',dims) + call define_rest_field(File,'Tsfcn',dims) + + if (tr_iage) then + call define_rest_field(File,'iage',dims) + end if + + if (tr_FY) then + call define_rest_field(File,'FY',dims) + end if + + if (tr_lvl) then + call define_rest_field(File,'alvl',dims) + call define_rest_field(File,'vlvl',dims) + end if - if (skl_bgc) then + if (tr_pond_topo) then + call define_rest_field(File,'apnd',dims) + call define_rest_field(File,'hpnd',dims) + call define_rest_field(File,'ipnd',dims) + end if + + if (tr_pond_lvl) then + call define_rest_field(File,'apnd',dims) + call define_rest_field(File,'hpnd',dims) + call define_rest_field(File,'ipnd',dims) + call define_rest_field(File,'dhs',dims) + call define_rest_field(File,'ffrac',dims) + end if + + if (tr_brine) then + call define_rest_field(File,'fbrn',dims) + call define_rest_field(File,'first_ice',dims) + endif + + if (skl_bgc) then + do k = 1, n_algae + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_N'//trim(nchar) ,dims) + enddo + if (tr_bgc_C) then + ! do k = 1, n_algae + ! write(nchar,'(i3.3)') k + ! call define_rest_field(File,'bgc_C'//trim(nchar) ,dims) + ! enddo + do k = 1, n_doc + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DOC'//trim(nchar) ,dims) + enddo + do k = 1, n_dic + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DIC'//trim(nchar) ,dims) + enddo + endif + if (tr_bgc_chl) then do k = 1, n_algae write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_N'//trim(nchar) ,dims) + call define_rest_field(File,'bgc_chl'//trim(nchar) ,dims) enddo - if (tr_bgc_C) then - ! do k = 1, n_algae - ! write(nchar,'(i3.3)') k - ! call define_rest_field(File,'bgc_C'//trim(nchar) ,dims) - ! enddo - do k = 1, n_doc - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DOC'//trim(nchar) ,dims) - enddo - do k = 1, n_dic - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DIC'//trim(nchar) ,dims) - enddo - endif - if (tr_bgc_chl) then - do k = 1, n_algae - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_chl'//trim(nchar) ,dims) - enddo - endif - call define_rest_field(File,'bgc_Nit' ,dims) - if (tr_bgc_Am) & + endif + call define_rest_field(File,'bgc_Nit' ,dims) + if (tr_bgc_Am) & call define_rest_field(File,'bgc_Am' ,dims) - if (tr_bgc_Sil) & + if (tr_bgc_Sil) & call define_rest_field(File,'bgc_Sil' ,dims) - if (tr_bgc_hum) & + if (tr_bgc_hum) & call define_rest_field(File,'bgc_hum' ,dims) - if (tr_bgc_DMS) then - call define_rest_field(File,'bgc_DMSPp',dims) - call define_rest_field(File,'bgc_DMSPd',dims) - call define_rest_field(File,'bgc_DMS' ,dims) - endif - if (tr_bgc_PON) & + if (tr_bgc_DMS) then + call define_rest_field(File,'bgc_DMSPp',dims) + call define_rest_field(File,'bgc_DMSPd',dims) + call define_rest_field(File,'bgc_DMS' ,dims) + endif + if (tr_bgc_PON) & call define_rest_field(File,'bgc_PON' ,dims) - if (tr_bgc_DON) then - do k = 1, n_don - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DON'//trim(nchar) ,dims) - enddo - endif - if (tr_bgc_Fe ) then - do k = 1, n_fed - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fed'//trim(nchar) ,dims) - enddo - do k = 1, n_fep - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fep'//trim(nchar) ,dims) - enddo - endif - endif !skl_bgc + if (tr_bgc_DON) then + do k = 1, n_don + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DON'//trim(nchar) ,dims) + enddo + endif + if (tr_bgc_Fe ) then + do k = 1, n_fed + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fed'//trim(nchar) ,dims) + enddo + do k = 1, n_fep + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fep'//trim(nchar) ,dims) + enddo + endif + endif !skl_bgc !----------------------------------------------------------------- ! 4D restart fields, written as layers of 3D !----------------------------------------------------------------- - do k=1,nilyr + do k=1,nilyr + write(nchar,'(i3.3)') k + call define_rest_field(File,'sice'//trim(nchar),dims) + call define_rest_field(File,'qice'//trim(nchar),dims) + enddo + + do k=1,nslyr + write(nchar,'(i3.3)') k + call define_rest_field(File,'qsno'//trim(nchar),dims) + enddo + + if (tr_snow) then + do k=1,nslyr write(nchar,'(i3.3)') k - call define_rest_field(File,'sice'//trim(nchar),dims) - call define_rest_field(File,'qice'//trim(nchar),dims) + call define_rest_field(File,'smice'//trim(nchar),dims) + call define_rest_field(File,'smliq'//trim(nchar),dims) + call define_rest_field(File, 'rhos'//trim(nchar),dims) + call define_rest_field(File, 'rsnw'//trim(nchar),dims) enddo + endif - do k=1,nslyr + if (tr_fsd) then + do k=1,nfsd write(nchar,'(i3.3)') k - call define_rest_field(File,'qsno'//trim(nchar),dims) + call define_rest_field(File,'fsd'//trim(nchar),dims) enddo + endif - if (tr_snow) then - do k=1,nslyr + if (tr_iso) then + do k=1,n_iso + write(nchar,'(i3.3)') k + call define_rest_field(File,'isosno'//nchar, dims) + call define_rest_field(File,'isoice'//nchar, dims) + enddo + endif + + if (tr_aero) then + do k=1,n_aero + write(nchar,'(i3.3)') k + call define_rest_field(File,'aerosnossl'//nchar, dims) + call define_rest_field(File,'aerosnoint'//nchar, dims) + call define_rest_field(File,'aeroicessl'//nchar, dims) + call define_rest_field(File,'aeroiceint'//nchar, dims) + enddo + endif + + if (z_tracers) then + if (tr_zaero) then + do n = 1, n_zaero + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'zaero'//trim(ncharb)//trim(nchar),dims) + enddo !k + enddo !n + endif !tr_zaero + if (tr_bgc_Nit) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'smice'//trim(nchar),dims) - call define_rest_field(File,'smliq'//trim(nchar),dims) - call define_rest_field(File, 'rhos'//trim(nchar),dims) - call define_rest_field(File, 'rsnw'//trim(nchar),dims) + call define_rest_field(File,'bgc_Nit'//trim(nchar),dims) enddo endif - - if (tr_fsd) then - do k=1,nfsd - write(nchar,'(i3.3)') k - call define_rest_field(File,'fsd'//trim(nchar),dims) + if (tr_bgc_N) then + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_N'//trim(ncharb)//trim(nchar),dims) + enddo enddo endif - - if (tr_iso) then - do k=1,n_iso - write(nchar,'(i3.3)') k - call define_rest_field(File,'isosno'//nchar, dims) - call define_rest_field(File,'isoice'//nchar, dims) + if (tr_bgc_C) then + ! do n = 1, n_algae + ! write(ncharb,'(i3.3)') n + ! do k = 1, nblyr+3 + ! write(nchar,'(i3.3)') k + ! call define_rest_field(File,'bgc_C'//trim(ncharb)//trim(nchar),dims) + ! enddo + ! enddo + do n = 1, n_doc + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_dic + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) + enddo enddo endif - - if (tr_aero) then - do k=1,n_aero + if (tr_bgc_chl) then + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_chl'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + endif + if (tr_bgc_Am) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'aerosnossl'//nchar, dims) - call define_rest_field(File,'aerosnoint'//nchar, dims) - call define_rest_field(File,'aeroicessl'//nchar, dims) - call define_rest_field(File,'aeroiceint'//nchar, dims) + call define_rest_field(File,'bgc_Am'//trim(nchar),dims) enddo endif - - if (z_tracers) then - if (tr_zaero) then - do n = 1, n_zaero - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 + if (tr_bgc_Sil) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'zaero'//trim(ncharb)//trim(nchar),dims) - enddo !k - enddo !n - endif !tr_zaero - if (tr_bgc_Nit) then - do k = 1, nblyr+3 + call define_rest_field(File,'bgc_Sil'//trim(nchar),dims) + enddo + endif + if (tr_bgc_hum) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Nit'//trim(nchar),dims) - enddo - endif - if (tr_bgc_N) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 + call define_rest_field(File,'bgc_hum'//trim(nchar),dims) + enddo + endif + if (tr_bgc_DMS) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_N'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_C) then - ! do n = 1, n_algae - ! write(ncharb,'(i3.3)') n - ! do k = 1, nblyr+3 - ! write(nchar,'(i3.3)') k - ! call - ! define_rest_field(File,'bgc_C'//trim(ncharb)//trim(nchar),dims) - ! enddo - ! enddo - do n = 1, n_doc - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_dic - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_chl) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_chl'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_Am) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Am'//trim(nchar),dims) - enddo - endif - if (tr_bgc_Sil) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Sil'//trim(nchar),dims) - enddo - endif - if (tr_bgc_hum) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_hum'//trim(nchar),dims) - enddo - endif - if (tr_bgc_DMS) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DMSPp'//trim(nchar),dims) - call define_rest_field(File,'bgc_DMSPd'//trim(nchar),dims) - call define_rest_field(File,'bgc_DMS'//trim(nchar),dims) - enddo - endif - if (tr_bgc_PON) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_PON'//trim(nchar),dims) - enddo - endif - if (tr_bgc_DON) then - do n = 1, n_don - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DON'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_Fe ) then - do n = 1, n_fed - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_fep - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - do k = 1, nbtrcr + call define_rest_field(File,'bgc_DMSPp'//trim(nchar),dims) + call define_rest_field(File,'bgc_DMSPd'//trim(nchar),dims) + call define_rest_field(File,'bgc_DMS'//trim(nchar),dims) + enddo + endif + if (tr_bgc_PON) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'zbgc_frac'//trim(nchar),dims) + call define_rest_field(File,'bgc_PON'//trim(nchar),dims) enddo - endif !z_tracers - - deallocate(dims) - status = pio_enddef(File) + endif + if (tr_bgc_DON) then + do n = 1, n_don + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DON'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + endif + if (tr_bgc_Fe ) then + do n = 1, n_fed + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_fep + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + endif + do k = 1, nbtrcr + write(nchar,'(i3.3)') k + call define_rest_field(File,'zbgc_frac'//trim(nchar),dims) + enddo + endif !z_tracers - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + deallocate(dims) + call ice_pio_check(pio_enddef(File), subname//' ERROR enddef',file=__FILE__,line=__LINE__) - call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) -! endif ! restart_format + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) if (my_task == master_task) then write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) @@ -704,33 +691,33 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & use ice_global_reductions, only: global_minval, global_maxval, global_sum integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(inout) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc , & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables integer (kind=int_kind) :: & - j, & ! dimension counter - n, & ! number of dimensions for variable - ndims, & ! number of variable dimensions - status ! status variable from netCDF routine + j , & ! dimension counter + n , & ! number of dimensions for variable + ndims , & ! number of variable dimensions + status ! status variable from netCDF routine real (kind=dbl_kind) :: amin,amax,asum @@ -738,70 +725,64 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & call pio_seterrorhandling(File, PIO_RETURN_ERROR) -! if (restart_format(1:3) == "pio") then - if (my_task == master_task) & - write(nu_diag,*)'Parallel restart file read: ',vname + if (my_task == master_task) then + write(nu_diag,*)'Parallel restart file read: ',vname + endif + + call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & + subname// "ERROR: missing varid "//trim(vname),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & - subname// "ERROR: CICE restart? Missing variable: "//trim(vname)) - - call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & - subname// "ERROR reading ndims for "//trim(vname)) + call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & + subname// "ERROR missing varndims "//trim(vname),file=__FILE__,line=__LINE__) -! if (ndim3 == ncat .and. ncat>1) then - if (ndim3 == ncat .and. ndims == 3) then - call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) + if (ndim3 == ncat .and. ndims == 3) then + call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) #ifdef CESMCOUPLED - where (work == PIO_FILL_DOUBLE) work = c0 + where (work == PIO_FILL_DOUBLE) work = c0 #endif - if (present(field_loc)) then - do n=1,ndim3 - call ice_HaloUpdate (work(:,:,n,:), halo_info, & - field_loc, field_type) - enddo - endif -! elseif (ndim3 == 1) then - elseif (ndim3 == 1 .and. ndims == 2) then - call pio_read_darray(File, vardesc, iodesc2d, work, status) + if (present(field_loc)) then + do n=1,ndim3 + call ice_HaloUpdate (work(:,:,n,:), halo_info, & + field_loc, field_type) + enddo + endif + elseif (ndim3 == 1 .and. ndims == 2) then + call pio_read_darray(File, vardesc, iodesc2d, work, status) #ifdef CESMCOUPLED - where (work == PIO_FILL_DOUBLE) work = c0 + where (work == PIO_FILL_DOUBLE) work = c0 #endif - if (present(field_loc)) then - call ice_HaloUpdate (work(:,:,1,:), halo_info, & - field_loc, field_type) - endif - else - write(nu_diag,*) "ndim3 not supported ",ndim3 + if (present(field_loc)) then + call ice_HaloUpdate (work(:,:,1,:), halo_info, & + field_loc, field_type) endif + else + write(nu_diag,*) "ndim3 not supported ",ndim3 + endif - call ice_pio_check(status, & - subname//" ERROR reading distributed array for "//trim(vname)) - - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - - if (diag) then - if (ndim3 > 1) then - do n=1,ndim3 - amin = global_minval(work(:,:,n,:),distrb_info) - amax = global_maxval(work(:,:,n,:),distrb_info) - asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) - endif - enddo - else - amin = global_minval(work(:,:,1,:),distrb_info) - amax = global_maxval(work(:,:,1,:),distrb_info) - asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + call ice_pio_check(status, & + subname//" ERROR reading var "//trim(vname),file=__FILE__,line=__LINE__) + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + + if (diag) then + if (ndim3 > 1) then + do n=1,ndim3 + amin = global_minval(work(:,:,n,:),distrb_info) + amax = global_maxval(work(:,:,n,:),distrb_info) + asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) if (my_task == master_task) then write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif + enddo + else + amin = global_minval(work(:,:,1,:),distrb_info) + amax = global_maxval(work(:,:,1,:),distrb_info) + asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + if (my_task == master_task) then + write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif - endif -! else -! call abort_ice(subname//" ERROR: Invalid restart_format: "//trim(restart_format)) -! endif ! restart_format + endif end subroutine read_restart_field @@ -819,29 +800,29 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) use ice_global_reductions, only: global_minval, global_maxval, global_sum integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname ! local variables integer (kind=int_kind) :: & - j, & ! dimension counter - n, & ! dimension counter - ndims, & ! number of variable dimensions - status ! status variable from netCDF routine + j , & ! dimension counter + n , & ! dimension counter + ndims , & ! number of variable dimensions + status ! status variable from netCDF routine real (kind=dbl_kind) :: amin,amax,asum @@ -849,53 +830,50 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) call pio_seterrorhandling(File, PIO_RETURN_ERROR) -! if (restart_format(1:3) == "pio") then - if (my_task == master_task) & - write(nu_diag,*)'Parallel restart file write: ',vname + if (my_task == master_task) then + write(nu_diag,*)'Parallel restart file write: ',vname + endif - call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & - subname// "ERROR reading "//trim(vname)) + call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & + subname// "ERROR missing varid "//trim(vname),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & - subname// "ERROR reading "//trim(vname)) + call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & + subname// "ERROR missing varndims "//trim(vname),file=__FILE__,line=__LINE__) - if (ndims==3) then - call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & - status, fillval=c0) - elseif (ndims == 2) then - call pio_write_darray(File, vardesc, iodesc2d, work(:,:,1,1:nblocks), & - status, fillval=c0) - else - write(nu_diag,*) "ndims not supported",ndims,ndim3 - endif - - call ice_pio_check(status, & - subname//" ERROR writing distributed array for "//trim(vname)) - - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - - if (diag) then - if (ndim3 > 1) then - do n=1,ndim3 - amin = global_minval(work(:,:,n,:),distrb_info) - amax = global_maxval(work(:,:,n,:),distrb_info) - asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) - endif - enddo - else - amin = global_minval(work(:,:,1,:),distrb_info) - amax = global_maxval(work(:,:,1,:),distrb_info) - asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + if (ndims==3) then + call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & + status, fillval=c0) + elseif (ndims == 2) then + call pio_write_darray(File, vardesc, iodesc2d, work(:,:,1,1:nblocks), & + status, fillval=c0) + else + write(nu_diag,*) "ndims not supported",ndims,ndim3 + endif + + call ice_pio_check(status, & + subname//" ERROR writing "//trim(vname),file=__FILE__,line=__LINE__) + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + + if (diag) then + if (ndim3 > 1) then + do n=1,ndim3 + amin = global_minval(work(:,:,n,:),distrb_info) + amax = global_maxval(work(:,:,n,:),distrb_info) + asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) if (my_task == master_task) then write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif + enddo + else + amin = global_minval(work(:,:,1,:),distrb_info) + amax = global_maxval(work(:,:,1,:),distrb_info) + asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + if (my_task == master_task) then + write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif endif -! else -! call abort_ice(subname//" ERROR: Invalid restart_format: "//trim(restart_format)) -! endif + endif end subroutine write_restart_field @@ -931,13 +909,10 @@ subroutine define_rest_field(File, vname, dims) character (len=*) , intent(in) :: vname integer (kind=int_kind), intent(in) :: dims(:) - integer (kind=int_kind) :: & - status ! status variable from netCDF routine - character(len=*), parameter :: subname = '(define_rest_field)' call ice_pio_check(pio_def_var(File,trim(vname),pio_double,dims,vardesc), & - subname//' ERROR defining restart field '//trim(vname)) + subname//' ERROR def_var '//trim(vname),file=__FILE__,line=__LINE__) end subroutine define_rest_field diff --git a/configuration/scripts/options/set_env.iopio1 b/configuration/scripts/options/set_env.iopio1 index 8357b4aac..1a92353ce 100644 --- a/configuration/scripts/options/set_env.iopio1 +++ b/configuration/scripts/options/set_env.iopio1 @@ -1 +1,2 @@ setenv ICE_IOTYPE pio1 +setenv ICE_CPPDEFS -DUSE_PIO1 diff --git a/configuration/scripts/options/set_env.iopio1p b/configuration/scripts/options/set_env.iopio1p index 8357b4aac..1a92353ce 100644 --- a/configuration/scripts/options/set_env.iopio1p +++ b/configuration/scripts/options/set_env.iopio1p @@ -1 +1,2 @@ setenv ICE_IOTYPE pio1 +setenv ICE_CPPDEFS -DUSE_PIO1 From 10da9286b335bab7625f10597702495123f9314a Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 15 Jan 2024 13:46:16 -0700 Subject: [PATCH 20/32] - Update some ERROR statements, reduce some line lengths - Refactor time reading in io_netcdf/ice_restart, now similar to pio implementation - Update github actions gx3 forcing dataset download to reduce size (same data) - Update documentation --- .github/workflows/test-cice.yml | 3 +- .../cicedyn/infrastructure/ice_blocks.F90 | 54 ++++++------- .../cicedyn/infrastructure/ice_domain.F90 | 40 +++++---- cicecore/cicedyn/infrastructure/ice_grid.F90 | 41 +++++----- .../cicedyn/infrastructure/ice_memusage.F90 | 3 +- .../cicedyn/infrastructure/ice_read_write.F90 | 22 ++--- .../cicedyn/infrastructure/ice_restoring.F90 | 2 +- .../io/io_binary/ice_restart.F90 | 24 +++--- .../io/io_netcdf/ice_history_write.F90 | 15 ++-- .../io/io_netcdf/ice_restart.F90 | 52 +++++++----- .../io/io_pio2/ice_history_write.F90 | 38 ++++++--- .../infrastructure/io/io_pio2/ice_pio.F90 | 14 ++-- .../infrastructure/io/io_pio2/ice_restart.F90 | 38 ++++----- doc/source/user_guide/ug_case_settings.rst | 21 ++--- doc/source/user_guide/ug_running.rst | 81 +++++++++++++++---- 15 files changed, 263 insertions(+), 185 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 160485d04..a91432971 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -147,7 +147,8 @@ jobs: run: | cd $HOME/cice-dirs/input wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz - wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz +# wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz pwd ls -alR # - name: run case diff --git a/cicecore/cicedyn/infrastructure/ice_blocks.F90 b/cicecore/cicedyn/infrastructure/ice_blocks.F90 index fb7483914..ccaf23999 100644 --- a/cicecore/cicedyn/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedyn/infrastructure/ice_blocks.F90 @@ -173,7 +173,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & do jblock=1,nblocks_y js = (jblock-1)*block_size_y + 1 if (js > ny_global) call abort_ice(subname// & - 'ERROR: Bad block decomp: ny_block too large?') + ' ERROR: Bad block decomp: ny_block too large?') je = js + block_size_y - 1 if (je > ny_global) je = ny_global ! pad array @@ -182,7 +182,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & is = (iblock-1)*block_size_x + 1 if (is > nx_global) call abort_ice(subname// & - 'ERROR: Bad block decomp: nx_block too large?') + ' ERROR: Bad block decomp: nx_block too large?') ie = is + block_size_x - 1 if (ie > nx_global) ie = nx_global @@ -223,7 +223,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('tripoleT') j_global(j,n) = -j_global(j,n) + 1 ! open case default - call abort_ice(subname//'ERROR: unknown n-s bndy type') + call abort_ice(subname//' ERROR: unknown n-s bndy type') end select endif @@ -247,7 +247,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('tripoleT') j_global(j,n) = -j_global(j,n) case default - call abort_ice(subname//'ERROR: unknown n-s bndy type') + call abort_ice(subname//' ERROR: unknown n-s bndy type') end select !*** set last physical point if padded domain @@ -275,7 +275,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('closed') i_global(i,n) = 0 case default - call abort_ice(subname//'ERROR: unknown e-w bndy type') + call abort_ice(subname//' ERROR: unknown e-w bndy type') end select endif @@ -295,7 +295,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('closed') i_global(i,n) = 0 case default - call abort_ice(subname//'ERROR: unknown e-w bndy type') + call abort_ice(subname//' ERROR: unknown e-w bndy type') end select !*** last physical point in padded domain @@ -427,7 +427,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & inbr = nblocks_x - iBlock + 1 jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -448,7 +448,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('tripoleT') jnbr = 0 ! do not write into the neighbor's ghost cells case default - call abort_ice(subname//'ERROR: unknown south boundary') + call abort_ice(subname//' ERROR: unknown south boundary') end select endif @@ -465,7 +465,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = 1 case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif @@ -482,7 +482,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif @@ -499,7 +499,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = 1 case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif if (jnbr > nblocks_y) then @@ -521,7 +521,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr == 0) inbr = nblocks_x jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -538,7 +538,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif if (jnbr > nblocks_y) then @@ -560,7 +560,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr > nblocks_x) inbr = 1 jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -577,7 +577,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = 1 case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif if (jnbr < 1) then @@ -593,7 +593,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('tripoleT') jnbr = 0 ! do not write into the neighbor's ghost cells case default - call abort_ice(subname//'ERROR: unknown south boundary') + call abort_ice(subname//' ERROR: unknown south boundary') end select endif @@ -609,7 +609,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif if (jnbr < 1) then @@ -625,7 +625,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('tripoleT') jnbr = 0 ! do not write into the neighbor's ghost cells case default - call abort_ice(subname//'ERROR: unknown south boundary') + call abort_ice(subname//' ERROR: unknown south boundary') end select endif @@ -642,7 +642,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = inbr - nblocks_x case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif @@ -658,7 +658,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x + inbr case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif @@ -675,7 +675,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = inbr - nblocks_x case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif if (jnbr > nblocks_y) then @@ -697,7 +697,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr <= 0) inbr = inbr + nblocks_x jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -714,7 +714,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x + inbr case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif if (jnbr > nblocks_y) then @@ -736,13 +736,13 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr > nblocks_x) inbr = inbr - nblocks_x jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif case default - call abort_ice(subname//'ERROR: unknown direction') + call abort_ice(subname//' ERROR: unknown direction') return end select @@ -789,7 +789,7 @@ function get_block(block_id,local_id) !---------------------------------------------------------------------- if (block_id < 1 .or. block_id > nblocks_tot) then - call abort_ice(subname//'ERROR: invalid block_id') + call abort_ice(subname//' ERROR: invalid block_id') endif get_block = all_blocks(block_id) @@ -834,7 +834,7 @@ subroutine get_block_parameter(block_id, local_id, & !---------------------------------------------------------------------- if (block_id < 1 .or. block_id > nblocks_tot) then - call abort_ice(subname//'ERROR: invalid block_id') + call abort_ice(subname//' ERROR: invalid block_id') endif if (present(local_id)) local_id = all_blocks(block_id)%local_id diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 12b7d93aa..8b680f2d4 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -176,13 +176,13 @@ subroutine init_domain_blocks call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: domain_nml open file '// & + call abort_ice(subname//' ERROR: domain_nml open file '// & trim(nml_filename), file=__FILE__, line=__LINE__) endif call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + call abort_ice(subname//' ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif @@ -194,7 +194,7 @@ subroutine init_domain_blocks ! backspace and re-read erroneous line backspace(nu_nml) read(nu_nml,fmt='(A)') tmpstr2 - call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + call abort_ice(subname//' ERROR: ' // trim(nml_name) // ' reading ' // & trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do @@ -241,7 +241,7 @@ subroutine init_domain_blocks !*** !*** domain size zero or negative !*** - call abort_ice(subname//'ERROR: Invalid domain: size < 1', file=__FILE__, line=__LINE__) ! no domain + call abort_ice(subname//' ERROR: Invalid domain: size < 1', file=__FILE__, line=__LINE__) ! no domain else if (nprocs /= get_num_procs()) then !*** !*** input nprocs does not match system (eg MPI) request @@ -249,14 +249,14 @@ subroutine init_domain_blocks #if (defined CESMCOUPLED) nprocs = get_num_procs() #else - write(nu_diag,*) subname,'ERROR: nprocs, get_num_procs = ',nprocs,get_num_procs() - call abort_ice(subname//'ERROR: Input nprocs not same as system request', file=__FILE__, line=__LINE__) + write(nu_diag,*) subname,' ERROR: nprocs, get_num_procs = ',nprocs,get_num_procs() + call abort_ice(subname//' ERROR: Input nprocs not same as system request', file=__FILE__, line=__LINE__) #endif else if (nghost < 1) then !*** !*** must have at least 1 layer of ghost cells !*** - call abort_ice(subname//'ERROR: Not enough ghost cells allocated', file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Not enough ghost cells allocated', file=__FILE__, line=__LINE__) endif !---------------------------------------------------------------------- @@ -384,7 +384,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) file=__FILE__, line=__LINE__) if (trim(ns_boundary_type) == 'closed') then - call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported', file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: ns_boundary_type = closed not supported', file=__FILE__, line=__LINE__) allocate(nocn(nblocks_tot)) nocn = 0 do n=1,nblocks_tot @@ -417,13 +417,14 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif if (nocn(n) > 0) then write(nu_diag,*) subname,'ns closed, Not enough land cells along ns edge' - call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed', file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Not enough land cells along ns edge for ns closed', & + file=__FILE__, line=__LINE__) endif enddo deallocate(nocn) endif if (trim(ew_boundary_type) == 'closed') then - call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported', file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: ew_boundary_type = closed not supported', file=__FILE__, line=__LINE__) allocate(nocn(nblocks_tot)) nocn = 0 do n=1,nblocks_tot @@ -456,7 +457,8 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif if (nocn(n) > 0) then write(nu_diag,*) subname,'ew closed, Not enough land cells along ew edge' - call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed', file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Not enough land cells along ew edge for ew closed', & + file=__FILE__, line=__LINE__) endif enddo deallocate(nocn) @@ -486,23 +488,27 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) #ifdef USE_NETCDF status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid) if (status /= nf90_noerr) then - call abort_ice(subname//'ERROR: Cannot open '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Cannot open '//trim(distribution_wght_file), & + file=__FILE__, line=__LINE__) endif status = nf90_inq_varid(fid, 'wght', varid) if (status /= nf90_noerr) then - call abort_ice(subname//'ERROR: Cannot find wght '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Cannot find wght '//trim(distribution_wght_file), & + file=__FILE__, line=__LINE__) endif status = nf90_get_var(fid, varid, wght) if (status /= nf90_noerr) then - call abort_ice(subname//'ERROR: Cannot get wght '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Cannot get wght '//trim(distribution_wght_file), & + file=__FILE__, line=__LINE__) endif status = nf90_close(fid) if (status /= nf90_noerr) then - call abort_ice(subname//'ERROR: Cannot close '//trim(distribution_wght_file), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: Cannot close '//trim(distribution_wght_file), & + file=__FILE__, line=__LINE__) endif write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif endif @@ -721,7 +727,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif if (nblocks_max > max_blocks) then - write(outstring,*) 'ERROR: num blocks exceed max: increase max to', nblocks_max + write(outstring,*) ' ERROR: num blocks exceed max: increase max to', nblocks_max call abort_ice(subname//trim(outstring), file=__FILE__, line=__LINE__) else if (nblocks_max < max_blocks) then write(outstring,*) 'WARNING: ice no. blocks too large: decrease max to', nblocks_max diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 815821c10..da4388d78 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -224,7 +224,7 @@ subroutine alloc_grid ocn_gridcell_frac(nx_block,ny_block,max_blocks),& ! only relevant for lat-lon grids hm (nx_block,ny_block,max_blocks), & ! land/boundary mask, thickness (T-cell) bm (nx_block,ny_block,max_blocks), & ! task/block id - uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) - water in case of all water point + uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) - all water point npm (nx_block,ny_block,max_blocks), & ! land/boundary mask (N-cell) epm (nx_block,ny_block,max_blocks), & ! land/boundary mask (E-cell) kmt (nx_block,ny_block,max_blocks), & ! ocean topography mask for bathymetry (T-cell) @@ -245,7 +245,7 @@ subroutine alloc_grid lone_bounds(4,nx_block,ny_block,max_blocks), & ! longitude of gridbox corners for E point late_bounds(4,nx_block,ny_block,max_blocks), & ! latitude of gridbox corners for E point stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1', file=__FILE__, line=__LINE__) + if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory1', file=__FILE__, line=__LINE__) if (save_ghte_ghtn) then if (my_task == master_task) then @@ -259,7 +259,7 @@ subroutine alloc_grid G_HTN(1,1), & ! never used in code stat=ierr) endif - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory3', file=__FILE__, line=__LINE__) + if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory3', file=__FILE__, line=__LINE__) endif end subroutine alloc_grid @@ -277,7 +277,7 @@ subroutine dealloc_grid if (save_ghte_ghtn) then deallocate(G_HTE, G_HTN, stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Dealloc error1', file=__FILE__, line=__LINE__) + if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error1', file=__FILE__, line=__LINE__) endif end subroutine dealloc_grid @@ -324,12 +324,12 @@ subroutine init_grid1 if (grid_type == 'tripole' .and. ns_boundary_type /= 'tripole' .and. & ns_boundary_type /= 'tripoleT') then - call abort_ice(subname//'ERROR: grid_type tripole needs tripole ns_boundary_type', & + call abort_ice(subname//' ERROR: grid_type tripole needs tripole ns_boundary_type', & file=__FILE__, line=__LINE__) endif if (grid_type == 'tripole' .and. (mod(nx_global,2)/=0)) then - call abort_ice(subname//'ERROR: grid_type tripole requires even nx_global number', & + call abort_ice(subname//' ERROR: grid_type tripole requires even nx_global number', & file=__FILE__, line=__LINE__) endif @@ -676,7 +676,7 @@ subroutine init_grid2 elseif (trim(bathymetry_format) == 'pop') then call get_bathymetry_popfile else - call abort_ice(subname//'ERROR: bathymetry_format value must be default or pop', & + call abort_ice(subname//' ERROR: bathymetry_format value must be default or pop', & file=__FILE__, line=__LINE__) endif @@ -991,7 +991,7 @@ subroutine popgrid_nc call ice_close_nc(fid_kmt) endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -1090,7 +1090,7 @@ subroutine latlongrid write(nu_diag,*) 'Because you have selected the column model flag' write(nu_diag,*) 'Please set nx_global=ny_global=1 in file' write(nu_diag,*) 'ice_domain_size.F and recompile' - call abort_ice (subname//'ERROR: check nx_global, ny_global', file=__FILE__, line=__LINE__) + call abort_ice (subname//' ERROR: check nx_global, ny_global', file=__FILE__, line=__LINE__) endif end if @@ -1162,7 +1162,8 @@ subroutine latlongrid if (nx_global /= ni .and. ny_global /= nj) then write(nu_diag,*) 'latlongrid: ni,nj = ',ni,nj write(nu_diag,*) 'latlongrid: nx_g,ny_g = ',nx_global, ny_global - call abort_ice (subname//'ERROR: ni,nj not equal to nx_global,ny_global', file=__FILE__, line=__LINE__) + call abort_ice (subname//' ERROR: ni,nj not equal to nx_global,ny_global', & + file=__FILE__, line=__LINE__) end if end if @@ -1271,7 +1272,7 @@ subroutine latlongrid call makemask #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -1454,7 +1455,7 @@ subroutine rectgrid else - call abort_ice(subname//'ERROR: unknown kmt_type '//trim(kmt_type), & + call abort_ice(subname//' ERROR: unknown kmt_type '//trim(kmt_type), & file=__FILE__, line=__LINE__) endif ! kmt_type @@ -1657,7 +1658,7 @@ subroutine grid_boxislands_kmt (work) nyb = int(real(ny_global, dbl_kind) / c20, int_kind) if (nxb < 1 .or. nyb < 1) & - call abort_ice(subname//'ERROR: requires larger grid size', & + call abort_ice(subname//' ERROR: requires larger grid size', & file=__FILE__, line=__LINE__) ! initialize work area as all ocean (c1). @@ -2723,7 +2724,7 @@ subroutine grid_average_X2Y_NEversion(type,work1a,grid1a,work1b,grid1b,work2,gri call grid_average_X2Y_2('NE2TA',work1b,narea,npm,work1a,earea,epm,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_NEversion @@ -2832,7 +2833,7 @@ subroutine grid_average_X2Y_1(X2Y,work1,work2) call grid_average_X2YA('SE',work1,narea,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_1 @@ -2944,7 +2945,7 @@ subroutine grid_average_X2Y_1f(X2Y,work1,wght1,mask1,work2) call grid_average_X2YA('SE',work1,wght1,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_1f @@ -3173,7 +3174,7 @@ subroutine grid_average_X2YS(dir,work1,wght1,mask1,work2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YS @@ -3401,7 +3402,7 @@ subroutine grid_average_X2YA(dir,work1,wght1,work2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YA @@ -3603,7 +3604,7 @@ subroutine grid_average_X2YF(dir,work1,wght1,work2,wght2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YF @@ -3748,7 +3749,7 @@ subroutine grid_average_X2Y_2(dir,work1a,wght1a,mask1a,work1b,wght1b,mask1b,work !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_2 diff --git a/cicecore/cicedyn/infrastructure/ice_memusage.F90 b/cicecore/cicedyn/infrastructure/ice_memusage.F90 index 8dca4e621..323a9074e 100644 --- a/cicecore/cicedyn/infrastructure/ice_memusage.F90 +++ b/cicecore/cicedyn/infrastructure/ice_memusage.F90 @@ -74,7 +74,8 @@ subroutine ice_memusage_init(iunit) write(iunit,'(A,l4)') subname//' Initset conversion flag is ',initset write(iunit,'(A,f16.2)') subname//' 8 MB memory alloc in MB is ',(mrss1-mrss0)*mb_blk write(iunit,'(A,f16.2)') subname//' 8 MB memory dealloc in MB is ',(mrss1-mrss2)*mb_blk - write(iunit,'(A,f16.2)') subname//' Memory block size conversion in bytes is ',mb_blk*1024_dbl_kind*1024.0_dbl_kind + write(iunit,'(A,f16.2)') subname//' Memory block size conversion in bytes is ', & + mb_blk*1024_dbl_kind*1024.0_dbl_kind endif end subroutine ice_memusage_init diff --git a/cicecore/cicedyn/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index 3d0e9dc25..f4c61e3cb 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -1197,7 +1197,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & call ice_check_nc(status, subname//' ERROR: inquire dimension size 3 '//trim(varname), & file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & file=__FILE__, line=__LINE__) endif @@ -1398,7 +1398,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & call ice_check_nc(status, subname//' ERROR: inquire dimension size 4 '//trim(varname), & file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & file=__FILE__, line=__LINE__) endif @@ -1610,7 +1610,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & call ice_check_nc(status, subname//' ERROR: inquire dimension size 4 '//trim(varname), & file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & file=__FILE__, line=__LINE__) endif @@ -1777,7 +1777,7 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & call ice_check_nc(status, subname//' ERROR: inquire dimension size 1 '//trim(varname), & file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & file=__FILE__, line=__LINE__) endif @@ -1895,7 +1895,7 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -1981,7 +1981,7 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -2069,7 +2069,7 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -2157,7 +2157,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & call ice_check_nc(status, subname//' ERROR: inquire dimension size 2 '//trim(varname), & file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & file=__FILE__, line=__LINE__) endif @@ -2589,13 +2589,13 @@ subroutine ice_check_nc(status, abort_msg, file, line) #ifdef USE_NETCDF if (status /= nf90_noerr) then if (present(file) .and. present(line)) then - call abort_ice(subname//trim(nf90_strerror(status))//':'//trim(abort_msg), & + call abort_ice(subname//trim(nf90_strerror(status))//', '//trim(abort_msg), & file=file, line=line) elseif (present(file)) then - call abort_ice(subname//trim(nf90_strerror(status))//':'//trim(abort_msg), & + call abort_ice(subname//trim(nf90_strerror(status))//', '//trim(abort_msg), & file=file) else - call abort_ice(subname//trim(nf90_strerror(status))//':'//trim(abort_msg)) + call abort_ice(subname//trim(nf90_strerror(status))//', '//trim(abort_msg)) endif endif #else diff --git a/cicecore/cicedyn/infrastructure/ice_restoring.F90 b/cicecore/cicedyn/infrastructure/ice_restoring.F90 index 221d066df..27328d9dd 100644 --- a/cicecore/cicedyn/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedyn/infrastructure/ice_restoring.F90 @@ -88,7 +88,7 @@ subroutine ice_HaloRestore_init if ((ew_boundary_type == 'open' .or. & ns_boundary_type == 'open') .and. .not.(restart_ext)) then - if (my_task == master_task) write (nu_diag,*) 'ERROR: restart_ext=F and open boundaries' + if (my_task == master_task) write (nu_diag,*) ' ERROR: restart_ext=F and open boundaries' call abort_ice(error_message=subname//'open boundary and restart_ext=F', & file=__FILE__, line=__LINE__) endif diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index cc158fccc..606f0d46b 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -128,7 +128,7 @@ subroutine init_restart_read(ice_ic) if (kdyn == 2) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: eap restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: eap restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -148,7 +148,7 @@ subroutine init_restart_read(ice_ic) if (tr_fsd) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: fsd restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: fsd restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -168,7 +168,7 @@ subroutine init_restart_read(ice_ic) if (tr_iage) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: iage restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: iage restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -188,7 +188,7 @@ subroutine init_restart_read(ice_ic) if (tr_FY) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: FY restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: FY restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -208,7 +208,7 @@ subroutine init_restart_read(ice_ic) if (tr_lvl) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: lvl restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: lvl restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -228,7 +228,7 @@ subroutine init_restart_read(ice_ic) if (tr_pond_lvl) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR:pond_lvl restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR:pond_lvl restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -248,7 +248,7 @@ subroutine init_restart_read(ice_ic) if (tr_pond_topo) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: pond_topo restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: pond_topo restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -268,7 +268,7 @@ subroutine init_restart_read(ice_ic) if (tr_snow) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: snow restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: snow restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -288,7 +288,7 @@ subroutine init_restart_read(ice_ic) if (tr_brine) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: brine restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: brine restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -308,7 +308,7 @@ subroutine init_restart_read(ice_ic) if (nbtrcr > 0) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: bgc restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: bgc restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -328,7 +328,7 @@ subroutine init_restart_read(ice_ic) if (tr_iso) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: iso restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: iso restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -348,7 +348,7 @@ subroutine init_restart_read(ice_ic) if (tr_aero) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: aero restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: aero restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index cba629a64..78eec1d75 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -177,19 +177,19 @@ subroutine ice_write_hist (ns) file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nkice',nzilyr,kmtidi) - call ice_check_nc(status, subname// ' ERROR: defining dim nki', & + call ice_check_nc(status, subname// ' ERROR: defining dim nkice', & file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nksnow',nzslyr,kmtids) - call ice_check_nc(status, subname// ' ERROR: defining dim nks', & + call ice_check_nc(status, subname// ' ERROR: defining dim nksnow', & file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nkbio',nzblyr,kmtidb) - call ice_check_nc(status, subname// ' ERROR: defining dim nkb', & + call ice_check_nc(status, subname// ' ERROR: defining dim nkbio', & file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nkaer',nzalyr,kmtida) - call ice_check_nc(status, subname// ' ERROR: defining dim nka', & + call ice_check_nc(status, subname// ' ERROR: defining dim nkaer', & file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid) @@ -197,7 +197,7 @@ subroutine ice_write_hist (ns) file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nvertices',nverts,nvertexid) - call ice_check_nc(status, subname// ' ERROR: defining dim nverts', & + call ice_check_nc(status, subname// ' ERROR: defining dim nvertices', & file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nf',nfsd_hist,fmtid) @@ -723,8 +723,7 @@ subroutine ice_write_hist (ns) endif title = 'CF-1.0' - status = & - nf90_put_att(ncid,nf90_global,'conventions',title) + status = nf90_put_att(ncid,nf90_global,'conventions',title) call ice_check_nc(status, subname// ' ERROR: in global attribute conventions', & file=__FILE__, line=__LINE__) @@ -748,7 +747,7 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- status = nf90_enddef(ncid) - call ice_check_nc(status, subname// ' ERROR in nf90_enddef', & + call ice_check_nc(status, subname// ' ERROR: in nf90_enddef', & file=__FILE__, line=__LINE__) !----------------------------------------------------------------- diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 994ef9665..c670bf016 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -55,7 +55,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status, status1 + integer (kind=int_kind) :: status character(len=*), parameter :: subname = '(init_restart_read)' @@ -80,24 +80,31 @@ subroutine init_restart_read(ice_ic) call ice_check_nc(status, subname//' ERROR: open '//trim(filename), file=__FILE__, line=__LINE__) if (use_restart_time) then - status1 = nf90_noerr + ! for backwards compatibility, check nyr, month, and sec as well status = nf90_get_att(ncid, nf90_global, 'istep1', istep0) - if (status /= nf90_noerr) status1 = status -! status = nf90_get_att(ncid, nf90_global, 'time', time) -! status = nf90_get_att(ncid, nf90_global, 'time_forc', time_forc) + call ice_check_nc(status, subname//" ERROR: reading restart step ",file=__FILE__,line=__LINE__) + status = nf90_get_att(ncid, nf90_global, 'myear', myear) - if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'nyr', myear) - if (status /= nf90_noerr) status1 = status + if (status /= nf90_noerr) then + status = nf90_get_att(ncid, nf90_global, 'nyr', myear) + call ice_check_nc(status, subname//" ERROR: reading restart year ",file=__FILE__,line=__LINE__) + endif + status = nf90_get_att(ncid, nf90_global, 'mmonth', mmonth) - if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'month', mmonth) - if (status /= nf90_noerr) status1 = status + if (status /= nf90_noerr) then + status = nf90_get_att(ncid, nf90_global, 'month', mmonth) + call ice_check_nc(status, subname//" ERROR: reading restart month ",file=__FILE__,line=__LINE__) + endif + status = nf90_get_att(ncid, nf90_global, 'mday', mday) - if (status /= nf90_noerr) status1 = status + call ice_check_nc(status, subname//" ERROR: reading restart day ",file=__FILE__,line=__LINE__) + status = nf90_get_att(ncid, nf90_global, 'msec', msec) - if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'sec', msec) - if (status /= nf90_noerr) status1 = status - if (status1 /= nf90_noerr) call abort_ice(subname// & - 'ERROR: reading restart time '//trim(filename), file=__FILE__, line=__LINE__) + if (status /= nf90_noerr) then + status = nf90_get_att(ncid, nf90_global, 'sec', msec) + call ice_check_nc(status, subname//" ERROR: reading restart sec ",file=__FILE__,line=__LINE__) + endif + endif ! use namelist values if use_restart_time = F endif @@ -115,7 +122,7 @@ subroutine init_restart_read(ice_ic) npt = npt - istep0 endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & file=__FILE__, line=__LINE__) #endif @@ -663,7 +670,7 @@ subroutine init_restart_write(filename_spec) endif ! master_task #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(filename_spec), & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(filename_spec), & file=__FILE__, line=__LINE__) #endif @@ -749,7 +756,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -819,7 +826,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -843,10 +850,11 @@ subroutine final_restart() ! ncid is only valid on master status = nf90_close(ncid) call ice_check_nc(status, subname//' ERROR: closing', file=__FILE__, line=__LINE__) - write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec + write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -874,7 +882,7 @@ subroutine define_rest_field(ncid, vname, dims) status = nf90_def_var(ncid,trim(vname),nf90_double,dims,varid) call ice_check_nc(status, subname//' ERROR: def var '//trim(vname), file=__FILE__, line=__LINE__) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -903,7 +911,7 @@ logical function query_field(nu,vname) endif call broadcast_scalar(query_field,master_task) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & file=__FILE__, line=__LINE__) #endif diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index 5c06f2a88..0260815b5 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -826,7 +826,8 @@ subroutine ice_write_hist (ns) workr2, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) enddo ! Extra dimensions (NCAT, NFSD, VGRD*) @@ -919,7 +920,8 @@ subroutine ice_write_hist (ns) workr2, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo @@ -978,7 +980,8 @@ subroutine ice_write_hist (ns) workr3v, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) enddo deallocate(workd3v) deallocate(workr3v) @@ -992,7 +995,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & - subname//' ERROR getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) workd2(:,:,:) = a2D(:,:,n,1:nblocks) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO @@ -1010,7 +1013,8 @@ subroutine ice_write_hist (ns) workr2, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_2D @@ -1046,7 +1050,8 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Dc deallocate(workd3) @@ -1081,7 +1086,8 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Dz deallocate(workd3) @@ -1116,7 +1122,8 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1151,7 +1158,8 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1186,7 +1194,8 @@ subroutine ice_write_hist (ns) workr3, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Df deallocate(workd3) @@ -1222,7 +1231,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4di,& workr4, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Di deallocate(workd4) @@ -1259,7 +1269,8 @@ subroutine ice_write_hist (ns) workr4, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Ds deallocate(workd4) @@ -1295,7 +1306,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4df,& workr4, status, fillval=spval) endif - call ice_pio_check(status,subname//' ERROR writing '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Df deallocate(workd4) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index 47ebf36d1..a62e77139 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -113,7 +113,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & rearranger, ice_pio_subsystem, base=basetask) - call pio_seterrorhandling(ice_pio_subsystem, PIO_BCAST_ERROR) + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) !--- initialize rearranger options !pio_rearr_opt_comm_type = integer (PIO_REARR_COMM_[P2P,COLL]) @@ -185,16 +185,16 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) inquire(file=trim(filename),exist=exists) if (exists) then if (my_task == master_task) then - write(nu_diag,*) subname,' opening file for reading' + write(nu_diag,*) subname//' opening file for reading '//trim(filename) endif status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite) call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename), & file=__FILE__,line=__LINE__) else if(my_task==master_task) then - write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename) + write(nu_diag,*) subname//' ERROR: file not found '//trim(filename) end if - call abort_ice(subname//'ERROR: aborting with invalid file') + call abort_ice(subname//' ERROR: aborting with invalid file '//trim(filename)) endif end if @@ -499,11 +499,11 @@ subroutine ice_pio_check(status, abort_msg, file, line) strerror_status = pio_strerror(status, err_msg) #endif if (present(file) .and. present(line)) then - call abort_ice(subname//trim(err_msg)//':'//trim(abort_msg), file=file, line=line) + call abort_ice(subname//trim(err_msg)//', '//trim(abort_msg), file=file, line=line) elseif (present(file)) then - call abort_ice(subname//trim(err_msg)//':'//trim(abort_msg), file=file) + call abort_ice(subname//trim(err_msg)//', '//trim(abort_msg), file=file) else - call abort_ice(subname//trim(err_msg)//':'//trim(abort_msg)) + call abort_ice(subname//trim(err_msg)//', '//trim(abort_msg)) endif endif end subroutine ice_pio_check diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index d4ee7eda5..e55acc434 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -116,7 +116,8 @@ subroutine init_restart_read(ice_ic) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) if (my_task == master_task) then - write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read at istep=',istep0,myear,'-',mmonth,'-',mday,'-',msec + write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + 'Restart read at istep=',istep0,myear,'-',mmonth,'-',mday,'-',msec endif call broadcast_scalar(istep0,master_task) @@ -230,22 +231,22 @@ subroutine init_restart_write(filename_spec) call pio_seterrorhandling(File, PIO_RETURN_ERROR) call ice_pio_check(pio_put_att(File,pio_global,'istep1',istep1), & - subname//' ERROR writing restart step',file=__FILE__,line=__LINE__) + subname//' ERROR: writing restart step',file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,pio_global,'myear',myear), & - subname//' ERROR writing restart year',file=__FILE__,line=__LINE__) + subname//' ERROR: writing restart year',file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,pio_global,'mmonth',mmonth), & - subname//' ERROR writing restart month',file=__FILE__,line=__LINE__) + subname//' ERROR: writing restart month',file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,pio_global,'mday',mday), & - subname//' ERROR writing restart day',file=__FILE__,line=__LINE__) + subname//' ERROR: writing restart day',file=__FILE__,line=__LINE__) call ice_pio_check(pio_put_att(File,pio_global,'msec',msec), & - subname//' ERROR writing restart sec',file=__FILE__,line=__LINE__) + subname//' ERROR: writing restart sec',file=__FILE__,line=__LINE__) call ice_pio_check(pio_def_dim(File,'ni',nx_global,dimid_ni), & - subname//' ERROR defining restart dim ni',file=__FILE__,line=__LINE__) + subname//' ERROR: defining restart dim ni',file=__FILE__,line=__LINE__) call ice_pio_check(pio_def_dim(File,'nj',ny_global,dimid_nj), & - subname//' ERROR defining restart dim nj',file=__FILE__,line=__LINE__) + subname//' ERROR: defining restart dim nj',file=__FILE__,line=__LINE__) call ice_pio_check(pio_def_dim(File,'ncat',ncat,dimid_ncat), & - subname//' ERROR defining restart dim ncat',file=__FILE__,line=__LINE__) + subname//' ERROR: defining restart dim ncat',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! 2D restart fields @@ -662,7 +663,7 @@ subroutine init_restart_write(filename_spec) endif !z_tracers deallocate(dims) - call ice_pio_check(pio_enddef(File), subname//' ERROR enddef',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_enddef(File), subname//' ERROR: enddef',file=__FILE__,line=__LINE__) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) @@ -730,10 +731,10 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & endif call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & - subname// "ERROR: missing varid "//trim(vname),file=__FILE__,line=__LINE__) + subname// " ERROR: missing varid "//trim(vname),file=__FILE__,line=__LINE__) call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & - subname// "ERROR missing varndims "//trim(vname),file=__FILE__,line=__LINE__) + subname// " ERROR: missing varndims "//trim(vname),file=__FILE__,line=__LINE__) if (ndim3 == ncat .and. ndims == 3) then call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) @@ -760,7 +761,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & endif call ice_pio_check(status, & - subname//" ERROR reading var "//trim(vname),file=__FILE__,line=__LINE__) + subname//" ERROR: reading var "//trim(vname),file=__FILE__,line=__LINE__) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) @@ -835,10 +836,10 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) endif call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & - subname// "ERROR missing varid "//trim(vname),file=__FILE__,line=__LINE__) + subname// " ERROR: missing varid "//trim(vname),file=__FILE__,line=__LINE__) call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & - subname// "ERROR missing varndims "//trim(vname),file=__FILE__,line=__LINE__) + subname// " ERROR: missing varndims "//trim(vname),file=__FILE__,line=__LINE__) if (ndims==3) then call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & @@ -851,7 +852,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) endif call ice_pio_check(status, & - subname//" ERROR writing "//trim(vname),file=__FILE__,line=__LINE__) + subname//" ERROR: writing "//trim(vname),file=__FILE__,line=__LINE__) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) @@ -893,7 +894,8 @@ subroutine final_restart() call pio_closefile(File) if (my_task == master_task) then - write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec + write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec endif end subroutine final_restart @@ -912,7 +914,7 @@ subroutine define_rest_field(File, vname, dims) character(len=*), parameter :: subname = '(define_rest_field)' call ice_pio_check(pio_def_var(File,trim(vname),pio_double,dims,vardesc), & - subname//' ERROR def_var '//trim(vname),file=__FILE__,line=__LINE__) + subname//' ERROR: def_var '//trim(vname),file=__FILE__,line=__LINE__) end subroutine define_rest_field diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index fd808fd8f..7ba3f35ad 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -37,7 +37,8 @@ can be found in :ref:`cicecpps`. The following CPPs are available. "NO_I8", "Converts integer*8 to integer*4. This could have adverse affects for certain algorithms including the ddpdd implementation associated with the ``bfbflag``" "NO_R16", "Converts real*16 to real*8. This could have adverse affects for certain algorithms including the lsum16 implementation associated with the ``bfbflag``" "NO_SNICARHC", "Does not compile hardcoded (HC) 5 band snicar tables tables needed by ``shortwave=dEdd_snicar_ad``. May reduce compile time." - "USE_NETCDF", "Turns on netcdf code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported" + "USE_NETCDF", "Turns on netCDF code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported." + "USE_PIO1", "Modifies pio code to be compatible with PIO1. By default, code is compatible with PIO2" "","" "**Application Macros**", "" "CESMCOUPLED", "Turns on code changes for the CESM coupled application " @@ -80,10 +81,10 @@ can be modified as needed. "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" "ICE_DRVOPT", "string", "unused", "standalone/cice" "ICE_TARGET", "string", "build target", "set by cice.setup" - "ICE_IOTYPE", "string", "I/O format", "set by cice.setup" - " ", "netcdf", "serial netCDF" - " ", "none", "netCDF library is not available" - " ", "pio", "parallel netCDF" + "ICE_IOTYPE", "string", "I/O source code", "set by cice.setup" + " ", "binary", "uses io_binary directory, no support for netCDF files" + " ", "netcdf", "uses io_netCDF directory, supports netCDF files" + " ", "pio", "uses io_pio directory, supports netCDF and parallel netCDF thru PIO interfaces" "ICE_CLEANBUILD", "true, false", "automatically clean before building", "true" "ICE_CPPDEFS", "user defined preprocessor macros for build", "null" "ICE_QUIETMODE", "true, false", "reduce build output to the screen", "false" @@ -208,7 +209,7 @@ setup_nml "``incond_file``", "string", "output file prefix for initial condition", "‘iceh_ic’" "``istep0``", "integer", "initial time step number", "0" "``latpnt``", "real", "latitude of (2) diagnostic points", "90.0,-65.0" - "``lcdf64``", "logical", "use 64-bit netcdf format", "``.false.``" + "``lcdf64``", "logical", "use 64-bit netCDF format", "``.false.``" "``lonpnt``", "real", "longitude of (2) diagnostic points", "0.0,-45.0" "``memory_stats``", "logical", "turns on memory use diagnostics", "``.false.``" "``month_init``", "integer", "the initial month if not using restart", "1" @@ -616,7 +617,7 @@ forcing_nml "", "``nc``", "read netcdf atmo forcing files", "" "``atm_data_type``", "``box2001``", "forcing data for :cite:`Hunke01` box problem", "``default``" "", "``default``", "constant values defined in the code", "" - "", "``hycom``", "HYCOM atm forcing data in netcdf format", "" + "", "``hycom``", "HYCOM atm forcing data in netCDF format", "" "", "``JRA55``", "JRA55 forcing data :cite:`Tsujino18`", "" "", "``JRA55do``", "JRA55do forcing data :cite:`Tsujino18`", "" "", "``monthly``", "monthly forcing data", "" @@ -626,7 +627,7 @@ forcing_nml "``bgc_data_dir``", "string", "path to oceanic forcing data directory", "'unknown_bgc_data_dir'" "``bgc_data_type``", "``clim``", "bgc climatological data", "``default``" "", "``default``", "constant values defined in the code", "" - "", "``hycom``", "HYCOM ocean forcing data in netcdf format", "" + "", "``hycom``", "HYCOM ocean forcing data in netCDF format", "" "", "``ncar``", "POP ocean forcing data", "" "``calc_strair``", "``.false.``", "read wind stress and speed from files", "``.true.``" "", "``.true.``", "calculate wind stress and speed", "" @@ -673,10 +674,10 @@ forcing_nml "``oceanmixed_ice``", "logical", "active ocean mixed layer calculation", "``.false.``" "``ocn_data_dir``", "string", "path to oceanic forcing data directory", "'unknown_ocn_data_dir'" "``ocn_data_format``", "``bin``", "read direct access binary ocean forcing files", "``bin``" - "", "``nc``", "read netcdf ocean forcing files", "" + "", "``nc``", "read netCDF ocean forcing files", "" "``ocn_data_type``", "``clim``", "ocean climatological data formulation", "``default``" "", "``default``", "constant values defined in the code", "" - "", "``hycom``", "HYCOM ocean forcing data in netcdf format", "" + "", "``hycom``", "HYCOM ocean forcing data in netCDF format", "" "", "``ncar``", "POP ocean forcing data", "" "``precip_units``", "``mks``", "liquid precipitation data units", "``mks``" "", "``mm_per_month``", "", "" diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 3f3cd3495..065682d13 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -16,42 +16,61 @@ To run stand-alone, CICE requires - bash and csh - gmake (GNU Make) -- Fortran and C compilers (Intel, PGI, GNU, Cray, and NAG have been tested) -- NetCDF (this is actually optional but required to test out of the box configurations) -- MPI (this is actually optional but without it you can only run on 1 processor) +- Fortran and C compilers (Intel, PGI, GNU, Cray, NVHPC, AOCC, and NAG have been tested) +- NetCDF (optional, but required to test standard configurations that have netcdf grid, input, and forcing files) +- MPI (optional, but required for running on more than 1 processor) +- PIO (optional, but required for running with PIO I/O interfaces) Below are lists of software versions that the Consortium has tested at some point. There is no guarantee that all compiler versions work with all CICE model versions. At any given point, the Consortium is regularly testing on several different compilers, but not -necessarily on all possible versions or combinations. A CICE goal is to be relatively portable +necessarily on all possible versions or combinations. CICE supports both PIO1 and PIO2. To +use PIO1, the cpp USE_PIO1 should also be set. A CICE goal is to be relatively portable across different hardware, compilers, and other software. As a result, the coding implementation tends to be on the conservative side at times. If there are problems porting to a particular system, please let the Consortium know. The Consortium has tested the following compilers at some point, -- Intel 15.0.3.187 -- Intel 16.0.1.150 -- Intel 17.0.1.132 -- Intel 17.0.2.174 -- Intel 17.0.5.239 -- Intel 18.0.1.163 -- Intel 18.0.5 -- Intel 19.0.2 -- Intel 19.0.3.199 -- Intel 19.1.0.166 -- Intel 19.1.1.217 +- AOCC 3.0.0 +- Intel ifort 15.0.3.187 +- Intel ifort 16.0.1.150 +- Intel ifort 17.0.1.132 +- Intel ifort 17.0.2.174 +- Intel ifort 17.0.5.239 +- Intel ifort 18.0.1.163 +- Intel ifort 18.0.5 +- Intel ifort 19.0.2 +- Intel ifort 19.0.3.199 +- Intel ifort 19.1.0.166 +- Intel ifort 19.1.1.217 +- Intel ifort 19.1.2.254 +- Intel ifort 2021.4.0 +- Intel ifort 2021.6.0 +- Intel ifort 2021.8.0 +- Intel ifort 2021.9.0 +- Intel ifort 2022.2.1 - PGI 16.10.0 - PGI 19.9-0 - PGI 20.1-0 +- PGI 20.4-0 - GNU 6.3.0 - GNU 7.2.0 - GNU 7.3.0 +- GNU 7.7.0 - GNU 8.3.0 - GNU 9.3.0 -- Cray 8.5.8 -- Cray 8.6.4 +- GNU 10.1.0 +- GNU 11.2.0 +- GNU 12.1.0 +- GNU 12.2.0 +- Cray CCE 8.5.8 +- Cray CCE 8.6.4 +- Cray CCE 13.0.2 +- Cray CCE 14.0.3 +- Cray CCE 15.0.1 - NAG 6.2 +- NVC 23.5-0 The Consortium has tested the following mpi versions, @@ -59,16 +78,26 @@ The Consortium has tested the following mpi versions, - MPICH 7.5.3 - MPICH 7.6.2 - MPICH 7.6.3 +- MPICH 7.7.0 - MPICH 7.7.6 +- MPICH 7.7.7 +- MPICH 7.7.19 +- MPICH 7.7.20 +- MPICH 8.1.14 +- MPICH 8.1.21 +- MPICH 8.1.25 - Intel MPI 18.0.1 - Intel MPI 18.0.4 - Intel MPI 2019 Update 6 +- Intel MPI 2019 Update 8 - MPT 2.14 - MPT 2.17 - MPT 2.18 - MPT 2.19 - MPT 2.20 - MPT 2.21 +- MPT 2.22 +- MPT 2.25 - mvapich2-2.3.3 - OpenMPI 1.6.5 - OpenMPI 4.0.2 @@ -79,6 +108,7 @@ The NetCDF implementation is relatively general and should work with any version - NetCDF 4.3.2 - NetCDF 4.4.0 - NetCDF 4.4.1.1.3 +- NetCDF 4.4.1.1.6 - NetCDF 4.4.1.1 - NetCDF 4.4.2 - NetCDF 4.5.0 @@ -88,6 +118,23 @@ The NetCDF implementation is relatively general and should work with any version - NetCDF 4.6.3.2 - NetCDF 4.7.2 - NetCDF 4.7.4 +- NetCDF 4.8.1 +- NetCDF 4.8.1.1 +- NetCDF 4.8.1.3 +- NetCDF 4.9.0.1 +- NetCDF 4.9.0.3 +- NetCDF 4.9.2 + +CICE has been tested with + +- PIO 1.10.1 +- PIO 2.5.4 +- PIO 2.5.9 +- PIO 2.6.0 +- PIO 2.6.1 +- PnetCDF 2.6.2 +- PnetCDF 1.12.2 +- PnetCDF 1.12.3 Please email the Consortium if this list can be extended. From e1b071aafb895822b81fdb817c74b21507ab545d Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 15 Jan 2024 14:03:51 -0700 Subject: [PATCH 21/32] Update git workflow script --- .github/workflows/test-cice.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index a91432971..16beefd59 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -147,8 +147,8 @@ jobs: run: | cd $HOME/cice-dirs/input wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz -# wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz - wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz +# wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz pwd ls -alR # - name: run case From 85e09a7441383743316613ec294eb82ee13910f5 Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 15 Jan 2024 14:05:33 -0700 Subject: [PATCH 22/32] Update git workflow script --- .github/workflows/test-cice.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 16beefd59..160485d04 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -148,7 +148,6 @@ jobs: cd $HOME/cice-dirs/input wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz -# wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz pwd ls -alR # - name: run case From 22a9aa5a4ab372fb7673979783053e68983a2bfb Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 15 Jan 2024 14:07:23 -0700 Subject: [PATCH 23/32] Update git workflow script --- .github/workflows/test-cice.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 160485d04..b37328f9c 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -147,7 +147,7 @@ jobs: run: | cd $HOME/cice-dirs/input wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz - wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz pwd ls -alR # - name: run case From ac9afc382c52c507c4076467c87feecc1660d32a Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 15 Jan 2024 14:28:58 -0700 Subject: [PATCH 24/32] Update git workflow script --- .github/workflows/test-cice.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index b37328f9c..e7e41de11 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -149,6 +149,9 @@ jobs: wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz pwd + cd CICE_data/forcing/gx3/JRA55/8XDAILY + ln -s JRA55_gx3_03hr_forcing_200501.nc JRA55_gx3_03hr_forcing_2005.nc + cd $HOME/cice-dirs/input ls -alR # - name: run case # run: | From b8779d901e97a116d351e8f52700224f7226bad6 Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 15 Jan 2024 15:36:02 -0700 Subject: [PATCH 25/32] update conda_macos for compilation with parallelio --- configuration/scripts/machines/Macros.conda_macos | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index ee43dd771..6f26da0fc 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -52,7 +52,7 @@ else endif # Libraries to be passed to the linker -SLIBS := -L$(CONDA_PREFIX)/lib -lpiof -lnetcdf -lnetcdff -llapack -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh -lmpi +SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh -lmpi # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) @@ -61,3 +61,7 @@ ifeq ($(ICE_THREADED), true) FFLAGS += -fopenmp endif +ifeq ($(ICE_IOTYPE), pio2) + SLIBS := $(SLIBS) -lpiof -lpioc +endif + From fa2d619dab067c09ef3540bd6e2beb13035d9cfd Mon Sep 17 00:00:00 2001 From: Anton Steketee Date: Tue, 16 Jan 2024 11:35:03 +1100 Subject: [PATCH 26/32] error messages cleanup --- cicecore/cicedyn/general/ice_forcing.F90 | 16 ++++----- cicecore/cicedyn/infrastructure/ice_grid.F90 | 36 ++++++++++---------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 05899d646..b977f54aa 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -3701,15 +3701,15 @@ subroutine ocn_data_ncar_init ! status = nf90_inq_dimid(fid,'nlon',dimid) status = nf90_inq_dimid(fid,'ni',dimid) - call ice_check_nc(status, subname//'ERROR: inq dimid ni', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlon) - call ice_check_nc(status, subname//'ERROR: inq dim ni', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dim ni', file=__FILE__, line=__LINE__) ! status = nf90_inq_dimid(fid,'nlat',dimid) status = nf90_inq_dimid(fid,'nj',dimid) - call ice_check_nc(status, subname//'ERROR: inq dimid nj', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlat) - call ice_check_nc(status, subname//'ERROR: inq dim nj', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dim nj', file=__FILE__, line=__LINE__) if( nlon .ne. nx_global ) then call abort_ice (error_message=subname//'ice: ocn frc file nlon ne nx_global', & @@ -3866,15 +3866,15 @@ subroutine ocn_data_ncar_init_3D ! status = nf90_inq_dimid(fid,'nlon',dimid) status = nf90_inq_dimid(fid,'ni',dimid) - call ice_check_nc(status, subname//'ERROR: inq dimid ni', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlon) - call ice_check_nc(status, subname//'ERROR: inq dim ni', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dim ni', file=__FILE__, line=__LINE__) ! status = nf90_inq_dimid(fid,'nlat',dimid) status = nf90_inq_dimid(fid,'nj',dimid) - call ice_check_nc(status, subname//'ERROR: inq dimid nj', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(fid,dimid,len=nlat) - call ice_check_nc(status, subname//'ERROR: inq dim nj', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dim nj', file=__FILE__, line=__LINE__) if( nlon .ne. nx_global ) then call abort_ice (error_message=subname//'ice: ocn frc file nlon ne nx_global', & diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index da4388d78..8f3392215 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -1071,13 +1071,13 @@ subroutine latlongrid call ice_open_nc(kmt_file, ncid) status = nf90_inq_dimid (ncid, 'ni', dimid) - call ice_check_nc(status, subname//' inq_dimid ni', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(ncid, dimid, len=ni) - call ice_check_nc(status, subname//' inq dim ni', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dim ni', file=__FILE__, line=__LINE__) status = nf90_inq_dimid (ncid, 'nj', dimid) - call ice_check_nc(status, subname//' inq_dimid nj', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(ncid, dimid, len=nj) - call ice_check_nc(status, subname//' inq dim nj', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq dim nj', file=__FILE__, line=__LINE__) end if ! Determine start/count to read in for either single column or global lat-lon grid @@ -1103,17 +1103,17 @@ subroutine latlongrid start3=(/1,1,1/) count3=(/ni,nj,1/) status = nf90_inq_varid(ncid, 'xc' , varid) - call ice_check_nc(status, subname//' inq_varid xc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid xc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - call ice_check_nc(status, subname//' get_var xc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var xc', file=__FILE__, line=__LINE__) do i = 1,ni lons(i) = glob_grid(i,1) end do status = nf90_inq_varid(ncid, 'yc' , varid) - call ice_check_nc(status, subname//' inq_varid yc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid yc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - call ice_check_nc(status, subname//' get_var yc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var yc', file=__FILE__, line=__LINE__) do j = 1,nj lats(j) = glob_grid(1,j) end do @@ -1132,29 +1132,29 @@ subroutine latlongrid deallocate(glob_grid) status = nf90_inq_varid(ncid, 'xc' , varid) - call ice_check_nc(status, subname//' inq_varid xc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid xc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - call ice_check_nc(status, subname//' get_var xc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var xc', file=__FILE__, line=__LINE__) TLON = scamdata status = nf90_inq_varid(ncid, 'yc' , varid) - call ice_check_nc(status, subname//' inq_varid yc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid yc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - call ice_check_nc(status, subname//' get_var yc', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var yc', file=__FILE__, line=__LINE__) TLAT = scamdata status = nf90_inq_varid(ncid, 'area' , varid) - call ice_check_nc(status, subname//' inq_varid area', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid area', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - call ice_check_nc(status, subname//' get_var are', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var are', file=__FILE__, line=__LINE__) tarea = scamdata status = nf90_inq_varid(ncid, 'mask' , varid) - call ice_check_nc(status, subname//' inq_varid mask', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid mask', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - call ice_check_nc(status, subname//' get_var mask', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var mask', file=__FILE__, line=__LINE__) hm = scamdata status = nf90_inq_varid(ncid, 'frac' , varid) - call ice_check_nc(status, subname//' inq_varid frac', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: inq_varid frac', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - call ice_check_nc(status, subname//' get_var frac', file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: get_var frac', file=__FILE__, line=__LINE__) ocn_gridcell_frac = scamdata else ! Check for consistency From a39b8812a20d35eed1c88d8fea64cb3b567b1a60 Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 16 Jan 2024 11:22:51 -0700 Subject: [PATCH 27/32] Update error messages --- .../io/io_netcdf/ice_history_write.F90 | 12 ++++++------ .../io/io_pio2/ice_history_write.F90 | 14 +++++++------- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 3 ++- 3 files changed, 15 insertions(+), 14 deletions(-) diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index 78eec1d75..a0e0ad3c2 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -226,15 +226,15 @@ subroutine ice_write_hist (ns) if (days_per_year == 360) then status = nf90_put_att(ncid,varid,'calendar','360_day') - call ice_check_nc(status, subname// ' ERROR: time calendar', & + call ice_check_nc(status, subname// ' ERROR: time calendar 360', & file=__FILE__, line=__LINE__) elseif (days_per_year == 365 .and. .not.use_leap_years ) then status = nf90_put_att(ncid,varid,'calendar','noleap') - call ice_check_nc(status, subname// ' ERROR: time calendar', & + call ice_check_nc(status, subname// ' ERROR: time calendar noleap', & file=__FILE__, line=__LINE__) elseif (use_leap_years) then status = nf90_put_att(ncid,varid,'calendar','Gregorian') - call ice_check_nc(status, subname// ' ERROR: time calendar', & + call ice_check_nc(status, subname// ' ERROR: time calendar Gregorian', & file=__FILE__, line=__LINE__) else call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) @@ -268,15 +268,15 @@ subroutine ice_write_hist (ns) file=__FILE__, line=__LINE__) if (days_per_year == 360) then status = nf90_put_att(ncid,varid,'calendar','360_day') - call ice_check_nc(status, subname// ' ERROR: time calendar1', & + call ice_check_nc(status, subname// ' ERROR: time calendar 360 time bounds', & file=__FILE__, line=__LINE__) elseif (days_per_year == 365 .and. .not.use_leap_years ) then status = nf90_put_att(ncid,varid,'calendar','noleap') - call ice_check_nc(status, subname// ' ERROR: time calendar2', & + call ice_check_nc(status, subname// ' ERROR: time calendar noleap time bounds', & file=__FILE__, line=__LINE__) elseif (use_leap_years) then status = nf90_put_att(ncid,varid,'calendar','Gregorian') - call ice_check_nc(status, subname// ' ERROR: time calendar3', & + call ice_check_nc(status, subname// ' ERROR: time calendar Gregorian time bounds', & file=__FILE__, line=__LINE__) else call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index 0260815b5..4eb5379a4 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -223,7 +223,7 @@ subroutine ice_write_hist (ns) subname//' ERROR: defining dim time',file=__FILE__,line=__LINE__) call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & - subname//' ERROR: defining dim nverticies',file=__FILE__,line=__LINE__) + subname//' ERROR: defining dim nvertices',file=__FILE__,line=__LINE__) call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & subname//' ERROR: defining dim nf',file=__FILE__,line=__LINE__) @@ -246,13 +246,13 @@ subroutine ice_write_hist (ns) if (days_per_year == 360) then call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//' ERROR: defining att calendar1',file=__FILE__,line=__LINE__) + subname//' ERROR: defining att calendar 360',file=__FILE__,line=__LINE__) elseif (days_per_year == 365 .and. .not.use_leap_years ) then call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//' ERROR: defining att calendar2',file=__FILE__,line=__LINE__) + subname//' ERROR: defining att calendar noleap',file=__FILE__,line=__LINE__) elseif (use_leap_years) then call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//' ERROR: defining att calendar3',file=__FILE__,line=__LINE__) + subname//' ERROR: defining att calendar Gregorian',file=__FILE__,line=__LINE__) else call abort_ice(subname//' ERROR: invalid calendar settings') endif @@ -273,13 +273,13 @@ subroutine ice_write_hist (ns) if (days_per_year == 360) then call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//' ERROR: defining att calendar1 tb',file=__FILE__,line=__LINE__) + subname//' ERROR: defining att calendar 360 time bounds',file=__FILE__,line=__LINE__) elseif (days_per_year == 365 .and. .not.use_leap_years ) then call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//' ERROR: defining att calendar2 tb',file=__FILE__,line=__LINE__) + subname//' ERROR: defining att calendar noleap time bounds',file=__FILE__,line=__LINE__) elseif (use_leap_years) then call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//' ERROR: defining att calendar3 tb',file=__FILE__,line=__LINE__) + subname//' ERROR: defining att calendar Gregorian time bounds',file=__FILE__,line=__LINE__) else call abort_ice(subname//' ERROR: invalid calendar settings') endif diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 9493add51..a3db97fa1 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -437,8 +437,9 @@ subroutine ice_mesh_init_tlon_tlat_area_hm() use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT, HTN, HTE, ANGLE, ANGLET use ice_grid , only : uarea, uarear, tarear!, tinyarea - use ice_grid , only : dxT, dyT, dxU, dyU, dyhx, dxhy, cyp, cxp, cym, cxm + use ice_grid , only : dxT, dyT, dxU, dyU use ice_grid , only : makemask + use ice_dyn_shared, only : dyhx, dxhy, cyp, cxp, cym, cxm use ice_boundary , only : ice_HaloUpdate use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info use ice_constants , only : c0, c1, p25 From 5268d5cd51d7f923be286cab6256d2ce7dde9e6b Mon Sep 17 00:00:00 2001 From: anton-climate Date: Wed, 17 Jan 2024 10:36:29 +1100 Subject: [PATCH 28/32] typo in ice_pio --- cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index a62e77139..8b02fb75e 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -76,7 +76,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) ice_pio_subsystem => shr_pio_getiosys(inst_name) pio_iotype = shr_pio_getiotype(inst_name) - pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) #else #ifdef GPTL From a4a493044aae6330e581d6bd2465c80485504756 Mon Sep 17 00:00:00 2001 From: apcraig Date: Thu, 18 Jan 2024 09:34:34 -0700 Subject: [PATCH 29/32] update uvm comment --- cicecore/cicedyn/infrastructure/ice_grid.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 8f3392215..c43b7989c 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -224,7 +224,7 @@ subroutine alloc_grid ocn_gridcell_frac(nx_block,ny_block,max_blocks),& ! only relevant for lat-lon grids hm (nx_block,ny_block,max_blocks), & ! land/boundary mask, thickness (T-cell) bm (nx_block,ny_block,max_blocks), & ! task/block id - uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) - all water point + uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) npm (nx_block,ny_block,max_blocks), & ! land/boundary mask (N-cell) epm (nx_block,ny_block,max_blocks), & ! land/boundary mask (E-cell) kmt (nx_block,ny_block,max_blocks), & ! ocean topography mask for bathymetry (T-cell) From 9c4038c9623364027dcf024cc51e381601271602 Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 19 Jan 2024 12:10:32 -0700 Subject: [PATCH 30/32] Updates based on reviews --- cicecore/cicedyn/infrastructure/ice_read_write.F90 | 6 +++--- .../cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 | 2 -- doc/source/user_guide/ug_running.rst | 6 +++--- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/cicecore/cicedyn/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index f4c61e3cb..ad50b38f2 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -1237,7 +1237,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo ! optional - missingvalue = 1.234e30 + missingvalue = spval_dbl status = nf90_get_att(fid, varid, "_FillValue", missingvalue) ! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & ! file=__FILE__, line=__LINE__) @@ -1438,7 +1438,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo ! optional - missingvalue = 1.234e30 + missingvalue = spval_dbl status = nf90_get_att(fid, varid, "_FillValue", missingvalue) ! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & ! file=__FILE__, line=__LINE__) @@ -1650,7 +1650,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen enddo ! optional - missingvalue = 1.234e30 + missingvalue = spval_dbl status = nf90_get_att(fid, varid, "_FillValue", missingvalue) ! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & ! file=__FILE__, line=__LINE__) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index 4eb5379a4..bb4ef0ea1 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -1348,7 +1348,6 @@ end subroutine ice_write_hist subroutine ice_write_hist_attrs(File, varid, hfield, ns) - use ice_kinds_mod use ice_calendar, only: histfreq, histfreq_n, write_ic use ice_history_shared, only: ice_hist_field, history_precision, & hist_avg @@ -1425,7 +1424,6 @@ end subroutine ice_write_hist_attrs subroutine ice_write_hist_fill(File,varid,vname,precision) - ! use ice_kinds_mod, only: int_kind use ice_pio, only: ice_pio_check use pio, only: pio_put_att, file_desc_t, var_desc_t diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 065682d13..4576b8861 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -17,7 +17,7 @@ To run stand-alone, CICE requires - bash and csh - gmake (GNU Make) - Fortran and C compilers (Intel, PGI, GNU, Cray, NVHPC, AOCC, and NAG have been tested) -- NetCDF (optional, but required to test standard configurations that have netcdf grid, input, and forcing files) +- NetCDF (optional, but required to test standard configurations that have netCDF grid, input, and forcing files) - MPI (optional, but required for running on more than 1 processor) - PIO (optional, but required for running with PIO I/O interfaces) @@ -25,7 +25,7 @@ Below are lists of software versions that the Consortium has tested at some poin guarantee that all compiler versions work with all CICE model versions. At any given point, the Consortium is regularly testing on several different compilers, but not necessarily on all possible versions or combinations. CICE supports both PIO1 and PIO2. To -use PIO1, the cpp USE_PIO1 should also be set. A CICE goal is to be relatively portable +use PIO1, the ``USE_PIO1`` macro should also be set. A CICE goal is to be relatively portable across different hardware, compilers, and other software. As a result, the coding implementation tends to be on the conservative side at times. If there are problems porting to a particular system, please let the Consortium know. @@ -72,7 +72,7 @@ The Consortium has tested the following compilers at some point, - NAG 6.2 - NVC 23.5-0 -The Consortium has tested the following mpi versions, +The Consortium has tested the following MPI implementations and versions, - MPICH 7.3.2 - MPICH 7.5.3 From 75e9b811e1f5cc963bda7bd5d1b687b06f2213e6 Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 19 Jan 2024 12:37:26 -0700 Subject: [PATCH 31/32] Update documentation --- doc/source/developer_guide/dg_about.rst | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/doc/source/developer_guide/dg_about.rst b/doc/source/developer_guide/dg_about.rst index 95645d45d..642d08b93 100644 --- a/doc/source/developer_guide/dg_about.rst +++ b/doc/source/developer_guide/dg_about.rst @@ -53,13 +53,13 @@ Overall, CICE code should be implemented as follows, Any public module interfaces or data should be explicitly specified - * All subroutines and functions should define the subname character parameter statement to match the interface name like + * All subroutines and functions should define the ``subname`` character parameter statement to match the interface name like .. code-block:: fortran character(len=*),parameter :: subname='(advance_timestep)' - * Public Icepack interfaces should be accessed thru the icepack_intfc module like + * Public Icepack interfaces should be accessed thru the ``icepack_intfc`` module like .. code-block:: fortran @@ -73,5 +73,11 @@ Overall, CICE code should be implemented as follows, call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + * Use ``ice_check_nc`` or ``ice_pio_check`` after netcdf or pio calls to check for return errors. + + * Use subroutine ``abort_ice`` to abort the model run. Do not use stop or MPI_ABORT. Use optional arguments (file=__FILE__, line=__LINE__) in calls to ``abort_ice`` to improve debugging + + * Write output to stdout from the master task only unless the output is associated with an abort call. Write to unit ``nu_diag`` following the current standard. Do not use units 5 or 6. Do not use the print statement. + * Use of new Fortran features or external libraries need to be balanced against usability and the desire to compile on as many machines and compilers as possible. Developers are encouraged to contact the Consortium as early as possible to discuss requirements and implementation in this case. From b8e6b0a7e6b59286f7c7312b4a8f4323dbbde1d0 Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 19 Jan 2024 12:52:12 -0700 Subject: [PATCH 32/32] Update documentation --- doc/source/user_guide/ug_running.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 4576b8861..9337b3c47 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -132,9 +132,9 @@ CICE has been tested with - PIO 2.5.9 - PIO 2.6.0 - PIO 2.6.1 -- PnetCDF 2.6.2 - PnetCDF 1.12.2 - PnetCDF 1.12.3 +- PnetCDF 2.6.2 Please email the Consortium if this list can be extended.