From 78b2a702981e8f7e22f771f86b9331170de92868 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Wed, 8 Sep 2021 19:27:14 -0500 Subject: [PATCH 01/17] Updated files for parallel netcdf-4 with internal compression (io_netcdfpar) --- Makefile | 6 ++- Registry/Registry.EM_COMMON | 1 + arch/Config.pl | 44 +++++++++++++++ arch/postamble | 8 ++- arch/preamble | 2 +- configure | 15 +++++- external/Makefile | 1 + frame/module_io.F | 105 ++++++++++++++++++++++++++++++++++++ share/module_io_domain.F | 2 + share/output_wrf.F | 1 + share/wrf_ext_write_field.F | 1 + 11 files changed, 181 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 610002d473..60b61b0ae9 100644 --- a/Makefile +++ b/Makefile @@ -1131,7 +1131,11 @@ fseek_test : # rule used by configure to test if this will compile with netcdf4 nc4_test: - @cd tools ; /bin/rm -f nc4_test.{exe,nc,o} ; $(SCC) -o nc4_test.exe nc4_test.c -I$(NETCDF)/include -L$(NETCDF)/lib $(USENETCDF) ; cd .. + if [ $(USENETCDFPAR) -eq 0 ] ; then \ + ( cd tools ; /bin/rm -f nc4_test.{exe,nc,o} ; $(SCC) -o nc4_test.exe nc4_test.c -I$(NETCDF)/include -L$(NETCDF)/lib -lnetcdf $(NETCDF4_DEP_LIB) ; cd .. ) ; \ + else \ + ( cd tools ; /bin/rm -f nc4_test.{exe,nc,o} ; $(DM_CC) -o nc4_test.exe nc4_test.c -I$(NETCDF)/include -L$(NETCDF)/lib -lnetcdf $(NETCDF4_DEP_LIB) ; cd .. ) ; \ + fi # rule used by configure to test if Fortran 2003 IEEE signaling is available fortran_2003_ieee_test: diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index e3bd08b795..3fb2b018c6 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -3299,6 +3299,7 @@ package io_zzz io_form_restart==9 - - package io_grib2 io_form_restart==10 - - package io_pnetcdf io_form_restart==11 - - package io_pio io_form_restart==12 - - +package io_netcdfpar io_form_restart==13 - - #WRF Hydro package no_wrfhydro wrf_hydro==0 - - diff --git a/arch/Config.pl b/arch/Config.pl index ecccb670cd..32bfc12ad3 100644 --- a/arch/Config.pl +++ b/arch/Config.pl @@ -9,6 +9,7 @@ $sw_perl_path = perl ; $sw_netcdf_path = "" ; $sw_pnetcdf_path = "" ; +$sw_netcdfpar_path = "" ; $sw_hdf5_path=""; $sw_phdf5_path=""; $sw_jasperlib_path=""; @@ -95,6 +96,10 @@ { $sw_pnetcdf_path = substr( $ARGV[0], 9 ) ; } + if ( substr( $ARGV[0], 1, 10 ) eq "netcdfpar=" ) + { + $sw_netcdfpar_path = substr( $ARGV[0], 11 ) ; + } if ( substr( $ARGV[0], 1, 5 ) eq "hdf5=" ) { $sw_hdf5_path = substr( $ARGV[0], 6 ) ; @@ -459,6 +464,7 @@ $_ =~ s/CONFIGURE_PERL_PATH/$sw_perl_path/g ; $_ =~ s/CONFIGURE_NETCDF_PATH/$sw_netcdf_path/g ; $_ =~ s/CONFIGURE_PNETCDF_PATH/$sw_pnetcdf_path/g ; + $_ =~ s/CONFIGURE_NETCDFPAR_PATH/$sw_netcdfpar_path/g ; $_ =~ s/CONFIGURE_HDF5_PATH/$sw_hdf5_path/g ; $_ =~ s/CONFIGURE_PHDF5_PATH/$sw_phdf5_path/g ; $_ =~ s/CONFIGURE_LDFLAGS/$sw_ldflags/g ; @@ -496,6 +502,25 @@ $_ =~ s/#// ; $_ =~ s/#// ; } + +# put netcdfpar ahead of netcdf so that part of the name does not get clobbered + if ( $sw_netcdfpar_path ) + { $_ =~ s/CONFIGURE_WRFIO_NFPAR/wrfio_nfpar/g ; + $_ =~ s:CONFIGURE_NETCDFPAR_FLAG:-DNETCDFPAR: ; + if ( $ENV{NETCDFPAR_LDFLAGS} ) { + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH:\$\(WRF_SRC_ROOT_DIR\)/external/io_netcdfpar/libwrfio_nfpar.a $ENV{NETCDFPAR_LDFLAGS} : ; + } elsif ( $sw_os eq "Interix" ) { + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH:\$\(WRF_SRC_ROOT_DIR\)/external/io_netcdfpar/libwrfio_nfpar.a -L$sw_netcdfpar_path/lib $sw_usenetcdff $sw_usenetcdf : ; + } else { + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH:-L\$\(WRF_SRC_ROOT_DIR\)/external/io_netcdfpar -lwrfio_nfpar -L$sw_netcdfpar_path/lib $sw_usenetcdff $sw_usenetcdf : ; + } + } + else + { $_ =~ s/CONFIGURE_WRFIO_NFPAR//g ; + $_ =~ s:CONFIGURE_NETCDFPAR_FLAG::g ; + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH::g ; + } + if ( $sw_netcdf_path ) { $_ =~ s/CONFIGURE_WRFIO_NF/wrfio_nf/g ; $_ =~ s:CONFIGURE_NETCDF_FLAG:-DNETCDF: ; @@ -837,6 +862,25 @@ if ( $sw_os ne "CYGWIN_NT" ) { $_ =~ s/#NOWIN// ; } + + if ( $sw_netcdfpar_path ) + { #print("set sw_netcdfpar_path stuff\n"); + $_ =~ s/CONFIGURE_WRFIO_NFPAR/wrfio_nfpar/g ; + $_ =~ s:CONFIGURE_NETCDFPAR_FLAG:-DNETCDFPAR: ; + if ( $ENV{NETCDFPAR_LDFLAGS} ) { + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH:\$\(WRF_SRC_ROOT_DIR\)/external/io_netcdfpar/libwrfio_nfpar.a $ENV{NETCDFPAR_LDFLAGS} : ; + } elsif ( $sw_os eq "Interix" ) { + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH:\$\(WRF_SRC_ROOT_DIR\)/external/io_netcdfpar/libwrfio_nfpar.a -L$sw_netcdfpar_path/lib $sw_usenetcdff $sw_usenetcdf : ; + } else { + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH:-L\$\(WRF_SRC_ROOT_DIR\)/external/io_netcdfpar -lwrfio_nfpar -L$sw_netcdfpar_path/lib $sw_usenetcdff $sw_usenetcdf : ; + } + } + else + { $_ =~ s/CONFIGURE_WRFIO_NFPAR//g ; + $_ =~ s:CONFIGURE_NETCDFPAR_FLAG::g ; + $_ =~ s:CONFIGURE_NETCDFPAR_LIB_PATH::g ; + } + if ( $sw_netcdf_path ) { $_ =~ s/CONFIGURE_WRFIO_NF/wrfio_nf/g ; $_ =~ s:CONFIGURE_NETCDF_FLAG:-DNETCDF: ; diff --git a/arch/postamble b/arch/postamble index 152010fe3f..33bd572b1f 100644 --- a/arch/postamble +++ b/arch/postamble @@ -9,6 +9,7 @@ ARCHFLAGS = $(COREDEFS) -DIWORDSIZE=$(IWORDSIZE) -DDWORDSIZE=$(DWORDSIZ CONFIGURE_DMPARALLEL \ CONFIGURE_STUBMPI \ CONFIGURE_NETCDF_FLAG \ + CONFIGURE_NETCDFPAR_FLAG \ CONFIGURE_PNETCDF_FLAG \ CONFIGURE_ESMF_FLAG \ CONFIGURE_GRIB2_FLAG \ @@ -69,7 +70,7 @@ PNETCDFPATH = CONFIGURE_PNETCDF_PATH bundled: io_only CONFIGURE_ATMOCN external: io_only CONFIGURE_COMMS_EXTERNAL $(ESMF_TARGET) -io_only: esmf_time CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_PNF CONFIGURE_WRFIO_GRIB2 \ +io_only: esmf_time CONFIGURE_WRFIO_NF CONFIGURE_WRFIO_NFPAR CONFIGURE_WRFIO_PNF CONFIGURE_WRFIO_GRIB2 \ wrf_ioapi_includes wrfio_grib_share wrfio_grib1 wrfio_int fftpack @@ -97,6 +98,11 @@ wrfio_nf : CC="$(SCC)" CFLAGS="$(CFLAGS)" \ FC="$(SFC) $(PROMOTION) $(OMP) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ) +wrfio_nfpar : + ( cd $(WRF_SRC_ROOT_DIR)/external/io_netcdfpar ; \ + make $(J) NETCDFPARPATH="$(NETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP) $(ARCHFLAGS)" \ + FC="$(FC) $(PROMOTION) $(OMP) $(FCFLAGS)" TRADFLAG="$(TRADFLAG)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ) + wrfio_pnf : ( cd $(WRF_SRC_ROOT_DIR)/external/io_pnetcdf ; \ make $(J) NETCDFPATH="$(PNETCDFPATH)" RANLIB="$(RANLIB)" CPP="$(CPP) $(ARCHFLAGS)" \ diff --git a/arch/preamble b/arch/preamble index ecefa1455b..32c632a9c4 100644 --- a/arch/preamble +++ b/arch/preamble @@ -119,7 +119,7 @@ LIBWRFLIB = libwrflib.a #NOWIN $(WRF_SRC_ROOT_DIR)/frame/pack_utils.o #NOWIN LIB_EXTERNAL = \ -#NOWIN CONFIGURE_NETCDF_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH CONFIGURE_GRIB2_LIB CONFIGURE_ATMOCN_LIB CONFIGURE_HDF5_LIB_PATH +#NOWIN CONFIGURE_NETCDF_LIB_PATH CONFIGURE_NETCDFPAR_LIB_PATH CONFIGURE_PNETCDF_LIB_PATH CONFIGURE_GRIB2_LIB CONFIGURE_ATMOCN_LIB CONFIGURE_HDF5_LIB_PATH #### Architecture specific settings #### diff --git a/configure b/configure index ed9f10c2f4..6d11819e69 100755 --- a/configure +++ b/configure @@ -159,6 +159,17 @@ if test -n "$PERL" ; then fi + +if [ -n "$NETCDFPAR" ] ; then + echo "Will use NETCDFPAR in dir: $NETCDFPAR, which should be the same as $NETCDF" + NETCDF="$NETCDFPAR" + NETCDF4="1" + USENETCDFPAR="1" + export NETCDF + export NETCDF4 + export USENETCDFPAR +fi + if test -z "$NETCDF" ; then echo ' ' echo '*****************************************************************************' @@ -552,7 +563,7 @@ if test -n "$PERL" ; then srch=`grep -i "^#ARCH.*$os" arch/configure.defaults | grep -i "$mach"` if [ -n "$srch" ] ; then $PERL arch/Config.pl -dmparallel=$COMMLIB -ompparallel=$OMP -perl=$PERL \ - -netcdf=$NETCDF -pnetcdf=$PNETCDF -hdf5=$HDF5 -phdf5=$PHDF5 -os=$os -mach=$mach -ldflags=$ldflags \ + -netcdf=$NETCDF -pnetcdf=$PNETCDF -netcdfpar=$NETCDFPAR -hdf5=$HDF5 -phdf5=$PHDF5 -os=$os -mach=$mach -ldflags=$ldflags \ -compileflags=$compileflags -opt_level=$opt_level -USENETCDFF=$USENETCDFF -USENETCDF=$USENETCDF \ -time=$FORTRAN_COMPILER_TIMER -tfl="$TFL" -cfl="$CFL" -config_line="$config_line" \ -wrf_core=$wrf_core -gpfs=$GPFS_PATH -curl=$CURL_PATH -dep_lib_path="$DEP_LIB_PATH" @@ -1052,7 +1063,7 @@ if [ -n "$NETCDF4" ] ; then echo "!!! configure.wrf has been REMOVED !!!" echo echo "*****************************************************************************" - rm -f configure.wrf + # rm -f configure.wrf else echo "*****************************************************************************" echo "This build of WRF will use NETCDF4 with HDF5 compression" diff --git a/external/Makefile b/external/Makefile index 51a11576b8..833a63a82a 100644 --- a/external/Makefile +++ b/external/Makefile @@ -6,6 +6,7 @@ superclean : @( cd io_pio ; make -s superclean ) @( cd io_int ; make -s superclean ) @( cd io_netcdf ; make -s superclean ) + @( cd io_netcdfpar ; make -s superclean ) @( cd io_phdf5 ; make -s superclean ) @( cd io_grib1 ; make -s superclean ) @( cd io_grib_share ; make -s superclean ) diff --git a/frame/module_io.F b/frame/module_io.F index 9c769b17c5..f64b307c30 100644 --- a/frame/module_io.F +++ b/frame/module_io.F @@ -124,6 +124,9 @@ SUBROUTINE wrf_ioinit( Status ) #endif #ifdef PIO CALL ext_pio_ioinit ( SysDepInfo, ierr(12) ) +#endif +#ifdef NETCDFPAR + CALL ext_ncdpar_ioinit( SysDepInfo, ierr(13) ) #endif minerr = MINVAL(ierr) maxerr = MAXVAL(ierr) @@ -186,6 +189,9 @@ SUBROUTINE wrf_ioexit( Status ) #ifdef PIO CALL ext_pio_ioexit ( ierr(12) ) #endif +#ifdef NETCDFPAR + CALL ext_ncdpar_ioexit ( ierr(13) ) +#endif IF ( use_output_servers() ) THEN CALL wrf_quilt_ioexit( ierr(11) ) @@ -233,6 +239,7 @@ SUBROUTINE wrf_open_for_write_begin( FileName , grid, SysDepInfo, & CHARACTER*512 :: LocFilename ! for appending the process ID if necessary INTEGER :: myproc CHARACTER*512 :: mess + CHARACTER (LEN=256) :: message CHARACTER*1028 :: tstr, t1 INTEGER :: i,j INTEGER :: Comm_compute , Comm_io @@ -275,6 +282,25 @@ SUBROUTINE wrf_open_for_write_begin( FileName , grid, SysDepInfo, & CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF + +#endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + IF ( ncd_nofill ) THEN + CALL wrf_debug ( 100 , 'calling ext_ncdpar_open_for_write_begin 1' ) + + CALL ext_ncdpar_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo // ",NOFILL=.TRUE.", & + Hndl , Status ) + WRITE ( message , '("after ext_ncdpar_open_for_write_begin 1: status = ",i8)') status + + CALL wrf_debug ( 100 , message ) + ELSE + CALL wrf_debug ( 100 , 'calling ext_ncdpar_open_for_write_begin 2' ) + CALL ext_ncdpar_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, & + Hndl , Status ) + CALL wrf_debug ( 100 , 'after ext_ncdpar_open_for_write_begin 1' ) + ENDIF + #endif #ifdef PHDF5 CASE (IO_PHDF5 ) @@ -454,6 +480,10 @@ SUBROUTINE wrf_open_for_write_commit( DataHandle , Status ) ENDIF IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_open_for_write_commit ( Hndl , Status ) +#endif #ifdef ESMFIO CASE ( IO_ESMF ) CALL ext_esmf_open_for_write_commit ( Hndl , Status ) @@ -581,6 +611,11 @@ SUBROUTINE wrf_open_for_read_begin( FileName , grid, SysDepInfo, & CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, & + Hndl , Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, & @@ -704,6 +739,10 @@ SUBROUTINE wrf_open_for_read_commit( DataHandle , Status ) CASE ( IO_ESMF ) CALL ext_esmf_open_for_read_commit ( Hndl , Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_open_for_read_commit ( Hndl , Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_open_for_read_commit ( Hndl , Status ) @@ -802,6 +841,11 @@ SUBROUTINE wrf_open_for_read ( FileName , grid, SysDepInfo, & CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, & + Hndl , Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, & @@ -940,6 +984,10 @@ SUBROUTINE wrf_inquire_opened ( DataHandle, FileName , FileStatus, Status ) CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE ) CALL wrf_dm_bcast_bytes( Status , IWORDSIZE ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_inquire_opened ( Hndl, FileName , FileStatus, Status ) +#endif #ifdef PHDF5 CASE ( IO_PHDF5 ) CALL ext_phdf5_inquire_opened ( Hndl, FileName , FileStatus, Status ) @@ -1040,6 +1088,10 @@ SUBROUTINE wrf_inquire_filename ( DataHandle, FileName , FileStatus, Status ) CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE ) CALL wrf_dm_bcast_bytes( Status , IWORDSIZE ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_inquire_filename ( Hndl, FileName , FileStatus, Status ) +#endif #ifdef PHDF5 CASE ( IO_PHDF5 ) CALL ext_phdf5_inquire_filename ( Hndl, FileName , FileStatus, Status ) @@ -1203,6 +1255,10 @@ SUBROUTINE wrf_ioclose ( DataHandle, Status ) IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_ncd_ioclose( Hndl, Status ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_ioclose( Hndl, Status ) +#endif #ifdef PHDF5 CASE ( IO_PHDF5 ) CALL ext_phdf5_ioclose( Hndl, Status ) @@ -1330,6 +1386,10 @@ SUBROUTINE wrf_get_next_time ( DataHandle, DateStr, Status ) CASE ( IO_PHDF5 ) CALL ext_phdf5_get_next_time( Hndl, DateStr, Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_next_time( Hndl, DateStr, Status ) +#endif #ifdef XXX CASE ( IO_XXX ) CALL ext_xxx_get_next_time( Hndl, DateStr, Status ) @@ -1437,6 +1497,10 @@ SUBROUTINE wrf_get_previous_time ( DataHandle, DateStr, Status ) CASE ( IO_PHDF5 ) CALL ext_phdf5_get_previous_time( Hndl, DateStr, Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_previous_time( Hndl, DateStr, Status ) +#endif #ifdef XXX CASE ( IO_XXX ) CALL ext_xxx_get_previous_time( Hndl, DateStr, Status ) @@ -1525,6 +1589,10 @@ SUBROUTINE wrf_set_time ( DataHandle, DateStr, Status ) CASE ( IO_PHDF5 ) CALL ext_phdf5_set_time( Hndl, DateStr, Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_set_time( Hndl, DateStr, Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_set_time( Hndl, DateStr, Status ) @@ -1699,6 +1767,13 @@ SUBROUTINE wrf_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagge DomainStart , DomainEnd , & Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR) + CALL ext_ncdpar_get_var_info ( Hndl , VarName , NDim , & + MemoryOrder , Stagger , & + DomainStart , DomainEnd , & + Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF) CALL ext_pnc_get_var_info ( Hndl , VarName , NDim , & @@ -1808,6 +1883,10 @@ SUBROUTINE add_new_handle( Hndl, Hopened, for_out, DataHandle ) CASE ( IO_PHDF5 ) CALL wrf_error_fatal( 'add_new_handle: multiple output files not supported for PHDF5' ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL wrf_error_fatal( 'add_new_handle: multiple output files not supported for NETCDFPAR' ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL wrf_error_fatal( 'add_new_handle: multiple output files not supported for PNETCDF' ) @@ -2096,6 +2175,9 @@ SUBROUTINE wrf_read_field1 ( DataHandle , DateStr , VarName , Field , FieldType #ifdef NETCDF EXTERNAL ext_ncd_read_field #endif +#ifdef NETCDFPAR + EXTERNAL ext_ncdpar_read_field +#endif #ifdef PNETCDF EXTERNAL ext_pnc_read_field #endif @@ -2160,6 +2242,16 @@ SUBROUTINE wrf_read_field1 ( DataHandle , DateStr , VarName , Field , FieldType PatchStart , PatchEnd , & Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_read_field ( & + Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , & + DomainDesc , MemoryOrder , Stagger , DimNames , & + DomainStart , DomainEnd , & + MemoryStart , MemoryEnd , & + PatchStart , PatchEnd , & + Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF) CALL ext_pnc_read_field ( & @@ -2355,6 +2447,9 @@ SUBROUTINE wrf_write_field1 ( DataHandle , DateStr , VarName , Field , FieldType #ifdef NETCDF EXTERNAL ext_ncd_write_field #endif +#ifdef NETCDFPAR + EXTERNAL ext_ncdpar_write_field +#endif #ifdef PNETCDF EXTERNAL ext_pnc_write_field #endif @@ -2424,6 +2519,16 @@ SUBROUTINE wrf_write_field1 ( DataHandle , DateStr , VarName , Field , FieldType PatchStart , PatchEnd , & Status ) #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_write_field( & + Hndl , DateStr , VarName , Field , FieldType , Comm , IOComm , & + DomainDesc , MemoryOrder , Stagger , DimNames , & + DomainStart , DomainEnd , & + MemoryStart , MemoryEnd , & + PatchStart , PatchEnd , & + Status ) +#endif #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL lower_case( MemoryOrder, MemOrd ) diff --git a/share/module_io_domain.F b/share/module_io_domain.F index 7b2b115c6e..30f5354c3d 100644 --- a/share/module_io_domain.F +++ b/share/module_io_domain.F @@ -297,6 +297,8 @@ SUBROUTINE construct_filename4( result , basename , fld1 , len1 , date_char , io ext = '.int' ELSE IF ( use_package(io_form) .EQ. IO_NETCDF ) THEN ext = '.nc ' + ELSE IF ( use_package(io_form) .EQ. IO_NETCDFPAR ) THEN + ext = '.nc ' ELSE IF ( use_package(io_form) .EQ. IO_PNETCDF ) THEN ext = '.nc ' ELSE IF ( use_package(io_form) .EQ. IO_PIO ) THEN diff --git a/share/output_wrf.F b/share/output_wrf.F index 1aa59249a6..c6db0f4129 100644 --- a/share/output_wrf.F +++ b/share/output_wrf.F @@ -653,6 +653,7 @@ SUBROUTINE output_wrf ( fid , grid , config_flags, switch , ierr ) ! added netcdf-specific metadata: IF ( ( use_package( io_form ) == IO_NETCDF ) .OR. & + ( use_package( io_form ) == IO_NETCDFPAR ) .OR. & ( use_package( io_form ) == IO_PHDF5 ) .OR. & ( use_package( io_form ) == IO_PIO ) .OR. & ( use_package( io_form ) == IO_PNETCDF ) ) THEN diff --git a/share/wrf_ext_write_field.F b/share/wrf_ext_write_field.F index eaf44bf76f..99bc04116d 100644 --- a/share/wrf_ext_write_field.F +++ b/share/wrf_ext_write_field.F @@ -190,6 +190,7 @@ SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,grid, & CALL get_handle ( Hndl, io_form , for_out, DataHandle ) IF ( ( dryrun .AND. ( use_package(io_form) .EQ. IO_NETCDF .OR. & + use_package(io_form) .EQ. IO_NETCDFPAR .OR. & use_package(io_form) .EQ. IO_PIO .OR. & use_package(io_form) .EQ. IO_PNETCDF ) ) .OR. & ( use_package(io_form) .EQ. IO_PHDF5 ) ) THEN From a3666d60bf1e4dceb580ecf496e7e92d4760a611 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Wed, 8 Sep 2021 19:30:12 -0500 Subject: [PATCH 02/17] Added files for parallel netcdf-4 with compression (external/io_netcdfpar) --- external/io_netcdfpar/Makefile | 70 + .../io_netcdfpar/ext_ncdpar_get_dom_ti.code | 157 + .../io_netcdfpar/ext_ncdpar_get_var_td.code | 228 + .../io_netcdfpar/ext_ncdpar_get_var_ti.code | 174 + .../io_netcdfpar/ext_ncdpar_put_dom_ti.code | 164 + .../io_netcdfpar/ext_ncdpar_put_var_td.code | 240 + .../io_netcdfpar/ext_ncdpar_put_var_ti.code | 144 + external/io_netcdfpar/field_routines.F90 | 200 + external/io_netcdfpar/module_wrfsi_static.F90 | 96 + external/io_netcdfpar/transpose.code | 40 + external/io_netcdfpar/wrf_io.F90 | 4132 +++++++++++++++++ 11 files changed, 5645 insertions(+) create mode 100644 external/io_netcdfpar/Makefile create mode 100644 external/io_netcdfpar/ext_ncdpar_get_dom_ti.code create mode 100644 external/io_netcdfpar/ext_ncdpar_get_var_td.code create mode 100644 external/io_netcdfpar/ext_ncdpar_get_var_ti.code create mode 100644 external/io_netcdfpar/ext_ncdpar_put_dom_ti.code create mode 100644 external/io_netcdfpar/ext_ncdpar_put_var_td.code create mode 100644 external/io_netcdfpar/ext_ncdpar_put_var_ti.code create mode 100644 external/io_netcdfpar/field_routines.F90 create mode 100644 external/io_netcdfpar/module_wrfsi_static.F90 create mode 100644 external/io_netcdfpar/transpose.code create mode 100644 external/io_netcdfpar/wrf_io.F90 diff --git a/external/io_netcdfpar/Makefile b/external/io_netcdfpar/Makefile new file mode 100644 index 0000000000..1e2f4c31a2 --- /dev/null +++ b/external/io_netcdfpar/Makefile @@ -0,0 +1,70 @@ +#makefile to build a wrf_io with netCDF + +OBJSL = wrf_io.o field_routines.o module_wrfsi_static.o +OBJS = $(OBJSL) +CODE = ext_ncdpar_get_dom_ti.code ext_ncdpar_get_var_td.code ext_ncdpar_get_var_ti.code ext_ncdpar_put_dom_ti.code ext_ncdpar_put_var_td.code ext_ncdpar_put_var_ti.code transpose.code +FFLAGS = $(FCFLAGS) -I$(NETCDFPARPATH)/include -I../ioapi_share +LIBS = $(LIB_LOCAL) -L$(NETCDFPARPATH)/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lm -lz -lcurl +LIBFFS = $(LIB_LOCAL) -L$(NETCDFPARPATH)/lib -lnetcdff -lnetcdf $(NETCDF4_DEP_LIB) +CPP1 = $(CPP) -P $(TRADFLAG) -D_NETCDFPAR -D_NETCDF4 +M4 = m4 -Uinclude -Uindex -Ulen +AR = ar + +.SUFFIXES: .F90 .f .o .code + +all : libwrfio_nfpar.a + +libwrfio_nfpar.a: $(OBJS) $(CODE) + /bin/rm -f $@ + if [ "$(AR)" != "lib.exe" ] ; then \ + $(AR) cr libwrfio_nfpar.a $(OBJSL) ; \ + else \ + $(AR) /out:libwrfio_nfpar.a $(OBJSL) ; \ + fi + $(RANLIB) $@ + +wrf_io.o: wrf_io.F90 $(CODE) + grep nf_format_64bit $(NETCDFPATH)/include/netcdf.inc ;\ + a=$$? ; export a ; \ + if [ $$a -a "$$WRFIO_NCD_LARGE_FILE_SUPPORT" = "1" ] ; then \ + $(CPP1) -DWRFIO_NCD_LARGE_FILE_SUPPORT -I../ioapi_share wrf_io.F90 | $(M4) - > wrf_io.f ; \ + else \ + $(CPP1) -I../ioapi_share wrf_io.F90 | $(M4) - > wrf_io.f ; \ + fi + $(FC) -o $@ $(FFLAGS) -c wrf_io.f + + +module_wrfsi_static.o: module_wrfsi_static.F90 + $(CPP1) -I../ioapi_share module_wrfsi_static.F90 > module_wrfsi_static.f + $(FC) -o $@ $(FFLAGS) -c module_wrfsi_static.f + +# gfortran treats iargc as intrinsic, so get rid of external declaration in that case +diffwrf: diffwrf.F90 + x=`echo "$(FC)" | awk '{print $$1}'` ; export x ; \ + if [ $$x = "gfortran" ] ; then \ + echo removing external declaration of iargc for gfortran ; \ + $(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share diffwrf.F90 | sed '/integer *, *external.*iargc/d' > diffwrf.f ;\ + else \ + $(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share diffwrf.F90 > diffwrf.f ; \ + fi + $(FC) -c $(FFLAGS) diffwrf.f + @if [ \( -f ../../frame/wrf_debug.o \) -a \( -f ../../frame/module_wrf_error.o \) -a \( -f $(ESMF_MOD_DEPENDENCE) \) -a \( -f ../../frame/clog.o \) ] ; then \ + echo "diffwrf io_netcdf is being built now. " ; \ + if [ \( -f $(NETCDFPATH)/lib/libnetcdff.a -o -f $(NETCDFPATH)/lib/libnetcdff.so \) ] ; then \ + $(FC) $(FFLAGS) $(LDFLAGS) -o diffwrf diffwrf.o $(OBJSL) ../../frame/wrf_debug.o ../../frame/module_wrf_error.o ../../frame/clog.o $(ESMF_IO_LIB_EXT) $(LIBFFS) ;\ + else \ + $(FC) $(FFLAGS) $(LDFLAGS) -o diffwrf diffwrf.o $(OBJSL) ../../frame/wrf_debug.o ../../frame/module_wrf_error.o ../../frame/clog.o $(ESMF_IO_LIB_EXT) $(LIBS) ;\ + fi ; \ + else \ + echo "***************************************************************************** " ; \ + echo "*** Rerun compile to make diffwrf in external/io_netcdf directory *** " ; \ + echo "***************************************************************************** " ; \ + fi + +field_routines.o: field_routines.F90 wrf_io.o + $(CPP1) -I../ioapi_share field_routines.F90 > field_routines.f + $(FC) -o $@ $(FFLAGS) -c field_routines.f + +superclean: + /bin/rm -f *.f *.o *.obj *.i testWRFWrite testWRFRead \ + *.mod libwrfio_nfpar.a diffwrf diff --git a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code new file mode 100644 index 0000000000..0e41b521f8 --- /dev/null +++ b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code @@ -0,0 +1,157 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- + + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + TYPE_DATA + TYPE_COUNT + TYPE_OUTCOUNT + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: XType + integer :: Len + integer :: stat + TYPE_BUFFER + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif +! Do nothing unless it is time to read time-independent domain metadata. +IF ( ncdpar_ok_to_get_dom_ti( DataHandle ) ) THEN + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) & +'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) & +'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) & +'Warning READ WRITE ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + stat = NF_INQ_ATT(DH%NCID,NF_GLOBAL,Element, XType, Len) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then + if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) & +'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + else + if( XType/=NF_TYPE) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) & +'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + endif + if(Len<=0) then + Status = WRF_WARN_LENGTH_LESS_THAN_1 + write(msg,*) & +'Warning LENGTH < 1 in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif +#ifndef CHAR_TYPE + allocate(Buffer(Len), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) & +'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,Buffer) +#else + Data = '' + stat = NF_GET_ATT_TEXT(DH%NCID,NF_GLOBAL,Element,Data) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif +#ifndef CHAR_TYPE + COPY + deallocate(Buffer, STAT=stat) + if(stat/= WRF_NO_ERR) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) & +'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + if(Len > Count) then + OutCount = Count + Status = WRF_WARN_MORE_DATA_IN_FILE + else + OutCount = Len + Status = WRF_NO_ERR + endif +#endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) & +'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif +ENDIF + return diff --git a/external/io_netcdfpar/ext_ncdpar_get_var_td.code b/external/io_netcdfpar/ext_ncdpar_get_var_td.code new file mode 100644 index 0000000000..dcb0b21f81 --- /dev/null +++ b/external/io_netcdfpar/ext_ncdpar_get_var_td.code @@ -0,0 +1,228 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- + + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'netcdf.inc' + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character (DateStrLen),intent(in) :: DateStr + character*(*) ,intent(in) :: Var + TYPE_DATA + TYPE_COUNT + TYPE_OUTCOUNT + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + character (VarNameLen) :: VarName + character (40+len(Element)) :: Name + character (40+len(Element)) :: FName + integer :: stat + TYPE_BUFFER ,allocatable :: Buffer(:) + integer :: i + integer :: VDims (2) + integer :: VStart(2) + integer :: VCount(2) + integer :: NVar + integer :: TimeIndex + integer :: NCID + integer :: DimIDs(2) + integer :: VarID + integer :: XType + integer :: NDims + integer :: NAtts + integer :: Len1 + + if(Count <= 0) then + Status = WRF_WARN_ZERO_LENGTH_GET + write(msg,*) & +'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + VarName = Var + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + NCID = DH%NCID + call GetName(Element, VarName, Name, Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) & +'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) & +'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) & +'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + stat = NF_INQ_VARID(NCID,Name,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + stat = NF_INQ_VAR(NCID,VarID,FName,XType,NDims,DimIDs,NAtts) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then + if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) & +'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + else + if(XType /= NF_TYPE) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) & +'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + endif + if(NDims /= NMDVarDims) then + Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D + write(msg,*) & +'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + stat = NF_INQ_DIMLEN(NCID,DimIDs(1),Len1) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' DimIDs(1) ',DimIDs(1) + call wrf_debug ( WARN , msg) + return + endif + call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + VStart(1) = 1 + VStart(2) = TimeIndex + VCount(1) = LENGTH + VCount(2) = 1 +#ifndef CHAR_TYPE + allocate(Buffer(VCount(1)), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) & +'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + stat = NF_VAR_PAR_ACCESS(ncid,DH%MDVarIDs(NVar),DH%ind_or_collective) + stat = NF_ROUTINE (NCID,VarID,VStart,VCount,Buffer) +#else + if(Len1 > len(Data)) then + Status = WRF_WARN_CHARSTR_GT_LENDATA + write(msg,*) & +'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + Data = '' + stat = NF_GET_VARA_TEXT (NCID,VarID,VStart,VCount,Data) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif +#ifndef CHAR_TYPE + COPY + deallocate(Buffer, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) & +'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + if(Len1 > Count) then + OutCount = Count + Status = WRF_WARN_MORE_DATA_IN_FILE + else + OutCount = Len1 + Status = WRF_NO_ERR + endif +#endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) & +'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + return diff --git a/external/io_netcdfpar/ext_ncdpar_get_var_ti.code b/external/io_netcdfpar/ext_ncdpar_get_var_ti.code new file mode 100644 index 0000000000..d6c6d63c48 --- /dev/null +++ b/external/io_netcdfpar/ext_ncdpar_get_var_ti.code @@ -0,0 +1,174 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- + + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: Var + TYPE_DATA + TYPE_COUNT + TYPE_OUTCOUNT + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: XLen + TYPE_BUFFER + character (VarNameLen) :: VarName + integer :: stat + integer :: NVar + integer :: XType + + if(Count <= 0) then + Status = WRF_WARN_ZERO_LENGTH_GET + write(msg,*) & +'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + VarName = Var + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) & +'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) & +'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) & +'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + do NVar=1,DH%NumVars + if(DH%VarNames(NVar) == VarName) then + exit + elseif(NVar == DH%NumVars) then + Status = WRF_WARN_VAR_NF + write(msg,*) & +'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + enddo + stat = NF_INQ_ATT(DH%NCID,DH%VarIDs(NVar),trim(Element),XType,XLen) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + endif + if ( NF_TYPE == NF_DOUBLE .OR. NF_TYPE == NF_FLOAT ) then + if( .NOT. ( XType==NF_FLOAT .OR. XType==NF_DOUBLE) ) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) & +'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + else + if(XType /= NF_TYPE) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) & +'Warning TYPE MISMATCH in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + endif +#ifndef CHAR_TYPE + allocate(Buffer(XLen), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) & +'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), Buffer ) +#else + if(XLen > len(Data)) then + Status = WRF_WARN_CHARSTR_GT_LENDATA + write(msg,*) & +'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), Data ) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + endif + COPY +#ifndef CHAR_TYPE + deallocate(Buffer, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) & +'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + if(XLen > Count) then + OutCount = Count + Status = WRF_WARN_MORE_DATA_IN_FILE + else + OutCount = XLen + Status = WRF_NO_ERR + endif +#endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) & +'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + return diff --git a/external/io_netcdfpar/ext_ncdpar_put_dom_ti.code b/external/io_netcdfpar/ext_ncdpar_put_dom_ti.code new file mode 100644 index 0000000000..9417261c8f --- /dev/null +++ b/external/io_netcdfpar/ext_ncdpar_put_dom_ti.code @@ -0,0 +1,164 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- + + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + TYPE_DATA + TYPE_COUNT + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: stat + integer :: stat2 + integer ,allocatable :: Buffer(:) + integer :: i + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif +! Do nothing unless it is time to write time-independent domain metadata. +IF ( ncdpar_ok_to_put_dom_ti( DataHandle ) ) THEN + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) & +'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + STATUS = WRF_WARN_WRITE_RONLY_FILE + write(msg,*) & +'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then +#ifdef LOG + allocate(Buffer(Count), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + do i=1,Count + if(data(i)) then + Buffer(i)=1 + else + Buffer(i)=0 + endif + enddo + stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS) + deallocate(Buffer, STAT=stat2) + if(stat2/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif +#else + stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + stat = NF_REDEF(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif +#ifdef LOG + allocate(Buffer(Count), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) & +'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + do i=1,Count + if(data(i)) then + Buffer(i)=1 + else + Buffer(i)=0 + endif + enddo + stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS) + deallocate(Buffer, STAT=stat2) + if(stat2/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) & +'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif +#else + stat = NF_ROUTINE (DH%NCID,NF_GLOBAL,Element,ARGS) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + stat = NF_ENDDEF(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) & +'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif +ENDIF + return diff --git a/external/io_netcdfpar/ext_ncdpar_put_var_td.code b/external/io_netcdfpar/ext_ncdpar_put_var_td.code new file mode 100644 index 0000000000..ee62b45e83 --- /dev/null +++ b/external/io_netcdfpar/ext_ncdpar_put_var_td.code @@ -0,0 +1,240 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- + + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + character*(*) ,intent(in) :: Var + TYPE_DATA + TYPE_COUNT + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + character (VarNameLen) :: VarName + character (40+len(Element)) :: Name + integer :: stat + integer :: stat2 + integer ,allocatable :: Buffer(:) + integer :: i + integer :: VDims (2) + integer :: VStart(2) + integer :: VCount(2) + integer :: NVar + integer :: TimeIndex + integer :: NCID + + VarName = Var + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + NCID = DH%NCID + call GetName(Element, VarName, Name, Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) & +'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + Status = WRF_WARN_WRITE_RONLY_FILE + write(msg,*) & +'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + if(LENGTH < 1) then + Status = WRF_WARN_ZERO_LENGTH_PUT + return + endif + do NVar=1,MaxVars + if(DH%MDVarNames(NVar) == Name) then + Status = WRF_WARN_2DRYRUNS_1VARIABLE + return + elseif(DH%MDVarNames(NVar) == NO_NAME) then + DH%MDVarNames(NVar) = Name + exit + elseif(NVar == MaxVars) then + Status = WRF_WARN_TOO_MANY_VARIABLES + write(msg,*) & +'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + enddo + do i=1,MaxDims + if(DH%DimLengths(i) == LENGTH) then + exit + elseif(DH%DimLengths(i) == NO_DIM) then + stat = NF_DEF_DIM(NCID,DH%DimNames(i),LENGTH,DH%DimIDs(i)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + DH%DimLengths(i) = LENGTH + exit + elseif(i == MaxDims) then + Status = WRF_WARN_TOO_MANY_DIMS + write(msg,*) & +'Warning TOO MANY DIMENSIONS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + enddo + DH%MDVarDimLens(NVar) = LENGTH + VDims(1) = DH%DimIDs(i) + VDims(2) = DH%DimUnlimID + stat = NF_DEF_VAR(NCID,Name,NF_TYPE,2,VDims,DH%MDVarIDs(NVar)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + do NVar=1,MaxVars + if(DH%MDVarNames(NVar) == Name) then + exit + elseif(DH%MDVarNames(NVar) == NO_NAME) then + Status = WRF_WARN_MD_NF + write(msg,*) & +'Warning METADATA NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + elseif(NVar == MaxVars) then + Status = WRF_WARN_TOO_MANY_VARIABLES + write(msg,*) & +'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + enddo + if(LENGTH > DH%MDVarDimLens(NVar)) then + Status = WRF_WARN_COUNT_TOO_LONG + write(msg,*) & +'Warning COUNT TOO LONG in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + elseif(LENGTH < 1) then + Status = WRF_WARN_ZERO_LENGTH_PUT + write(msg,*) & +'Warning ZERO LENGTH PUT in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + VStart(1) = 1 + VStart(2) = TimeIndex + VCount(1) = LENGTH + VCount(2) = 1 +#ifdef LOG + allocate(Buffer(LENGTH), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) & +'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + do i=1,Count + if(data(i)) then + Buffer(i)=1 + else + Buffer(i)=0 + endif + enddo + stat = NF_VAR_PAR_ACCESS(ncid,DH%MDVarIDs(NVar),DH%ind_or_collective) +! call netcdf_err(stat,Status) +! if(Status /= WRF_NO_ERR) then +! write(msg,*) 'NetCDF error in ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ +! call wrf_debug ( WARN , TRIM(msg)) +! return +! endif + stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Buffer) + deallocate(Buffer, STAT=stat2) + if(stat2/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) & +'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif +#else + stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Data) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element + call wrf_debug ( WARN , msg) + return + endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) & +'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + return diff --git a/external/io_netcdfpar/ext_ncdpar_put_var_ti.code b/external/io_netcdfpar/ext_ncdpar_put_var_ti.code new file mode 100644 index 0000000000..eb7669fb5b --- /dev/null +++ b/external/io_netcdfpar/ext_ncdpar_put_var_ti.code @@ -0,0 +1,144 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- + + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: Var + TYPE_DATA + TYPE_COUNT + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + character (VarNameLen) :: VarName + integer :: stat + integer ,allocatable :: Buffer(:) + integer :: i + integer :: NVar + character*1 :: null + + null=char(0) + VarName = Var + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) & +'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + Status = WRF_WARN_WRITE_RONLY_FILE + write(msg,*) & +'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_MD_AFTER_OPEN + write(msg,*) & +'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + do NVar=1,MaxVars + if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then + exit + elseif(NVar == MaxVars) then + Status = WRF_WARN_VAR_NF + write(msg,*) & +'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ & + ,NVar,VarName + call wrf_debug ( WARN , msg) + return + endif + enddo +#ifdef LOG + allocate(Buffer(Count), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) & +'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + do i=1,Count + if(data(i)) then + Buffer(i)=1 + else + Buffer(i)=0 + endif + enddo +#endif +#ifdef CHAR_TYPE + if(len_trim(Data).le.0) then + stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element),len_trim(null),null) + else + stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), ARGS ) + endif +#else + stat = NF_ROUTINE(DH%NCID,DH%VarIDs(NVar),trim(Element), ARGS ) +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) & +'NetCDF error for Var ',TRIM(Var),& + ' Element ',trim(Element),' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( WARN , msg) + endif +#ifdef LOG + deallocate(Buffer, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) & +'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif +#endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) & +'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + return diff --git a/external/io_netcdfpar/field_routines.F90 b/external/io_netcdfpar/field_routines.F90 new file mode 100644 index 0000000000..93fdcd3370 --- /dev/null +++ b/external/io_netcdfpar/field_routines.F90 @@ -0,0 +1,200 @@ +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* +!*---------------------------------------------------------------------------- +subroutine ext_ncdpar_RealFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character (*) ,intent(in) :: IO + integer ,intent(in) :: NCID + integer ,intent(in) :: VarID + integer ,dimension(NVarDims),intent(in) :: VStart + integer ,dimension(NVarDims),intent(in) :: VCount + real, dimension(*) ,intent(inout) :: Data + integer ,intent(out) :: Status + integer :: stat + character(len=180) :: errmsg + integer i + + if(IO == 'write') then + ! write(0,*) 'vstart = ',vstart + ! write(0,*) 'vcount = ',vcount + ! write(0,*) 'varid = ',varid + ! i = vcount(1)*vcount(2) + ! write(0,*) 'data ',data(1),data(i) + !write(0,*) 'data size = ',size(data) + stat = NF_VAR_PAR_ACCESS(ncid,VarID,nf_collective) + call netcdf_err(stat,Status) + if ( Status /= WRF_NO_ERR) then + write(0,*) 'error setting par_access' + ENDIF + ! write(0,*) 'call put_vara' + stat = NF_PUT_VARA_REAL(NCID,VarID,VStart,VCount,Data) + ! write(0,*) 'done put_vara' + else + stat = NF_GET_VARA_REAL(NCID,VarID,VStart,VCount,Data) + endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + errmsg = NF_STRERROR(stat) + write(0,*) 'error = ',errmsg + write(0,*) 'vstart = ',vstart + write(0,*) 'vcount = ',vcount + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , msg) + endif + !write(0,*) 'barrier 1' + !call mpi_barrier(MPI_COMM_WORLD,i) + !write(0,*) 'barrier 2' + return +end subroutine ext_ncdpar_RealFieldIO + +subroutine ext_ncdpar_DoubleFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character (*) ,intent(in) :: IO + integer ,intent(in) :: NCID + integer ,intent(in) :: VarID + integer ,dimension(NVarDims),intent(in) :: VStart + integer ,dimension(NVarDims),intent(in) :: VCount + real*8 ,intent(inout) :: Data + integer ,intent(out) :: Status + integer :: stat + + if(IO == 'write') then + stat = NF_VAR_PAR_ACCESS(ncid,VarID,nf_collective) + stat = NF_PUT_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data) + else + stat = NF_GET_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data) + endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , msg) + endif + return +end subroutine ext_ncdpar_DoubleFieldIO + +subroutine ext_ncdpar_IntFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character (*) ,intent(in) :: IO + integer ,intent(in) :: NCID + integer ,intent(in) :: VarID + integer ,dimension(NVarDims),intent(in) :: VStart + integer ,dimension(NVarDims),intent(in) :: VCount + integer ,intent(inout) :: Data + integer ,intent(out) :: Status + integer :: stat + + if(IO == 'write') then + stat = NF_VAR_PAR_ACCESS(ncid,VarID,nf_collective) + stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Data) + else + stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Data) + endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , msg) + endif + return +end subroutine ext_ncdpar_IntFieldIO + +subroutine ext_ncdpar_LogicalFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character (*) ,intent(in) :: IO + integer ,intent(in) :: NCID + integer ,intent(in) :: VarID + integer,dimension(NVarDims) ,intent(in) :: VStart + integer,dimension(NVarDims) ,intent(in) :: VCount + logical,dimension(VCount(1),VCount(2),VCount(3)),intent(inout) :: Data + integer ,intent(out) :: Status + integer,dimension(:,:,:),allocatable :: Buffer + integer :: stat + integer :: i,j,k + + allocate(Buffer(VCount(1),VCount(2),VCount(3)), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + if(IO == 'write') then + do k=1,VCount(3) + do j=1,VCount(2) + do i=1,VCount(1) + if(data(i,j,k)) then + Buffer(i,j,k)=1 + else + Buffer(i,j,k)=0 + endif + enddo + enddo + enddo + stat = NF_VAR_PAR_ACCESS(ncid,VarID,nf_collective) + stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Buffer) + else + stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Buffer) + Data = Buffer == 1 + endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , msg) + return + endif + deallocate(Buffer, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + return +end subroutine ext_ncdpar_LogicalFieldIO diff --git a/external/io_netcdfpar/module_wrfsi_static.F90 b/external/io_netcdfpar/module_wrfsi_static.F90 new file mode 100644 index 0000000000..7660e67f38 --- /dev/null +++ b/external/io_netcdfpar/module_wrfsi_static.F90 @@ -0,0 +1,96 @@ +MODULE wrfsi_static + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +CONTAINS +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE open_wrfsi_static(dataroot,cdfid) + + IMPLICIT NONE + INCLUDE "netcdf.inc" + CHARACTER(LEN=*), INTENT(IN) :: dataroot + INTEGER, INTENT(OUT) :: cdfid + CHARACTER(LEN=255) :: staticfile + LOGICAL :: static_exists + INTEGER :: status + + staticfile = TRIM(dataroot) // '/static/static.wrfsi' + INQUIRE(FILE=staticfile, EXIST=static_exists) + IF (static_exists) THEN + status = NF_OPEN(TRIM(staticfile),NF_NOWRITE,cdfid) + IF (status .NE. NF_NOERR) THEN + PRINT '(A,I5)', 'NetCDF error opening WRF static file: ',status + STOP 'open_wrfsi_static' + END IF + + ELSE + +!mp +! search for rotlat version?? +! PRINT '(A)', 'Static file not found ', staticfile +! PRINT '(A)', 'Look for NMM version' + staticfile = TRIM(dataroot) // '/static/static.wrfsi.rotlat' + INQUIRE(FILE=staticfile, EXIST=static_exists) + IF (static_exists) THEN + status = NF_OPEN(TRIM(staticfile),NF_NOWRITE,cdfid) + IF (status .NE. NF_NOERR) THEN + PRINT '(A,I5)', 'NetCDF error opening WRF static file: ',status + STOP 'open_wrfsi_static' + END IF + ELSE + + PRINT '(A)', 'rotlat Static file not found, either: ', staticfile + STOP 'open_wrfsi_static' + ENDIF + + ENDIF + + RETURN + END SUBROUTINE open_wrfsi_static +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE get_wrfsi_static_dims(dataroot, nx, ny) + + ! Subroutine to return the horizontal dimensions of WRF static file + ! contained in the input dataroot + + IMPLICIT NONE + INCLUDE "netcdf.inc" + CHARACTER(LEN=*), INTENT(IN) :: dataroot + INTEGER , INTENT(OUT) :: nx + INTEGER , INTENT(OUT) :: ny + + INTEGER :: cdfid,vid, status + + CALL open_wrfsi_static(dataroot,cdfid) + status = NF_INQ_DIMID(cdfid, 'x', vid) + status = NF_INQ_DIMLEN(cdfid, vid, nx) + status = NF_INQ_DIMID(cdfid, 'y', vid) + status = NF_INQ_DIMLEN(cdfid, vid, ny) + PRINT '(A,I5,A,I5)', 'WRF X-dimension = ',nx, & + ' WRF Y-dimension = ',ny + status = NF_CLOSE(cdfid) + RETURN + END SUBROUTINE get_wrfsi_static_dims +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE get_wrfsi_static_2d(dataroot, varname, data) + + IMPLICIT NONE + INCLUDE "netcdf.inc" + ! Gets any 2D variable from the static file + CHARACTER(LEN=*), INTENT(IN) :: dataroot + CHARACTER(LEN=*), INTENT(IN) :: varname + REAL, INTENT(OUT) :: data(:,:) + + INTEGER :: cdfid, vid, status + + CALL open_wrfsi_static(dataroot,cdfid) + status = NF_INQ_VARID(cdfid,varname,vid) + status = NF_GET_VAR_REAL(cdfid,vid,data) + IF (status .NE. NF_NOERR) THEN + PRINT '(A)', 'Problem getting 2D data.' + ENDIF + status = NF_CLOSE(cdfid) + RETURN + END SUBROUTINE get_wrfsi_static_2d +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +END MODULE wrfsi_static diff --git a/external/io_netcdfpar/transpose.code b/external/io_netcdfpar/transpose.code new file mode 100644 index 0000000000..0ff4979b65 --- /dev/null +++ b/external/io_netcdfpar/transpose.code @@ -0,0 +1,40 @@ + ix=0 + jx=0 + kx=0 + call reorder(MemoryOrder,MemO) + if(IACHAR(MemO(1:1)) > MaxUpperCase) ix=i2+i1 + if(IACHAR(MemO(2:2)) > MaxUpperCase) jx=j2+j1 + if(IACHAR(MemO(3:3)) > MaxUpperCase) kx=k2+k1 + +! pjj/cray + if(IO == 'write') then +!dir$ concurrent +!$OMP PARALLEL DO SCHEDULE(RUNTIME) PRIVATE(i,j,k) + do k=k1,k2 + do j=j1,j2 +!dir$ prefervector +!dir$ concurrent +!cdir select(vector) + do i=i1,i2 + DFIELD = Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) + enddo + enddo + enddo +!$OMP END PARALLEL DO +else +!dir$ concurrent +!$OMP PARALLEL DO SCHEDULE(RUNTIME) PRIVATE(i,j,k) + do k=k1,k2 + do j=j1,j2 +!dir$ prefervector +!dir$ concurrent +!cdir select(vector) + do i=i1,i2 + Field(1:di,abs(ix-i),abs(jx-j),abs(kx-k)) = DFIELD + enddo + enddo + enddo +!$OMP END PARALLEL DO +endif + + return diff --git a/external/io_netcdfpar/wrf_io.F90 b/external/io_netcdfpar/wrf_io.F90 new file mode 100644 index 0000000000..10090e6cb0 --- /dev/null +++ b/external/io_netcdfpar/wrf_io.F90 @@ -0,0 +1,4132 @@ +#ifndef USE_NETCDF4_FEATURES +#define USE_NETCDF4_FEATURES 1 +#endif +!*------------------------------------------------------------------------------ +!* Standard Disclaimer +!* +!* Forecast Systems Laboratory +!* NOAA/OAR/ERL/FSL +!* 325 Broadway +!* Boulder, CO 80303 +!* +!* AVIATION DIVISION +!* ADVANCED COMPUTING BRANCH +!* SMS/NNT Version: 2.0.0 +!* +!* This software and its documentation are in the public domain and +!* are furnished "as is". The United States government, its +!* instrumentalities, officers, employees, and agents make no +!* warranty, express or implied, as to the usefulness of the software +!* and documentation for any purpose. They assume no +!* responsibility (1) for the use of the software and documentation; +!* or (2) to provide technical support to users. +!* +!* Permission to use, copy, modify, and distribute this software is +!* hereby granted, provided that this disclaimer notice appears in +!* all copies. All modifications to this software must be clearly +!* documented, and are solely the responsibility of the agent making +!* the modification. If significant modifications or enhancements +!* are made to this software, the SMS Development team +!* (sms-info@fsl.noaa.gov) should be notified. +!* +!*---------------------------------------------------------------------------- +!* +!* WRF NetCDF I/O +! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov +!* Date: October 6, 2000 +!* NetCDFpar: Adapted by E. Mansell for parallel write/read via netcdf4 interface +!* Feb. 2021 +!*---------------------------------------------------------------------------- + +module wrf_data_ncpar + + integer , parameter :: FATAL = 1 + integer , parameter :: WARN = 1 + integer , parameter :: WrfDataHandleMax = 99 + integer , parameter :: MaxDims = 2000 ! = NF_MAX_VARS +#if(WRF_CHEM == 1) + integer , parameter :: MaxVars = 10000 +#else + integer , parameter :: MaxVars = 3000 +#endif + integer , parameter :: MaxTimes = 10000 + integer , parameter :: DateStrLen = 19 + integer , parameter :: VarNameLen = 31 + integer , parameter :: NO_DIM = 0 + integer , parameter :: NVarDims = 4 + integer , parameter :: NMDVarDims = 2 + character (8) , parameter :: NO_NAME = 'NULL' + character (DateStrLen) , parameter :: ZeroDate = '0000-00-00-00_00_00' + +#include "wrf_io_flags.h" + + character (256) :: msg + logical :: WrfIOnotInitialized = .true. + + type :: wrf_data_handle + character (255) :: FileName + integer :: FileStatus + integer :: Comm + integer :: NCID + logical :: Free + logical :: Write + character (5) :: TimesName + integer :: TimeIndex + integer :: CurrentTime !Only used for read + integer :: NumberTimes !Only used for read + character (DateStrLen), pointer :: Times(:) + integer :: TimesVarID + integer , pointer :: DimLengths(:) + integer , pointer :: DimIDs(:) + character (31) , pointer :: DimNames(:) + integer :: DimUnlimID + character (9) :: DimUnlimName + integer , dimension(NVarDims) :: DimID + integer , dimension(NVarDims) :: Dimension + integer , pointer :: MDVarIDs(:) + integer , pointer :: MDVarDimLens(:) + character (80) , pointer :: MDVarNames(:) + integer , pointer :: VarIDs(:) + integer , pointer :: VarDimLens(:,:) + character (VarNameLen), pointer :: VarNames(:) + integer :: CurrentVariable !Only used for read + integer :: NumVars +! first_operation is set to .TRUE. when a new handle is allocated +! or when open-for-write or open-for-read are committed. It is set +! to .FALSE. when the first field is read or written. + logical :: first_operation + logical :: R4OnOutput + logical :: nofill + logical :: use_netcdf_classic + logical :: Collective + integer :: ind_or_collective + end type wrf_data_handle + type(wrf_data_handle),target :: WrfDataHandles(WrfDataHandleMax) +end module wrf_data_ncpar + +module ext_ncdpar_support_routines + + implicit none + include 'mpif.h' + +CONTAINS + +subroutine allocHandle(DataHandle,DH,Comm,Status) + use wrf_data_ncpar + include 'netcdf.inc' + include 'wrf_status_codes.h' + integer ,intent(out) :: DataHandle + type(wrf_data_handle),pointer :: DH + integer ,intent(IN) :: Comm + integer ,intent(out) :: Status + integer :: i + integer :: stat + + do i=1,WrfDataHandleMax + if(WrfDataHandles(i)%Free) then + DH => WrfDataHandles(i) + DataHandle = i + allocate(DH%Times(MaxTimes), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%DimLengths(MaxDims), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%DimIDs(MaxDims), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%DimNames(MaxDims), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%MDVarIDs(MaxVars), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%MDVarDimLens(MaxVars), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%MDVarNames(MaxVars), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%VarIDs(MaxVars), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%VarDimLens(NVarDims-1,MaxVars), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + allocate(DH%VarNames(MaxVars), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + exit + endif + if(i==WrfDataHandleMax) then + Status = WRF_WARN_TOO_MANY_FILES + write(msg,*) 'Warning TOO MANY FILES in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + write(msg,*) 'Did you call ext_ncdpar_ioinit?' + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + DH%Free =.false. + DH%Comm = Comm + DH%Write =.false. + DH%first_operation = .TRUE. + DH%R4OnOutput = .false. + DH%nofill = .false. + DH%Collective = .TRUE. + DH%ind_or_collective = NF_COLLECTIVE + Status = WRF_NO_ERR +end subroutine allocHandle + +subroutine deallocHandle(DataHandle, Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: i + integer :: stat + + IF ( DataHandle .GE. 1 .AND. DataHandle .LE. WrfDataHandleMax ) THEN + if(.NOT. WrfDataHandles(DataHandle)%Free) then + DH => WrfDataHandles(DataHandle) + deallocate(DH%Times, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%DimLengths, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%DimIDs, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%DimNames, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%MDVarIDs, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%MDVarDimLens, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%MDVarNames, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%VarIDs, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%VarDimLens, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + deallocate(DH%VarNames, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + DH%Free =.TRUE. + endif + ENDIF + Status = WRF_NO_ERR +end subroutine deallocHandle + +subroutine GetDH(DataHandle,DH,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + type(wrf_data_handle) ,pointer :: DH + integer ,intent(out) :: Status + + if(DataHandle < 1 .or. DataHandle > WrfDataHandleMax) then + Status = WRF_WARN_BAD_DATA_HANDLE + return + endif + DH => WrfDataHandles(DataHandle) + if(DH%Free) then + Status = WRF_WARN_BAD_DATA_HANDLE + return + endif + Status = WRF_NO_ERR + return +end subroutine GetDH + +subroutine DateCheck(Date,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: Date + integer ,intent(out) :: Status + + if(len(Date) /= DateStrLen) then + Status = WRF_WARN_DATESTR_BAD_LENGTH + else + Status = WRF_NO_ERR + endif + return +end subroutine DateCheck + +subroutine GetName(Element,Var,Name,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: Var + character*(*) ,intent(out) :: Name + integer ,intent(out) :: Status + character (VarNameLen) :: VarName + character (1) :: c + integer :: i + integer, parameter :: upper_to_lower =IACHAR('a')-IACHAR('A') + + VarName = Var + Name = 'MD___'//trim(Element)//VarName + do i=1,len(Name) + c=Name(i:i) + if('A'<=c .and. c <='Z') Name(i:i)=achar(iachar(c)+upper_to_lower) + if(c=='-'.or.c==':') Name(i:i)='_' + enddo + Status = WRF_NO_ERR + return +end subroutine GetName + +subroutine GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + include 'netcdf.inc' + character (*) ,intent(in) :: IO + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: DateStr + integer ,intent(out) :: TimeIndex + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: VStart(2) + integer :: VCount(2) + integer :: stat + integer :: i + + DH => WrfDataHandles(DataHandle) + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + Status = WRF_WARN_DATESTR_ERROR + write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(IO == 'write') then + TimeIndex = DH%TimeIndex + if(TimeIndex <= 0) then + TimeIndex = 1 + elseif(DateStr == DH%Times(TimeIndex)) then + Status = WRF_NO_ERR + return + else + TimeIndex = TimeIndex +1 + if(TimeIndex > MaxTimes) then + Status = WRF_WARN_TIME_EOF + write(msg,*) 'Warning TIME EOF in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + endif + DH%TimeIndex = TimeIndex + DH%Times(TimeIndex) = DateStr + VStart(1) = 1 + VStart(2) = TimeIndex + VCount(1) = DateStrLen + VCount(2) = 1 + stat = NF_VAR_PAR_ACCESS(DH%NCID,DH%TimesVarID,nf_collective) + stat = NF_PUT_VARA_TEXT(DH%NCID,DH%TimesVarID,VStart,VCount,DateStr) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + else + do i=1,MaxTimes + if(DH%Times(i)==DateStr) then + Status = WRF_NO_ERR + TimeIndex = i + exit + endif + if(i==MaxTimes) then + Status = WRF_WARN_TIME_NF + write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + endif + return +end subroutine GetTimeIndex + +subroutine GetDim(MemoryOrder,NDim,Status) + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: MemoryOrder + integer ,intent(out) :: NDim + integer ,intent(out) :: Status + character*3 :: MemOrd + + call LowerCase(MemoryOrder,MemOrd) + select case (MemOrd) + case ('xyz','xzy','yxz','yzx','zxy','zyx','xsz','xez','ysz','yez') + NDim = 3 + case ('xy','yx','xs','xe','ys','ye','cc') + NDim = 2 + case ('z','c') + NDim = 1 + case ('0') ! NDim=0 for scalars. TBH: 20060502 + NDim = 0 + case default + Status = WRF_WARN_BAD_MEMORYORDER + return + end select + Status = WRF_NO_ERR + return +end subroutine GetDim + +#ifdef USE_NETCDF4_FEATURES +subroutine set_chunking(MemoryOrder,need_chunking) + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: MemoryOrder + integer ,intent(out) :: need_chunking + character*3 :: MemOrd + + call LowerCase(MemoryOrder,MemOrd) + if(len(MemOrd) >= 2) then + select case (MemOrd) + case ('xyz','xzy','yxz','yzx','zxy','zyx','xsz','xez','ysz','yez') + need_chunking = 3 + case ('xy','yx') + need_chunking = 2 + case default + need_chunking = 0 + return + end select + endif +end subroutine set_chunking +#endif + +subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2) + integer ,intent(in) :: NDim + integer ,dimension(*),intent(in) :: Start,End + integer ,intent(out) :: i1,i2,j1,j2,k1,k2 + + i1=1 + i2=1 + j1=1 + j2=1 + k1=1 + k2=1 + if(NDim == 0) return ! NDim=0 for scalars. TBH: 20060502 + i1 = Start(1) + i2 = End (1) + if(NDim == 1) return + j1 = Start(2) + j2 = End (2) + if(NDim == 2) return + k1 = Start(3) + k2 = End (3) + return +end subroutine GetIndices + +logical function ZeroLengthHorzDim(MemoryOrder,Vector,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: MemoryOrder + integer,dimension(*) ,intent(in) :: Vector + integer ,intent(out) :: Status + integer :: NDim + integer,dimension(NVarDims) :: temp + character*3 :: MemOrd + logical zero_length + + call GetDim(MemoryOrder,NDim,Status) + temp(1:NDim) = Vector(1:NDim) + call LowerCase(MemoryOrder,MemOrd) + zero_length = .false. + select case (MemOrd) + case ('xsz','xez','ysz','yez','xs','xe','ys','ye','z','c') + continue + case ('0') + continue ! NDim=0 for scalars. TBH: 20060502 + case ('xzy','yzx') + zero_length = temp(1) .lt. 1 .or. temp(3) .lt. 1 + case ('xy','yx','xyz','yxz') + zero_length = temp(1) .lt. 1 .or. temp(2) .lt. 1 + case ('zxy','zyx') + zero_length = temp(2) .lt. 1 .or. temp(3) .lt. 1 + case default + Status = WRF_WARN_BAD_MEMORYORDER + ZeroLengthHorzDim = .true. + return + end select + Status = WRF_NO_ERR + ZeroLengthHorzDim = zero_length + return +end function ZeroLengthHorzDim + +subroutine ExtOrder(MemoryOrder,Vector,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: MemoryOrder + integer,dimension(*) ,intent(inout) :: Vector + integer ,intent(out) :: Status + integer :: NDim + integer,dimension(NVarDims) :: temp + character*3 :: MemOrd + + call GetDim(MemoryOrder,NDim,Status) + temp(1:NDim) = Vector(1:NDim) + call LowerCase(MemoryOrder,MemOrd) + select case (MemOrd) + + case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c') + continue + case ('0') + continue ! NDim=0 for scalars. TBH: 20060502 + case ('xzy') + Vector(2) = temp(3) + Vector(3) = temp(2) + case ('yxz') + Vector(1) = temp(2) + Vector(2) = temp(1) + case ('yzx') + Vector(1) = temp(3) + Vector(2) = temp(1) + Vector(3) = temp(2) + case ('zxy') + Vector(1) = temp(2) + Vector(2) = temp(3) + Vector(3) = temp(1) + case ('zyx') + Vector(1) = temp(3) + Vector(3) = temp(1) + case ('yx') + Vector(1) = temp(2) + Vector(2) = temp(1) + case default + Status = WRF_WARN_BAD_MEMORYORDER + return + end select + Status = WRF_NO_ERR + return +end subroutine ExtOrder + +subroutine ExtOrderStr(MemoryOrder,Vector,ROVector,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + character*(*) ,intent(in) :: MemoryOrder + character*(*),dimension(*) ,intent(in) :: Vector + character(80),dimension(NVarDims),intent(out) :: ROVector + integer ,intent(out) :: Status + integer :: NDim + character*3 :: MemOrd + + call GetDim(MemoryOrder,NDim,Status) + ROVector(1:NDim) = Vector(1:NDim) + call LowerCase(MemoryOrder,MemOrd) + select case (MemOrd) + + case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c') + continue + case ('0') + continue ! NDim=0 for scalars. TBH: 20060502 + case ('xzy') + ROVector(2) = Vector(3) + ROVector(3) = Vector(2) + case ('yxz') + ROVector(1) = Vector(2) + ROVector(2) = Vector(1) + case ('yzx') + ROVector(1) = Vector(3) + ROVector(2) = Vector(1) + ROVector(3) = Vector(2) + case ('zxy') + ROVector(1) = Vector(2) + ROVector(2) = Vector(3) + ROVector(3) = Vector(1) + case ('zyx') + ROVector(1) = Vector(3) + ROVector(3) = Vector(1) + case ('yx') + ROVector(1) = Vector(2) + ROVector(2) = Vector(1) + case default + Status = WRF_WARN_BAD_MEMORYORDER + return + end select + Status = WRF_NO_ERR + return +end subroutine ExtOrderStr + + +subroutine LowerCase(MemoryOrder,MemOrd) + character*(*) ,intent(in) :: MemoryOrder + character*(*) ,intent(out) :: MemOrd + character*1 :: c + integer ,parameter :: upper_to_lower =IACHAR('a')-IACHAR('A') + integer :: i,N + + MemOrd = ' ' + N = len(MemoryOrder) + MemOrd(1:N) = MemoryOrder(1:N) + do i=1,N + c = MemoryOrder(i:i) + if('A'<=c .and. c <='Z') MemOrd(i:i)=achar(iachar(c)+upper_to_lower) + enddo + return +end subroutine LowerCase + +subroutine UpperCase(MemoryOrder,MemOrd) + character*(*) ,intent(in) :: MemoryOrder + character*(*) ,intent(out) :: MemOrd + character*1 :: c + integer ,parameter :: lower_to_upper =IACHAR('A')-IACHAR('a') + integer :: i,N + + MemOrd = ' ' + N = len(MemoryOrder) + MemOrd(1:N) = MemoryOrder(1:N) + do i=1,N + c = MemoryOrder(i:i) + if('a'<=c .and. c <='z') MemOrd(i:i)=achar(iachar(c)+lower_to_upper) + enddo + return +end subroutine UpperCase + +subroutine netcdf_err(err,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: err + integer ,intent(out) :: Status + character(len=180) :: errmsg + integer :: stat + + if( err==NF_NOERR )then + Status = WRF_NO_ERR + else + errmsg = NF_STRERROR(err) + write(msg,*) 'NetCDF error: ',errmsg + call wrf_debug ( WARN , TRIM(msg)) + Status = WRF_WARN_NETCDF + endif + return +end subroutine netcdf_err + +subroutine FieldIO(IO,DataHandle,DateStr,Starts,Length,MemoryOrder & + ,FieldType,NCID,VarID,XField,Status) + use wrf_data_ncpar + include 'wrf_status_codes.h' + include 'netcdf.inc' + character (*) ,intent(in) :: IO + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: DateStr + integer,dimension(NVarDims),intent(in) :: Starts + integer,dimension(NVarDims),intent(in) :: Length + character*(*) ,intent(in) :: MemoryOrder + integer ,intent(in) :: FieldType + integer ,intent(in) :: NCID + integer ,intent(in) :: VarID + integer,dimension(*) ,intent(inout) :: XField + integer ,intent(out) :: Status + integer :: TimeIndex + integer :: NDim + integer,dimension(NVarDims) :: VStart + integer,dimension(NVarDims) :: VCount + + call GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + write(msg,*) ' Bad time index for DateStr = ',DateStr + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call GetDim(MemoryOrder,NDim,Status) +VStart(:) = 1 +VCount(:) = 1 +!jm for parallel netcef VStart(1:NDim) = 1 + VStart(1:NDim) = Starts(1:NDim) + VCount(1:NDim) = Length(1:NDim) + VStart(NDim+1) = TimeIndex + VCount(NDim+1) = 1 + + ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE + IF (FieldType == WRF_REAL) THEN + call ext_ncdpar_RealFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status) + ELSE IF (FieldType == WRF_DOUBLE) THEN + call ext_ncdpar_DoubleFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status) + ELSE IF (FieldType == WRF_INTEGER) THEN + call ext_ncdpar_IntFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status) + ELSE IF (FieldType == WRF_LOGICAL) THEN + call ext_ncdpar_LogicalFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status) + if(Status /= WRF_NO_ERR) return + ELSE +!for wrf_complex, double_complex + Status = WRF_WARN_DATA_TYPE_NOT_FOUND + write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + END IF + + return +end subroutine FieldIO + +subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + character*(*) ,intent(in) :: IO + character*(*) ,intent(in) :: MemoryOrder + integer ,intent(in) :: l1,l2,m1,m2,n1,n2 + integer ,intent(in) :: di + integer ,intent(in) :: x1,x2,y1,y2,z1,z2 + integer ,intent(in) :: i1,i2,j1,j2,k1,k2 + integer ,intent(inout) :: Field(di,l1:l2,m1:m2,n1:n2) +!jm 010827 integer ,intent(inout) :: XField(di,x1:x2,y1:y2,z1:z2) + integer ,intent(inout) :: XField(di,(i2-i1+1)*(j2-j1+1)*(k2-k1+1)) + character*3 :: MemOrd + character*3 :: MemO + integer ,parameter :: MaxUpperCase=IACHAR('Z') + integer :: i,j,k,ix,jx,kx + + call LowerCase(MemoryOrder,MemOrd) + select case (MemOrd) + +!#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) +! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) + + case ('xzy') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(i,k,j)) +#include "transpose.code" + case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c','0') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(i,j,k)) +#include "transpose.code" + case ('yxz') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(j,i,k)) +#include "transpose.code" + case ('zxy') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(k,i,j)) +#include "transpose.code" + case ('yzx') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(j,k,i)) +#include "transpose.code" + case ('zyx') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(k,j,i)) +#include "transpose.code" + case ('yx') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(j,i,k)) +#include "transpose.code" + end select + return +end subroutine Transpose + +subroutine reorder (MemoryOrder,MemO) + character*(*) ,intent(in) :: MemoryOrder + character*3 ,intent(out) :: MemO + character*3 :: MemOrd + integer :: N,i,i1,i2,i3 + + MemO = MemoryOrder + N = len_trim(MemoryOrder) + if(N == 1) return + call lowercase(MemoryOrder,MemOrd) +! never invert the boundary codes + select case ( MemOrd ) + case ( 'xsz','xez','ysz','yez' ) + return + case default + continue + end select + i1 = 1 + i3 = 1 + do i=2,N + if(ichar(MemOrd(i:i)) < ichar(MemOrd(i1:i1))) I1 = i + if(ichar(MemOrd(i:i)) > ichar(MemOrd(i3:i3))) I3 = i + enddo + if(N == 2) then + i2=i3 + else + i2 = 6-i1-i3 + endif + MemO(1:1) = MemoryOrder(i1:i1) + MemO(2:2) = MemoryOrder(i2:i2) + if(N == 3) MemO(3:3) = MemoryOrder(i3:i3) + if(MemOrd(i1:i1) == 's' .or. MemOrd(i1:i1) == 'e') then + MemO(1:N-1) = MemO(2:N) + MemO(N:N ) = MemoryOrder(i1:i1) + endif + return +end subroutine reorder + +! Returns .TRUE. iff it is OK to write time-independent domain metadata to the +! file referenced by DataHandle. If DataHandle is invalid, .FALSE. is +! returned. +LOGICAL FUNCTION ncdpar_ok_to_put_dom_ti( DataHandle ) + USE wrf_data_ncpar + include 'wrf_status_codes.h' + INTEGER, INTENT(IN) :: DataHandle + CHARACTER*80 :: fname + INTEGER :: filestate + INTEGER :: Status + LOGICAL :: dryrun, first_output, retval + call ext_ncdpar_inquire_filename( DataHandle, fname, filestate, Status ) + IF ( Status /= WRF_NO_ERR ) THEN + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, & + ', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg) ) + retval = .FALSE. + ELSE + dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) + first_output = ncdpar_is_first_operation( DataHandle ) + retval = .NOT. dryrun .AND. first_output + ENDIF + ncdpar_ok_to_put_dom_ti = retval + RETURN +END FUNCTION ncdpar_ok_to_put_dom_ti + +! Returns .TRUE. iff it is OK to read time-independent domain metadata from the +! file referenced by DataHandle. If DataHandle is invalid, .FALSE. is +! returned. +LOGICAL FUNCTION ncdpar_ok_to_get_dom_ti( DataHandle ) + USE wrf_data_ncpar + include 'wrf_status_codes.h' + INTEGER, INTENT(IN) :: DataHandle + CHARACTER*80 :: fname + INTEGER :: filestate + INTEGER :: Status + LOGICAL :: dryrun, retval + call ext_ncdpar_inquire_filename( DataHandle, fname, filestate, Status ) + IF ( Status /= WRF_NO_ERR ) THEN + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, & + ', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg) ) + retval = .FALSE. + ELSE + dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED ) + retval = .NOT. dryrun + ENDIF + ncdpar_ok_to_get_dom_ti = retval + RETURN +END FUNCTION ncdpar_ok_to_get_dom_ti + +! Returns .TRUE. iff nothing has been read from or written to the file +! referenced by DataHandle. If DataHandle is invalid, .FALSE. is returned. +LOGICAL FUNCTION ncdpar_is_first_operation( DataHandle ) + USE wrf_data_ncpar + INCLUDE 'wrf_status_codes.h' + INTEGER, INTENT(IN) :: DataHandle + TYPE(wrf_data_handle) ,POINTER :: DH + INTEGER :: Status + LOGICAL :: retval + CALL GetDH( DataHandle, DH, Status ) + IF ( Status /= WRF_NO_ERR ) THEN + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, & + ', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg) ) + retval = .FALSE. + ELSE + retval = DH%first_operation + ENDIF + ncdpar_is_first_operation = retval + RETURN +END FUNCTION ncdpar_is_first_operation + +subroutine upgrade_filename(FileName) + implicit none + + character*(*), intent(inout) :: FileName + integer :: i + + do i = 1, len(trim(FileName)) + if(FileName(i:i) == '-') then + FileName(i:i) = '_' + else if(FileName(i:i) == ':') then + FileName(i:i) = '_' + endif + enddo + +end subroutine upgrade_filename + +end module ext_ncdpar_support_routines + +subroutine TransposeToR4a(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + + use ext_ncdpar_support_routines + + character*(*) ,intent(in) :: IO + character*(*) ,intent(in) :: MemoryOrder + integer ,intent(in) :: l1,l2,m1,m2,n1,n2 + integer ,intent(in) :: di + integer ,intent(in) :: x1,x2,y1,y2,z1,z2 + integer ,intent(in) :: i1,i2,j1,j2,k1,k2 + real*8 ,intent(inout) :: Field(di,l1:l2,m1:m2,n1:n2) + real*4 ,intent(inout) :: XField(di,(i2-i1+1)*(j2-j1+1)*(k2-k1+1)) + character*3 :: MemOrd + character*3 :: MemO + integer ,parameter :: MaxUpperCase=IACHAR('Z') + integer :: i,j,k,ix,jx,kx + + call LowerCase(MemoryOrder,MemOrd) + select case (MemOrd) + +!#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) +! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) + + case ('xzy') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(i,k,j)) +#include "transpose.code" + case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c','0') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(i,j,k)) +#include "transpose.code" + case ('yxz') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(j,i,k)) +#include "transpose.code" + case ('zxy') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(k,i,j)) +#include "transpose.code" + case ('yzx') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(j,k,i)) +#include "transpose.code" + case ('zyx') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(k,j,i)) +#include "transpose.code" + case ('yx') +#undef DFIELD +#define DFIELD XField(1:di,XDEX(j,i,k)) +#include "transpose.code" + end select + return +end subroutine TransposeToR4a + +subroutine ext_ncdpar_open_for_read(DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character *(*), INTENT(IN) :: DatasetName + integer , INTENT(IN) :: Comm1, Comm2 + character *(*), INTENT(IN) :: SysDepInfo + integer , INTENT(OUT) :: DataHandle + integer , INTENT(OUT) :: Status + DataHandle = 0 ! dummy setting to quiet warning message + CALL ext_ncdpar_open_for_read_begin( DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status ) + IF ( Status .EQ. WRF_NO_ERR ) THEN + CALL ext_ncdpar_open_for_read_commit( DataHandle, Status ) + ENDIF + return +end subroutine ext_ncdpar_open_for_read + +!ends training phase; switches internal flag to enable input +!must be paired with call to ext_ncdpar_open_for_read_begin +subroutine ext_ncdpar_open_for_read_commit(DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer, intent(in) :: DataHandle + integer, intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + + if(WrfIOnotInitialized) then + Status = WRF_IO_NOT_INITIALIZED + write(msg,*) 'ext_ncdpar_ioinit was not called ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%FileStatus = WRF_FILE_OPENED_FOR_READ + DH%first_operation = .TRUE. + Status = WRF_NO_ERR + return +end subroutine ext_ncdpar_open_for_read_commit + +subroutine ext_ncdpar_open_for_read_begin( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character*(*) ,intent(INOUT) :: FileName + integer ,intent(IN) :: Comm + integer ,intent(IN) :: IOComm + character*(*) ,intent(in) :: SysDepInfo + integer ,intent(out) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: XType + integer :: stat + integer ,allocatable :: Buffer(:) + integer :: VarID + integer :: StoredDim + integer :: NAtts + integer :: DimIDs(2) + integer :: VStart(2) + integer :: VLen(2) + integer :: TotalNumVars + integer :: NumVars + integer :: i + character (NF_MAX_NAME) :: Name + +#ifdef USE_NETCDF4_FEATURES + integer :: open_mode +#endif + + !call upgrade_filename(FileName) + + if(WrfIOnotInitialized) then + Status = WRF_IO_NOT_INITIALIZED + write(msg,*) 'ext_ncdpar_ioinit was not called ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + call allocHandle(DataHandle,DH,Comm,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + +! stat = NF_OPEN_PAR(FileName, NF_NOWRITE, comm, MPI_INFO_NULL, DH%NCID) + stat = NF_OPEN(FileName, NF_NOWRITE, DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VARID(DH%NCID,DH%TimesName,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(XType/=NF_CHAR) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(VLen(1) /= DateStrLen) then + Status = WRF_WARN_DATESTR_BAD_LENGTH + write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(VLen(2) > MaxTimes) then + Status = WRF_ERR_FATAL_TOO_MANY_TIMES + write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + VStart(1) = 1 + VStart(2) = 1 + stat = NF_GET_VARA_TEXT(DH%NCID,VarID,VStart,VLen,DH%Times) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_NVARS(DH%NCID,TotalNumVars) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + NumVars = 0 + do i=1,TotalNumVars + stat = NF_INQ_VARNAME(DH%NCID,i,Name) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then + NumVars = NumVars+1 + DH%VarNames(NumVars) = Name + DH%VarIDs(NumVars) = i + endif + enddo + DH%NumVars = NumVars + DH%NumberTimes = VLen(2) + DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED + DH%FileName = trim(FileName) + DH%CurrentVariable = 0 + DH%CurrentTime = 0 + DH%TimesVarID = VarID + DH%TimeIndex = 0 + return +end subroutine ext_ncdpar_open_for_read_begin + +subroutine ext_ncdpar_open_for_update( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character*(*) ,intent(INOUT) :: FileName + integer ,intent(IN) :: Comm + integer ,intent(IN) :: IOComm + character*(*) ,intent(in) :: SysDepInfo + integer ,intent(out) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: XType + integer :: stat + integer ,allocatable :: Buffer(:) + integer :: VarID + integer :: StoredDim + integer :: NAtts + integer :: DimIDs(2) + integer :: VStart(2) + integer :: VLen(2) + integer :: TotalNumVars + integer :: NumVars + integer :: i + character (NF_MAX_NAME) :: Name + +!#ifdef USE_NETCDF4_FEATURES + integer :: open_mode +!#endif + + !call upgrade_filename(FileName) + + if(WrfIOnotInitialized) then + Status = WRF_IO_NOT_INITIALIZED + write(msg,*) 'ext_ncdpar_ioinit was not called ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + call allocHandle(DataHandle,DH,Comm,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif +! stat = NF_OPEN(FileName, NF_WRITE, DH%NCID) + open_mode = ior(NF_MPIIO, NF_WRITE) + stat = NF_OPEN_PAR(FileName, open_mode, comm, MPI_INFO_NULL, DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VARID(DH%NCID,DH%TimesName,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(XType/=NF_CHAR) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(VLen(1) /= DateStrLen) then + Status = WRF_WARN_DATESTR_BAD_LENGTH + write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(VLen(2) > MaxTimes) then + Status = WRF_ERR_FATAL_TOO_MANY_TIMES + write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + VStart(1) = 1 + VStart(2) = 1 + stat = NF_GET_VARA_TEXT(DH%NCID,VarID,VStart,VLen,DH%Times) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_NVARS(DH%NCID,TotalNumVars) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + NumVars = 0 + do i=1,TotalNumVars + stat = NF_INQ_VARNAME(DH%NCID,i,Name) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then + NumVars = NumVars+1 + DH%VarNames(NumVars) = Name + DH%VarIDs(NumVars) = i + endif + enddo + DH%NumVars = NumVars + DH%NumberTimes = VLen(2) + DH%FileStatus = WRF_FILE_OPENED_FOR_UPDATE + DH%FileName = trim(FileName) + DH%CurrentVariable = 0 + DH%CurrentTime = 0 + DH%TimesVarID = VarID + DH%TimeIndex = 0 + return +end subroutine ext_ncdpar_open_for_update + + +SUBROUTINE ext_ncdpar_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character*(*) ,intent(inout) :: FileName + integer ,intent(in) :: Comm + integer ,intent(in) :: IOComm + character*(*) ,intent(in) :: SysDepInfo + integer ,intent(out) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: i + integer :: stat + character (7) :: Buffer + integer :: VDimIDs(2) + +#ifdef USE_NETCDF4_FEATURES + integer :: create_mode + integer, parameter :: cache_size = 32, & + cache_nelem = 37, & + cache_preemption = 100 +#endif + + !call upgrade_filename(FileName) + + if(WrfIOnotInitialized) then + Status = WRF_IO_NOT_INITIALIZED + write(msg,*) 'ext_ncdpar_open_for_write_begin: ext_ncdpar_ioinit was not called ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + call allocHandle(DataHandle,DH,Comm,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Fatal ALLOCATION ERROR in ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + DH%TimeIndex = 0 + DH%Times = ZeroDate + ! create_mode = ior(NF90_NETCDF4,nf90_iotype) + create_mode = IOR(nf_netcdf4, nf_classic_model) + create_mode = IOR(create_mode, nf_mpiio) + +#ifdef USE_NETCDF4_FEATURES +! create_mode = IOR(nf_netcdf4, nf_classic_model) + if ( DH%use_netcdf_classic ) then + write(msg,*) 'output will be in classic NetCDF format' + call wrf_debug ( WARN , TRIM(msg)) +#ifdef WRFIO_ncdpar_NO_LARGE_FILE_SUPPORT +! stat = NF_CREATE(FileName, NF_CLOBBER, DH%NCID) + create_mode = IOR(create_mode, NF_CLOBBER) + stat = NF_CREATE_PAR(FileName, create_mode, comm, MPI_INFO_NULL, DH%NCID) +! stat = NF_OPEN_PAR(FileName, NF_NOWRITE, comm, MPI_INFO_NULL, DH%NCID) +#else +! stat = NF_CREATE(FileName, IOR(NF_CLOBBER,NF_64BIT_OFFSET), DH%NCID) +! stat = NF_CREATE_PAR(FileName, IOR(NF_CLOBBER,NF_64BIT_OFFSET), comm, MPI_INFO_NULL, DH%NCID) + stat = NF_CREATE_PAR(FileName, create_mode, comm, MPI_INFO_NULL, DH%NCID) +#endif + else + ! create_mode = nf_netcdf4 +! stat = NF_CREATE(FileName, create_mode, DH%NCID) + stat = NF_CREATE_PAR(FileName, create_mode, comm, MPI_INFO_NULL, DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in NF_CREATE_PAR ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_SET_CHUNK_CACHE(cache_size, cache_nelem, cache_preemption) + endif +#else +#ifdef WRFIO_ncdpar_NO_LARGE_FILE_SUPPORT + stat = NF_CREATE(FileName, NF_CLOBBER, DH%NCID) +#else + stat = NF_CREATE(FileName, IOR(NF_CLOBBER,NF_64BIT_OFFSET), DH%NCID) +#endif +#endif + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED + DH%FileName = trim(FileName) + stat = NF_DEF_DIM(DH%NCID,DH%DimUnlimName,NF_UNLIMITED,DH%DimUnlimID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%VarNames (1:MaxVars) = NO_NAME + DH%MDVarNames(1:MaxVars) = NO_NAME + do i=1,MaxDims + write(Buffer,FMT="('DIM',i4.4)") i + DH%DimNames (i) = Buffer + DH%DimLengths(i) = NO_DIM + enddo + DH%DimNames(1) = 'DateStrLen' + stat = NF_DEF_DIM(DH%NCID,DH%DimNames(1),DateStrLen,DH%DimIDs(1)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + VDimIDs(1) = DH%DimIDs(1) + VDimIDs(2) = DH%DimUnlimID + stat = NF_DEF_VAR(DH%NCID,DH%TimesName,NF_CHAR,2,VDimIDs,DH%TimesVarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_open_for_write_begin ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%DimLengths(1) = DateStrLen + + if (index(SysDepInfo,'REAL_OUTPUT_SIZE=4') /= 0) then + DH%R4OnOutput = .true. + end if +!toggle on nofill mode + if (index(SysDepInfo,'NOFILL=.TRUE.') /= 0) then + DH%nofill = .true. + end if + + return +end subroutine ext_ncdpar_open_for_write_begin + +!stub +!opens a file for writing or coupler datastream for sending messages. +!no training phase for this version of the open stmt. +subroutine ext_ncdpar_open_for_write (DatasetName, Comm1, Comm2, & + SysDepInfo, DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + character *(*), intent(in) ::DatasetName + integer , intent(in) ::Comm1, Comm2 + character *(*), intent(in) ::SysDepInfo + integer , intent(out) :: DataHandle + integer , intent(out) :: Status + Status=WRF_WARN_NOOP + DataHandle = 0 ! dummy setting to quiet warning message + return +end subroutine ext_ncdpar_open_for_write + +SUBROUTINE ext_ncdpar_open_for_write_commit(DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: i + integer :: stat + integer :: oldmode ! for nf_set_fill, not used + + if(WrfIOnotInitialized) then + Status = WRF_IO_NOT_INITIALIZED + write(msg,*) 'ext_ncdpar_open_for_write_commit: ext_ncdpar_ioinit was not called ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ext_ncdpar_open_for_write_commit ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if ( DH%nofill ) then + Status = NF_SET_FILL(DH%NCID,NF_NOFILL, oldmode ) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' from NF_SET_FILL ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + write(msg,*) 'Information: NOFILL being set for writing to ',TRIM(DH%FileName) + call wrf_debug ( WARN , TRIM(msg)) + endif + stat = NF_ENDDEF(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_open_for_write_commit ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%FileStatus = WRF_FILE_OPENED_FOR_WRITE + DH%first_operation = .TRUE. + return +end subroutine ext_ncdpar_open_for_write_commit + +subroutine ext_ncdpar_ioclose(DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: stat + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ext_ncdpar_ioclose ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ext_ncdpar_ioclose ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_CLOSE + write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ext_ncdpar_ioclose ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + continue + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + continue + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + continue + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ext_ncdpar_ioclose ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + + stat = NF_CLOSE(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_ioclose ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + CALL deallocHandle( DataHandle, Status ) + DH%Free=.true. + return +end subroutine ext_ncdpar_ioclose + +subroutine ext_ncdpar_iosync( DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: stat + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ext_ncdpar_iosync ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ext_ncdpar_iosync ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_FILE_NOT_COMMITTED + write(msg,*) 'Warning FILE NOT COMMITTED in ext_ncdpar_iosync ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + continue + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + continue + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ext_ncdpar_iosync ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + stat = NF_SYNC(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ext_ncdpar_iosync ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + return +end subroutine ext_ncdpar_iosync + + + +subroutine ext_ncdpar_redef( DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: stat + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_FILE_NOT_COMMITTED + write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + continue + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + continue + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + Status = WRF_WARN_FILE_OPEN_FOR_READ + write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + stat = NF_REDEF(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED + return +end subroutine ext_ncdpar_redef + +subroutine ext_ncdpar_enddef( DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle),pointer :: DH + integer :: stat + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_FILE_NOT_COMMITTED + write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + continue + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + Status = WRF_WARN_FILE_OPEN_FOR_READ + write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + stat = NF_ENDDEF(DH%NCID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%FileStatus = WRF_FILE_OPENED_FOR_WRITE + return +end subroutine ext_ncdpar_enddef + +subroutine ext_ncdpar_ioinit(SysDepInfo, Status) + use wrf_data_ncpar + implicit none + include 'wrf_status_codes.h' + CHARACTER*(*), INTENT(IN) :: SysDepInfo + INTEGER ,INTENT(INOUT) :: Status + + WrfIOnotInitialized = .false. + WrfDataHandles(1:WrfDataHandleMax)%Free = .true. + WrfDataHandles(1:WrfDataHandleMax)%TimesName = 'Times' + WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time' + WrfDataHandles(1:WrfDataHandleMax)%FileStatus = WRF_FILE_NOT_OPENED +! if(trim(SysDepInfo) == "use_netcdf_classic" ) then +! WrfDataHandles(1:WrfDataHandleMax)%use_netcdf_classic = .true. +! else + WrfDataHandles(1:WrfDataHandleMax)%use_netcdf_classic = .false. +! endif + Status = WRF_NO_ERR + return +end subroutine ext_ncdpar_ioinit + + +subroutine ext_ncdpar_inquiry (Inquiry, Result, Status) + use wrf_data_ncpar + implicit none + include 'wrf_status_codes.h' + character *(*), INTENT(IN) :: Inquiry + character *(*), INTENT(OUT) :: Result + integer ,INTENT(INOUT) :: Status + SELECT CASE (Inquiry) + CASE ("RANDOM_WRITE","RANDOM_READ","SEQUENTIAL_WRITE","SEQUENTIAL_READ") + Result='ALLOW' + CASE ("OPEN_READ","OPEN_COMMIT_WRITE") + Result='REQUIRE' + CASE ("OPEN_WRITE","OPEN_COMMIT_READ","PARALLEL_IO") + Result='NO' + CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS") + Result='YES' + CASE ("MEDIUM") + Result ='FILE' + CASE DEFAULT + Result = 'No Result for that inquiry!' + END SELECT + Status=WRF_NO_ERR + return +end subroutine ext_ncdpar_inquiry + + + + +subroutine ext_ncdpar_ioexit(Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer , INTENT(INOUT) ::Status + integer :: error + type(wrf_data_handle),pointer :: DH + integer :: i + integer :: stat + if(WrfIOnotInitialized) then + Status = WRF_IO_NOT_INITIALIZED + write(msg,*) 'ext_ncdpar_ioinit was not called ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + do i=1,WrfDataHandleMax + CALL deallocHandle( i , stat ) + enddo + return +end subroutine ext_ncdpar_ioexit + +subroutine ext_ncdpar_get_dom_ti_real(DataHandle,Element,Data,Count,OutCount,Status) +#define ROUTINE_TYPE 'REAL' +#define TYPE_DATA real,intent(out) :: Data(*) +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCOunt +#define TYPE_BUFFER real,allocatable :: Buffer(:) +#define NF_TYPE NF_FLOAT +#define NF_ROUTINE NF_GET_ATT_REAL +#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count)) +#include "ext_ncdpar_get_dom_ti.code" +end subroutine ext_ncdpar_get_dom_ti_real + +subroutine ext_ncdpar_get_dom_ti_integer(DataHandle,Element,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'INTEGER' +#define TYPE_DATA integer,intent(out) :: Data(*) +#define TYPE_BUFFER integer,allocatable :: Buffer(:) +#define NF_TYPE NF_INT +#define NF_ROUTINE NF_GET_ATT_INT +#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count)) +#include "ext_ncdpar_get_dom_ti.code" +end subroutine ext_ncdpar_get_dom_ti_integer + +subroutine ext_ncdpar_get_dom_ti_double(DataHandle,Element,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'DOUBLE' +#define TYPE_DATA real*8,intent(out) :: Data(*) +#define TYPE_BUFFER real*8,allocatable :: Buffer(:) +#define NF_TYPE NF_DOUBLE +#define NF_ROUTINE NF_GET_ATT_DOUBLE +#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count)) +#include "ext_ncdpar_get_dom_ti.code" +end subroutine ext_ncdpar_get_dom_ti_double + +subroutine ext_ncdpar_get_dom_ti_logical(DataHandle,Element,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'LOGICAL' +#define TYPE_DATA logical,intent(out) :: Data(*) +#define TYPE_BUFFER integer,allocatable :: Buffer(:) +#define NF_TYPE NF_INT +#define NF_ROUTINE NF_GET_ATT_INT +#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))==1 +#include "ext_ncdpar_get_dom_ti.code" +end subroutine ext_ncdpar_get_dom_ti_logical + +subroutine ext_ncdpar_get_dom_ti_char(DataHandle,Element,Data,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef TYPE_BUFFER +#undef NF_TYPE +#define ROUTINE_TYPE 'CHAR' +#define TYPE_DATA character*(*),intent(out) :: Data +#define TYPE_COUNT +#define TYPE_OUTCOUNT +#define TYPE_BUFFER +#define NF_TYPE NF_CHAR +#define CHAR_TYPE +#include "ext_ncdpar_get_dom_ti.code" +#undef CHAR_TYPE +end subroutine ext_ncdpar_get_dom_ti_char + +subroutine ext_ncdpar_put_dom_ti_real(DataHandle,Element,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'REAL' +#define TYPE_DATA real ,intent(in) :: Data(*) +#define TYPE_COUNT integer,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_REAL +#define ARGS NF_FLOAT,Count,Data +#include "ext_ncdpar_put_dom_ti.code" +end subroutine ext_ncdpar_put_dom_ti_real + +subroutine ext_ncdpar_put_dom_ti_integer(DataHandle,Element,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'INTEGER' +#define TYPE_DATA integer,intent(in) :: Data(*) +#define TYPE_COUNT integer,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_INT +#define ARGS NF_INT,Count,Data +#include "ext_ncdpar_put_dom_ti.code" +end subroutine ext_ncdpar_put_dom_ti_integer + +subroutine ext_ncdpar_put_dom_ti_double(DataHandle,Element,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'DOUBLE' +#define TYPE_DATA real*8 ,intent(in) :: Data(*) +#define TYPE_COUNT integer,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_DOUBLE +#define ARGS NF_DOUBLE,Count,Data +#include "ext_ncdpar_put_dom_ti.code" +end subroutine ext_ncdpar_put_dom_ti_double + +subroutine ext_ncdpar_put_dom_ti_logical(DataHandle,Element,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#define ROUTINE_TYPE 'LOGICAL' +#define TYPE_DATA logical,intent(in) :: Data(*) +#define TYPE_COUNT integer,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_INT +#define ARGS NF_INT,Count,Buffer +#define LOG +#include "ext_ncdpar_put_dom_ti.code" +end subroutine ext_ncdpar_put_dom_ti_logical + +subroutine ext_ncdpar_put_dom_ti_char(DataHandle,Element,Data,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'CHAR' +#define TYPE_DATA character*(*),intent(in) :: Data +#define TYPE_COUNT integer,parameter :: Count=1 +#define NF_ROUTINE NF_PUT_ATT_TEXT +#define ARGS len_trim(Data),Data +#include "ext_ncdpar_put_dom_ti.code" +end subroutine ext_ncdpar_put_dom_ti_char + +subroutine ext_ncdpar_put_var_ti_real(DataHandle,Element,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'REAL' +#define TYPE_DATA real ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_REAL +#define ARGS NF_FLOAT,Count,Data +#include "ext_ncdpar_put_var_ti.code" +end subroutine ext_ncdpar_put_var_ti_real + +subroutine ext_ncdpar_put_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef NF_TYPE +#undef LENGTH +#undef ARG +#undef LOG +#define ROUTINE_TYPE 'REAL' +#define TYPE_DATA real ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_VARA_REAL +#define NF_TYPE NF_FLOAT +#define LENGTH Count +#define ARG +#include "ext_ncdpar_put_var_td.code" +end subroutine ext_ncdpar_put_var_td_real + +subroutine ext_ncdpar_put_var_ti_double(DataHandle,Element,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'DOUBLE' +#define TYPE_DATA real*8 ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_DOUBLE +#define ARGS NF_DOUBLE,Count,Data +#include "ext_ncdpar_put_var_ti.code" +end subroutine ext_ncdpar_put_var_ti_double + +subroutine ext_ncdpar_put_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef NF_TYPE +#undef LENGTH +#undef ARG +#undef LOG +#define ROUTINE_TYPE 'DOUBLE' +#define TYPE_DATA real*8,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_VARA_DOUBLE +#define NF_TYPE NF_DOUBLE +#define LENGTH Count +#define ARG +#include "ext_ncdpar_put_var_td.code" +end subroutine ext_ncdpar_put_var_td_double + +subroutine ext_ncdpar_put_var_ti_integer(DataHandle,Element,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'INTEGER' +#define TYPE_DATA integer ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_INT +#define ARGS NF_INT,Count,Data +#include "ext_ncdpar_put_var_ti.code" +end subroutine ext_ncdpar_put_var_ti_integer + +subroutine ext_ncdpar_put_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef NF_TYPE +#undef LENGTH +#undef ARG +#undef LOG +#define ROUTINE_TYPE 'INTEGER' +#define TYPE_DATA integer ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_VARA_INT +#define NF_TYPE NF_INT +#define LENGTH Count +#define ARG +#include "ext_ncdpar_put_var_td.code" +end subroutine ext_ncdpar_put_var_td_integer + +subroutine ext_ncdpar_put_var_ti_logical(DataHandle,Element,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#define ROUTINE_TYPE 'LOGICAL' +#define TYPE_DATA logical ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_ATT_INT +#define LOG +#define ARGS NF_INT,Count,Buffer +#include "ext_ncdpar_put_var_ti.code" +end subroutine ext_ncdpar_put_var_ti_logical + +subroutine ext_ncdpar_put_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef NF_TYPE +#undef LENGTH +#undef ARG +#define ROUTINE_TYPE 'LOGICAL' +#define TYPE_DATA logical ,intent(in) :: Data(*) +#define TYPE_COUNT integer ,intent(in) :: Count +#define NF_ROUTINE NF_PUT_VARA_INT +#define NF_TYPE NF_INT +#define LOG +#define LENGTH Count +#define ARG +#include "ext_ncdpar_put_var_td.code" +end subroutine ext_ncdpar_put_var_td_logical + +subroutine ext_ncdpar_put_var_ti_char(DataHandle,Element,Var,Data,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef ARGS +#undef LOG +#define ROUTINE_TYPE 'CHAR' +#define TYPE_DATA character*(*) ,intent(in) :: Data +#define TYPE_COUNT +#define NF_ROUTINE NF_PUT_ATT_TEXT +#define ARGS len_trim(Data),trim(Data) +#define CHAR_TYPE +#include "ext_ncdpar_put_var_ti.code" +#undef CHAR_TYPE +end subroutine ext_ncdpar_put_var_ti_char + +subroutine ext_ncdpar_put_var_td_char(DataHandle,Element,DateStr,Var,Data,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_COUNT +#undef NF_ROUTINE +#undef NF_TYPE +#undef LENGTH +#undef ARG +#undef LOG +#define ROUTINE_TYPE 'CHAR' +#define TYPE_DATA character*(*) ,intent(in) :: Data +#define TYPE_COUNT +#define NF_ROUTINE NF_PUT_VARA_TEXT +#define NF_TYPE NF_CHAR +#define LENGTH len(Data) +#include "ext_ncdpar_put_var_td.code" +end subroutine ext_ncdpar_put_var_td_char + +subroutine ext_ncdpar_get_var_ti_real(DataHandle,Element,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'REAL' +#define TYPE_DATA real ,intent(out) :: Data(*) +#define TYPE_BUFFER real ,allocatable :: Buffer(:) +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_FLOAT +#define NF_ROUTINE NF_GET_ATT_REAL +#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count)) +#include "ext_ncdpar_get_var_ti.code" +end subroutine ext_ncdpar_get_var_ti_real + +subroutine ext_ncdpar_get_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef LENGTH +#undef COPY +#define ROUTINE_TYPE 'REAL' +#define TYPE_DATA real ,intent(out) :: Data(*) +#define TYPE_BUFFER real +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_FLOAT +#define NF_ROUTINE NF_GET_VARA_REAL +#define LENGTH min(Count,Len1) +#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count)) +#include "ext_ncdpar_get_var_td.code" +end subroutine ext_ncdpar_get_var_td_real + +subroutine ext_ncdpar_get_var_ti_double(DataHandle,Element,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'DOUBLE' +#define TYPE_DATA real*8 ,intent(out) :: Data(*) +#define TYPE_BUFFER real*8 ,allocatable :: Buffer(:) +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_DOUBLE +#define NF_ROUTINE NF_GET_ATT_DOUBLE +#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count)) +#include "ext_ncdpar_get_var_ti.code" +end subroutine ext_ncdpar_get_var_ti_double + +subroutine ext_ncdpar_get_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef LENGTH +#undef COPY +#define ROUTINE_TYPE 'DOUBLE' +#define TYPE_DATA real*8 ,intent(out) :: Data(*) +#define TYPE_BUFFER real*8 +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_DOUBLE +#define NF_ROUTINE NF_GET_VARA_DOUBLE +#define LENGTH min(Count,Len1) +#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count)) +#include "ext_ncdpar_get_var_td.code" +end subroutine ext_ncdpar_get_var_td_double + +subroutine ext_ncdpar_get_var_ti_integer(DataHandle,Element,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'INTEGER' +#define TYPE_DATA integer,intent(out) :: Data(*) +#define TYPE_BUFFER integer,allocatable :: Buffer(:) +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_INT +#define NF_ROUTINE NF_GET_ATT_INT +#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count)) +#include "ext_ncdpar_get_var_ti.code" +end subroutine ext_ncdpar_get_var_ti_integer + +subroutine ext_ncdpar_get_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef LENGTH +#undef COPY +#define ROUTINE_TYPE 'INTEGER' +#define TYPE_DATA integer,intent(out) :: Data(*) +#define TYPE_BUFFER integer +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_INT +#define NF_ROUTINE NF_GET_VARA_INT +#define LENGTH min(Count,Len1) +#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count)) +#include "ext_ncdpar_get_var_td.code" +end subroutine ext_ncdpar_get_var_td_integer + +subroutine ext_ncdpar_get_var_ti_logical(DataHandle,Element,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'LOGICAL' +#define TYPE_DATA logical,intent(out) :: Data(*) +#define TYPE_BUFFER integer,allocatable :: Buffer(:) +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_INT +#define NF_ROUTINE NF_GET_ATT_INT +#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))==1 +#include "ext_ncdpar_get_var_ti.code" +end subroutine ext_ncdpar_get_var_ti_logical + +subroutine ext_ncdpar_get_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef LENGTH +#undef COPY +#define ROUTINE_TYPE 'LOGICAL' +#define TYPE_DATA logical,intent(out) :: Data(*) +#define TYPE_BUFFER integer +#define TYPE_COUNT integer,intent(in) :: Count +#define TYPE_OUTCOUNT integer,intent(out) :: OutCount +#define NF_TYPE NF_INT +#define NF_ROUTINE NF_GET_VARA_INT +#define LENGTH min(Count,Len1) +#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))==1 +#include "ext_ncdpar_get_var_td.code" +end subroutine ext_ncdpar_get_var_td_logical + +subroutine ext_ncdpar_get_var_ti_char(DataHandle,Element,Var,Data,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef COPY +#define ROUTINE_TYPE 'CHAR' +#define TYPE_DATA character*(*) ,intent(out) :: Data +#define TYPE_BUFFER +#define TYPE_COUNT integer :: Count = 1 +#define TYPE_OUTCOUNT +#define NF_TYPE NF_CHAR +#define NF_ROUTINE NF_GET_ATT_TEXT +#define COPY +#define CHAR_TYPE +#include "ext_ncdpar_get_var_ti.code" +#undef CHAR_TYPE +end subroutine ext_ncdpar_get_var_ti_char + +subroutine ext_ncdpar_get_var_td_char(DataHandle,Element,DateStr,Var,Data,Status) +#undef ROUTINE_TYPE +#undef TYPE_DATA +#undef TYPE_BUFFER +#undef TYPE_COUNT +#undef TYPE_OUTCOUNT +#undef NF_TYPE +#undef NF_ROUTINE +#undef LENGTH +#define ROUTINE_TYPE 'CHAR' +#define TYPE_DATA character*(*) ,intent(out) :: Data +#define TYPE_BUFFER character (80) +#define TYPE_COUNT integer :: Count = 1 +#define TYPE_OUTCOUNT +#define NF_TYPE NF_CHAR +#define NF_ROUTINE NF_GET_VARA_TEXT +#define LENGTH Len1 +#define CHAR_TYPE +#include "ext_ncdpar_get_var_td.code" +#undef CHAR_TYPE +end subroutine ext_ncdpar_get_var_td_char + +subroutine ext_ncdpar_put_dom_td_real(DataHandle,Element,DateStr,Data,Count,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + real ,intent(in) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: Status + + call ext_ncdpar_put_var_td_real(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) + return +end subroutine ext_ncdpar_put_dom_td_real + +subroutine ext_ncdpar_put_dom_td_integer(DataHandle,Element,DateStr,Data,Count,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + integer ,intent(in) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: Status + + call ext_ncdpar_put_var_td_integer(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) + return +end subroutine ext_ncdpar_put_dom_td_integer + +subroutine ext_ncdpar_put_dom_td_double(DataHandle,Element,DateStr,Data,Count,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + real*8 ,intent(in) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: Status + + call ext_ncdpar_put_var_td_double(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) + return +end subroutine ext_ncdpar_put_dom_td_double + +subroutine ext_ncdpar_put_dom_td_logical(DataHandle,Element,DateStr,Data,Count,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + logical ,intent(in) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: Status + + call ext_ncdpar_put_var_td_logical(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) + return +end subroutine ext_ncdpar_put_dom_td_logical + +subroutine ext_ncdpar_put_dom_td_char(DataHandle,Element,DateStr,Data,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + character*(*) ,intent(in) :: Data + integer ,intent(out) :: Status + + call ext_ncdpar_put_var_td_char(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status) + return +end subroutine ext_ncdpar_put_dom_td_char + +subroutine ext_ncdpar_get_dom_td_real(DataHandle,Element,DateStr,Data,Count,OutCount,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + real ,intent(out) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: OutCount + integer ,intent(out) :: Status + call ext_ncdpar_get_var_td_real(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) + return +end subroutine ext_ncdpar_get_dom_td_real + +subroutine ext_ncdpar_get_dom_td_integer(DataHandle,Element,DateStr,Data,Count,OutCount,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + integer ,intent(out) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: OutCount + integer ,intent(out) :: Status + call ext_ncdpar_get_var_td_integer(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) + return +end subroutine ext_ncdpar_get_dom_td_integer + +subroutine ext_ncdpar_get_dom_td_double(DataHandle,Element,DateStr,Data,Count,OutCount,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + real*8 ,intent(out) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: OutCount + integer ,intent(out) :: Status + call ext_ncdpar_get_var_td_double(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) + return +end subroutine ext_ncdpar_get_dom_td_double + +subroutine ext_ncdpar_get_dom_td_logical(DataHandle,Element,DateStr,Data,Count,OutCount,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + logical ,intent(out) :: Data(*) + integer ,intent(in) :: Count + integer ,intent(out) :: OutCount + integer ,intent(out) :: Status + call ext_ncdpar_get_var_td_logical(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) + return +end subroutine ext_ncdpar_get_dom_td_logical + +subroutine ext_ncdpar_get_dom_td_char(DataHandle,Element,DateStr,Data,Status) + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Element + character*(*) ,intent(in) :: DateStr + character*(*) ,intent(out) :: Data + integer ,intent(out) :: Status + call ext_ncdpar_get_var_td_char(DataHandle,Element,DateStr, & + 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status) + return +end subroutine ext_ncdpar_get_dom_td_char + +subroutine ext_ncdpar_write_field(DataHandle,DateStr,Var,Field,FieldTypeIn, & + Comm, IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames, & + DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: DateStr + character*(*) ,intent(in) :: Var + integer ,intent(inout) :: Field(*) + integer ,intent(in) :: FieldTypeIn + integer ,intent(inout) :: Comm + integer ,intent(inout) :: IOComm + integer ,intent(in) :: DomainDesc + character*(*) ,intent(in) :: MemoryOrdIn + character*(*) ,intent(in) :: Stagger ! Dummy for now + character*(*) ,dimension(*) ,intent(in) :: DimNames + integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd + integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd + integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd + integer ,intent(out) :: Status + integer :: FieldType + character (3) :: MemoryOrder + type(wrf_data_handle) ,pointer :: DH + integer :: NCID + integer :: NDim + character (VarNameLen) :: VarName + character (3) :: MemO + character (3) :: UCMemO + integer :: VarID + integer ,dimension(NVarDims) :: Length_global, Length_native + integer ,dimension(NVarDims) :: Length + integer ,dimension(NVarDims) :: VDimIDs + character(80),dimension(NVarDims) :: RODimNames + integer ,dimension(NVarDims) :: StoredStart + integer ,dimension(:,:,:,:),allocatable :: XField + integer :: stat + integer :: NVar + integer :: i,j + integer :: i1,i2,j1,j2,k1,k2 + integer :: x1,x2,y1,y2,z1,z2 + integer :: p1,p2,q1,q2,r1,r2 + integer :: l1,l2,m1,m2,n1,n2 + integer :: XType + integer :: di + character (80) :: NullName + logical :: NotFound + ! Local, possibly adjusted, copies of MemoryStart and MemoryEnd + integer ,dimension(NVarDims) :: lMemoryStart, lMemoryEnd + +#ifdef USE_NETCDF4_FEATURES + integer, parameter :: cache_size = 32000000 + integer,dimension(NVarDims) :: chunks + integer :: need_chunking + integer :: compression_level + integer :: block_size +#endif + integer :: mpi_error_code + + MemoryOrder = trim(adjustl(MemoryOrdIn)) + NullName=char(0) + call GetDim(MemoryOrder,NDim,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning BAD MEMORY ORDER |',MemoryOrder,'| in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning DATE STRING ERROR |',DateStr,'| in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + VarName = Var + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + NCID = DH%NCID + +#ifdef USE_NETCDF4_FEATURES +if ( .not. DH%use_netcdf_classic ) then + call set_chunking(MemoryOrder,need_chunking) + compression_level = 2 +else + need_chunking = 0 +endif +#endif + + if ( DH%R4OnOutput .and. FieldTypeIn == WRF_DOUBLE ) then + FieldType = WRF_REAL + else + FieldType = FieldTypeIn + end if + + write(msg,*)'ext_ncdpar_write_field: called for ',TRIM(Var) + +!jm 010827 Length(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1 + + Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1 + + IF ( ZeroLengthHorzDim(MemoryOrder,Length,Status) ) THEN + write(msg,*)'ext_ncdpar_write_field: zero length dimension in ',TRIM(Var),'. Ignoring' + call wrf_debug ( WARN , TRIM(msg)) + return + ENDIF + + Length_native(1:NDim) = Length(1:NDim) + Length_global(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1 + ! Length_global(1:NDim) = Length(1:NDim) + + call ExtOrder(MemoryOrder,Length,Status) + call ExtOrder(MemoryOrder,Length_global,Status) + + call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status) + + ! Magic number to identify call from IO server when doing quilting +! quilting = (MemoryStart(1) == -998899 .AND. MemoryEnd(1) == -998899) +! IF(quilting)THEN +! lMemoryStart(1:NDim) = 1 +! lMemoryEnd(1:NDim) = Length(1:NDim) +! ELSE + lMemoryStart(1:NDim) = MemoryStart(1:NDim) + lMemoryEnd(1:NDim) = MemoryEnd(1:NDim) +! END IF + + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + Status = WRF_WARN_WRITE_RONLY_FILE + write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + do NVar=1,MaxVars + if(DH%VarNames(NVar) == VarName ) then + Status = WRF_WARN_2DRYRUNS_1VARIABLE + write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE (',TRIM(VarName),') in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(DH%VarNames(NVar) == NO_NAME) then + DH%VarNames(NVar) = VarName + DH%NumVars = NVar + exit + elseif(NVar == MaxVars) then + Status = WRF_WARN_TOO_MANY_VARIABLES + write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + do j = 1,NDim + if(RODimNames(j) == NullName .or. RODimNames(j) == '') then + do i=1,MaxDims + if(DH%DimLengths(i) == Length_global(j)) then + exit + elseif(DH%DimLengths(i) == NO_DIM) then + stat = NF_DEF_DIM(NCID,DH%DimNames(i),Length_global(j),DH%DimIDs(i)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%DimLengths(i) = Length_global(j) + exit + elseif(i == MaxDims) then + Status = WRF_WARN_TOO_MANY_DIMS + write(msg,*) 'Warning TOO MANY DIMENSIONS (',i,') in (',TRIM(VarName),') ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + else !look for input name and check if already defined + NotFound = .true. + do i=1,MaxDims + if (DH%DimNames(i) == RODimNames(j)) then + if (DH%DimLengths(i) == Length_global(j)) then + NotFound = .false. + exit + else + Status = WRF_WARN_DIMNAME_REDEFINED + write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDEFINED by var ', & + TRIM(Var),' ',DH%DimLengths(i),Length_global(j) ,' in ', __FILE__ ,' line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + endif + enddo + if (NotFound) then + do i=1,MaxDims + if (DH%DimLengths(i) == NO_DIM) then + DH%DimNames(i) = RODimNames(j) + stat = NF_DEF_DIM(NCID,DH%DimNames(i),Length_global(j),DH%DimIDs(i)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%DimLengths(i) = Length_global(j) + exit + elseif(i == MaxDims) then + Status = WRF_WARN_TOO_MANY_DIMS + write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + endif + endif + VDimIDs(j) = DH%DimIDs(i) + DH%VarDimLens(j,NVar) = Length_global(j) + enddo + VDimIDs(NDim+1) = DH%DimUnlimID + + ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE + IF (FieldType == WRF_REAL) THEN + XType = NF_FLOAT + ELSE IF (FieldType == WRF_DOUBLE) THEN + Xtype = NF_DOUBLE + ELSE IF (FieldType == WRF_INTEGER) THEN + XType = NF_INT + ELSE IF (FieldType == WRF_LOGICAL) THEN + XType = NF_INT + ELSE + Status = WRF_WARN_DATA_TYPE_NOT_FOUND + write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + END IF + + stat = NF_DEF_VAR(NCID,VarName,XType,NDim+1,VDimIDs,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + +#ifdef USE_NETCDF4_FEATURES + if(need_chunking > 0 ) then + chunks(1:NDim) = Length(1:NDim) + chunks(NDim+1) = 1 + + IF( need_chunking == 3 ) THEN + IF ( 4*(chunks(3)/4) == chunks(3) ) THEN + chunks(3) = chunks(3)/4 + ELSE + chunks(3) = chunks(3)/4 + 1 + ENDIF + ENDIF + + + IF ( .false. ) THEN + chunks(1) = (Length(1) + 1)/2 + chunks(2) = (Length(2) + 1)/2 + + block_size = 1 + do i = 1, NDim + block_size = block_size * chunks(i) + end do + + do while (block_size > cache_size) + chunks(1) = (chunks(1) + 1)/2 + chunks(2) = (chunks(2) + 1)/2 + + block_size = 1 + do i = 1, NDim + block_size = block_size * chunks(i) + end do + end do + + ENDIF + + ! send size from rank 0 so that all use the same value for chunking + CALL MPI_Bcast(chunks, 2, MPI_INTEGER, 0, MPI_COMM_WORLD, mpi_error_code) + +! write(unit=0, fmt='(2x, 3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ +! write(unit=0, fmt='(2x, 3a)') TRIM(VarName),':' +! write(unit=0, fmt='(10x, 2(a,i6))') 'length 1 = ', Length(1), ', chunk 1 = ', chunks(1) +! write(unit=0, fmt='(10x, 2(a,i6))') 'length 2 = ', Length(2), ', chunk 2 = ', chunks(2) +! write(unit=0, fmt='(10x, 2(a,i6))') 'length NDim+1 = ', Length(NDim+1), ', chunk NDim+1 = ', chunks(NDim+1) +! write(unit=0, fmt='(10x, a,i6)') 'compression_level = ', compression_level + + IF ( .true. ) THEN + stat = NF_DEF_VAR_CHUNKING(NCID, VarID, NF_CHUNKED, chunks(1:NDim+1)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF def chunking error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + ENDIF + + stat = NF_DEF_VAR_DEFLATE(NCID, VarID, 1, 1, compression_level) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF def compression error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + endif +#endif + + DH%VarIDs(NVar) = VarID + stat = NF_PUT_ATT_INT(NCID,VarID,'FieldType',NF_INT,1,FieldType) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call reorder(MemoryOrder,MemO) + call uppercase(MemO,UCMemO) + stat = NF_PUT_ATT_TEXT(NCID,VarID,'MemoryOrder',3,UCMemO) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + do NVar=1,DH%NumVars + if(DH%VarNames(NVar) == VarName) then + exit + elseif(NVar == DH%NumVars) then + Status = WRF_WARN_VAR_NF + write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + VarID = DH%VarIDs(NVar) + do j=1,NDim + if(Length_global(j) /= DH%VarDimLens(j,NVar) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then + Status = WRF_WARN_WRTLEN_NE_DRRUNLEN + write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for |', & + VarName,'| dim ',j,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + write(msg,*) ' LENGTH ',Length_global(j),' DRY RUN LENGTH ',DH%VarDimLens(j,NVar) + call wrf_debug ( WARN , TRIM(msg)) + return +!jm 010825 elseif(DomainStart(j) < MemoryStart(j)) then + elseif(PatchStart(j) < lMemoryStart(j)) then + Status = WRF_WARN_DIMENSION_ERROR + write(msg,*) 'Warning DIMENSION ERROR for |',VarName, & + '| in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + StoredStart = 1 + call GetIndices(NDim,lMemoryStart,lMemoryEnd,l1,l2,m1,m2,n1,n2) + call GetIndices(NDim,StoredStart,Length ,x1,x2,y1,y2,z1,z2) + call GetIndices(NDim,StoredStart,Length_native ,p1,p2,q1,q2,r1,r2) + call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2) + di=1 + if(FieldType == WRF_DOUBLE) di=2 + allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + if (DH%R4OnOutput .and. FieldTypeIn == WRF_DOUBLE) then + call TransposeToR4a('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + else + call Transpose('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + end if + StoredStart(1:NDim) = PatchStart(1:NDim) + call ExtOrder(MemoryOrder,StoredStart,Status) + call FieldIO('write',DataHandle,DateStr,StoredStart,Length,MemoryOrder, & + FieldType,NCID,VarID,XField,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + deallocate(XField, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + endif + DH%first_operation = .FALSE. + return +end subroutine ext_ncdpar_write_field + + +subroutine ext_ncdpar_write_field_orig(DataHandle,DateStr,Var,Field,FieldTypeIn, & + Comm, IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames, & + DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: DateStr + character*(*) ,intent(in) :: Var + integer ,intent(inout) :: Field(*) + integer ,intent(in) :: FieldTypeIn + integer ,intent(inout) :: Comm + integer ,intent(inout) :: IOComm + integer ,intent(in) :: DomainDesc + character*(*) ,intent(in) :: MemoryOrdIn + character*(*) ,intent(in) :: Stagger ! Dummy for now + character*(*) ,dimension(*) ,intent(in) :: DimNames + integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd + integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd + integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd + integer ,intent(out) :: Status + integer :: FieldType + character (3) :: MemoryOrder + type(wrf_data_handle) ,pointer :: DH + integer :: NCID + integer :: NDim + character (VarNameLen) :: VarName + character (3) :: MemO + character (3) :: UCMemO + integer :: VarID + integer ,dimension(NVarDims) :: Length + integer ,dimension(NVarDims) :: VDimIDs + character(80),dimension(NVarDims) :: RODimNames + integer ,dimension(NVarDims) :: StoredStart + integer ,dimension(:,:,:,:),allocatable :: XField + integer :: stat + integer :: NVar + integer :: i,j + integer :: i1,i2,j1,j2,k1,k2 + integer :: x1,x2,y1,y2,z1,z2 + integer :: l1,l2,m1,m2,n1,n2 + integer :: XType + integer :: di + character (80) :: NullName + logical :: NotFound + +#ifdef USE_NETCDF4_FEATURES + integer, parameter :: cache_size = 32000000 + integer,dimension(NVarDims) :: chunks + integer :: need_chunking + integer :: compression_level + integer :: block_size +#endif + + MemoryOrder = trim(adjustl(MemoryOrdIn)) + NullName=char(0) + call GetDim(MemoryOrder,NDim,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning BAD MEMORY ORDER |',MemoryOrder,'| in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning DATE STRING ERROR |',DateStr,'| in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + VarName = Var + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + NCID = DH%NCID + +#ifdef USE_NETCDF4_FEATURES +if ( .not. DH%use_netcdf_classic ) then + call set_chunking(MemoryOrder,need_chunking) + compression_level = 2 +else + need_chunking = 0 +endif +#endif + + if ( DH%R4OnOutput .and. FieldTypeIn == WRF_DOUBLE ) then + FieldType = WRF_REAL + else + FieldType = FieldTypeIn + end if + + write(msg,*)'ext_ncdpar_write_field: called for ',TRIM(Var) + +!jm 010827 Length(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1 + + Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1 + + IF ( ZeroLengthHorzDim(MemoryOrder,Length,Status) ) THEN + write(msg,*)'ext_ncdpar_write_field: zero length dimension in ',TRIM(Var),'. Ignoring' + call wrf_debug ( WARN , TRIM(msg)) + return + ENDIF + + call ExtOrder(MemoryOrder,Length,Status) + call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status) + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + Status = WRF_WARN_WRITE_RONLY_FILE + write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + do NVar=1,MaxVars + if(DH%VarNames(NVar) == VarName ) then + Status = WRF_WARN_2DRYRUNS_1VARIABLE + write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(DH%VarNames(NVar) == NO_NAME) then + DH%VarNames(NVar) = VarName + DH%NumVars = NVar + exit + elseif(NVar == MaxVars) then + Status = WRF_WARN_TOO_MANY_VARIABLES + write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + do j = 1,NDim + if(RODimNames(j) == NullName .or. RODimNames(j) == '') then + do i=1,MaxDims + if(DH%DimLengths(i) == Length(j)) then + exit + elseif(DH%DimLengths(i) == NO_DIM) then + stat = NF_DEF_DIM(NCID,DH%DimNames(i),Length(j),DH%DimIDs(i)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%DimLengths(i) = Length(j) + exit + elseif(i == MaxDims) then + Status = WRF_WARN_TOO_MANY_DIMS + write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + else !look for input name and check if already defined + NotFound = .true. + do i=1,MaxDims + if (DH%DimNames(i) == RODimNames(j)) then + if (DH%DimLengths(i) == Length(j)) then + NotFound = .false. + exit + else + Status = WRF_WARN_DIMNAME_REDEFINED + write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDEFINED by var ', & + TRIM(Var),' ',DH%DimLengths(i),Length(j) ,' in ', __FILE__ ,' line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + endif + enddo + if (NotFound) then + do i=1,MaxDims + if (DH%DimLengths(i) == NO_DIM) then + DH%DimNames(i) = RODimNames(j) + stat = NF_DEF_DIM(NCID,DH%DimNames(i),Length(j),DH%DimIDs(i)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + DH%DimLengths(i) = Length(j) + exit + elseif(i == MaxDims) then + Status = WRF_WARN_TOO_MANY_DIMS + write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + endif + endif + VDimIDs(j) = DH%DimIDs(i) + DH%VarDimLens(j,NVar) = Length(j) + enddo + VDimIDs(NDim+1) = DH%DimUnlimID + + ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE + IF (FieldType == WRF_REAL) THEN + XType = NF_FLOAT + ELSE IF (FieldType == WRF_DOUBLE) THEN + Xtype = NF_DOUBLE + ELSE IF (FieldType == WRF_INTEGER) THEN + XType = NF_INT + ELSE IF (FieldType == WRF_LOGICAL) THEN + XType = NF_INT + ELSE + Status = WRF_WARN_DATA_TYPE_NOT_FOUND + write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + END IF + + stat = NF_DEF_VAR(NCID,VarName,XType,NDim+1,VDimIDs,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + +#ifdef USE_NETCDF4_FEATURES + if(need_chunking > 0 ) then + chunks(1:NDim) = Length(1:NDim) + chunks(NDim+1) = 1 + chunks(1) = (Length(1) + 1)/2 + chunks(2) = (Length(2) + 1)/2 + + block_size = 1 + do i = 1, NDim + block_size = block_size * chunks(i) + end do + + do while (block_size > cache_size) + chunks(1) = (chunks(1) + 1)/2 + chunks(2) = (chunks(2) + 1)/2 + + block_size = 1 + do i = 1, NDim + block_size = block_size * chunks(i) + end do + end do + +! write(unit=0, fmt='(2x, 3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ +! write(unit=0, fmt='(2x, 3a)') TRIM(VarName),':' +! write(unit=0, fmt='(10x, 2(a,i6))') 'length 1 = ', Length(1), ', chunk 1 = ', chunks(1) +! write(unit=0, fmt='(10x, 2(a,i6))') 'length 2 = ', Length(2), ', chunk 2 = ', chunks(2) +! write(unit=0, fmt='(10x, 2(a,i6))') 'length NDim+1 = ', Length(NDim+1), ', chunk NDim+1 = ', chunks(NDim+1) +! write(unit=0, fmt='(10x, a,i6)') 'compression_level = ', compression_level + + stat = NF_DEF_VAR_CHUNKING(NCID, VarID, NF_CHUNKED, chunks(1:NDim+1)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF def chunking error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + + IF ( .false. ) THEN + stat = NF_DEF_VAR_DEFLATE(NCID, VarID, 1, 1, compression_level) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF def compression error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + ENDIF + endif +#endif + + DH%VarIDs(NVar) = VarID + stat = NF_PUT_ATT_INT(NCID,VarID,'FieldType',NF_INT,1,FieldType) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call reorder(MemoryOrder,MemO) + call uppercase(MemO,UCMemO) + stat = NF_PUT_ATT_TEXT(NCID,VarID,'MemoryOrder',3,UCMemO) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'ext_ncdpar_write_field: NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + do NVar=1,DH%NumVars + if(DH%VarNames(NVar) == VarName) then + exit + elseif(NVar == DH%NumVars) then + Status = WRF_WARN_VAR_NF + write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + VarID = DH%VarIDs(NVar) + do j=1,NDim + if(Length(j) /= DH%VarDimLens(j,NVar) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then + Status = WRF_WARN_WRTLEN_NE_DRRUNLEN + write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for |', & + VarName,'| dim ',j,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + write(msg,*) ' LENGTH ',Length(j),' DRY RUN LENGTH ',DH%VarDimLens(j,NVar) + call wrf_debug ( WARN , TRIM(msg)) + return +!jm 010825 elseif(DomainStart(j) < MemoryStart(j)) then + elseif(PatchStart(j) < MemoryStart(j)) then + Status = WRF_WARN_DIMENSION_ERROR + write(msg,*) 'Warning DIMENSION ERROR for |',VarName, & + '| in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + StoredStart = 1 + call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2) + call GetIndices(NDim,StoredStart,Length ,x1,x2,y1,y2,z1,z2) + call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2) + di=1 + if(FieldType == WRF_DOUBLE) di=2 + allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + if (DH%R4OnOutput .and. FieldTypeIn == WRF_DOUBLE) then + call TransposeToR4('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + else + call Transpose('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + end if + call FieldIO('write',DataHandle,DateStr,StoredStart,Length,MemoryOrder, & + FieldType,NCID,VarID,XField,Status) +! call FieldIO('write',DataHandle,DateStr,Length,MemoryOrder, & +! FieldType,NCID,VarID,XField,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + deallocate(XField, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + return + endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , TRIM(msg)) + endif + DH%first_operation = .FALSE. + return +end subroutine ext_ncdpar_write_field_orig + +subroutine ext_ncdpar_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm, & + IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames, & + DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: DateStr + character*(*) ,intent(in) :: Var + integer ,intent(out) :: Field(*) + integer ,intent(in) :: FieldType + integer ,intent(inout) :: Comm + integer ,intent(inout) :: IOComm + integer ,intent(in) :: DomainDesc + character*(*) ,intent(in) :: MemoryOrdIn + character*(*) ,intent(in) :: Stagger ! Dummy for now + character*(*) , dimension (*) ,intent(in) :: DimNames + integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd + integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd + integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd + integer ,intent(out) :: Status + character (3) :: MemoryOrder + character (NF_MAX_NAME) :: dimname + type(wrf_data_handle) ,pointer :: DH + integer :: NDim + integer :: NCID + character (VarNameLen) :: VarName + integer :: VarID + integer ,dimension(NVarDims) :: VCount + integer ,dimension(NVarDims) :: VStart + integer ,dimension(NVarDims) :: Length + integer ,dimension(NVarDims) :: VDimIDs + integer ,dimension(NVarDims) :: MemS + integer ,dimension(NVarDims) :: MemE + integer ,dimension(NVarDims) :: StoredStart + integer ,dimension(NVarDims) :: StoredLen + integer(KIND=MPI_OFFSET_KIND) ,dimension(NVarDims) :: StoredLen_okind + integer ,dimension(:,:,:,:) ,allocatable :: XField + integer :: NVar + integer :: j + integer :: i1,i2,j1,j2,k1,k2 + integer :: x1,x2,y1,y2,z1,z2 + integer :: l1,l2,m1,m2,n1,n2 + character (VarNameLen) :: Name + integer :: XType + integer :: StoredDim + integer :: NAtts + integer :: Len + integer :: stat + integer :: di + integer :: FType + + MemoryOrder = trim(adjustl(MemoryOrdIn)) + call GetDim(MemoryOrder,NDim,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning BAD MEMORY ORDER |',TRIM(MemoryOrder),'| for |', & + TRIM(Var),'| in ext_ncdpar_read_field ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning DATE STRING ERROR |',TRIM(DateStr),'| for |',TRIM(Var), & + '| in ext_ncdpar_read_field ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + VarName = Var + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ext_ncdpar_read_field ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then +! jm it is okay to have a dry run read. means read is called between ofrb and ofrc. Just return. +! Status = WRF_WARN_DRYRUN_READ +! write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ +! call wrf_debug ( WARN , TRIM(msg)) + Status = WRF_NO_ERR + RETURN + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then + NCID = DH%NCID + +!jm Length(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1 + Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1 + StoredStart(1:NDim) = PatchStart(1:NDim) + + call ExtOrder(MemoryOrder,Length,Status) + stat = NF_INQ_VARID(NCID,VarName,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname ',Varname + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VAR(NCID,VarID,Name,XType,StoredDim,VDimIDs,NAtts) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_GET_ATT_INT(NCID,VarID,'FieldType',FType) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif +! allow coercion between double and single prec real +!jm if(FieldType /= Ftype) then + if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then + if ( .NOT. (Ftype == WRF_REAL .OR. Ftype == WRF_DOUBLE )) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + else if(FieldType /= Ftype) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + + ! Do not use SELECT statement here as sometimes WRF_REAL=WRF_DOUBLE + IF (FieldType == WRF_REAL) THEN +! allow coercion between double and single prec real + if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) ) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning REAL TYPE MISMATCH in ',__FILE__,', line', __LINE__ + endif + ELSE IF (FieldType == WRF_DOUBLE) THEN +! allow coercion between double and single prec real + if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) ) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning DOUBLE TYPE MISMATCH in ',__FILE__,', line', __LINE__ + endif + ELSE IF (FieldType == WRF_INTEGER) THEN + if(XType /= NF_INT) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning INTEGER TYPE MISMATCH in ',__FILE__,', line', __LINE__ + endif + ELSE IF (FieldType == WRF_LOGICAL) THEN + if(XType /= NF_INT) then + Status = WRF_WARN_TYPE_MISMATCH + write(msg,*) 'Warning LOGICAL TYPE MISMATCH in ',__FILE__,', line', __LINE__ + endif + ELSE + Status = WRF_WARN_DATA_TYPE_NOT_FOUND + write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ + END IF + + if(Status /= WRF_NO_ERR) then + call wrf_debug ( WARN , TRIM(msg)) + return + endif + ! NDim=0 for scalars. Handle read of old NDim=1 files. TBH: 20060502 + IF ( ( NDim == 0 ) .AND. ( StoredDim == 2 ) ) THEN + stat = NF_INQ_DIMNAME(NCID,VDimIDs(1),dimname) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + IF ( dimname(1:10) == 'ext_scalar' ) THEN + NDim = 1 + Length(1) = 1 + ENDIF + ENDIF + if(StoredDim /= NDim+1) then + Status = WRF_ERR_FATAL_BAD_VARIABLE_DIM + write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ext_ncdpar_read_field ',TRIM(Var),TRIM(DateStr) + call wrf_debug ( FATAL , msg) + write(msg,*) ' StoredDim ', StoredDim, ' .NE. NDim+1 ', NDim+1 + call wrf_debug ( FATAL , msg) + return + endif + do j=1,NDim + stat = NF_INQ_DIMLEN(NCID,VDimIDs(j),StoredLen(j)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(Length(j) > StoredLen(j)) then + Status = WRF_WARN_READ_PAST_EOF + write(msg,*) 'Warning READ PAST EOF in ext_ncdpar_read_field of ',TRIM(Var),Length(j),'>',StoredLen(j) + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(Length(j) <= 0) then + Status = WRF_WARN_ZERO_LENGTH_READ + write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(DomainStart(j) < MemoryStart(j)) then + Status = WRF_WARN_DIMENSION_ERROR + write(msg,*) 'Warning dim ',j,' DomainStart (',DomainStart(j), & + ') < MemoryStart (',MemoryStart(j),') in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) +! return + endif + enddo + + StoredStart = 1 + call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2) + call GetIndices(NDim,StoredStart,StoredLen,x1,x2,y1,y2,z1,z2) +!jm call GetIndices(NDim,DomainStart,DomainEnd,i1,i2,j1,j2,k1,k2) + call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2) + StoredStart(1:NDim) = PatchStart(1:NDim) + call ExtOrder(MemoryOrder,StoredStart,Status) + + di=1 + if(FieldType == WRF_DOUBLE) di=2 + allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_ALLOCATION_ERROR + write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + call FieldIO('read',DataHandle,DateStr,StoredStart,Length,MemoryOrder, & + FieldType,NCID,VarID,XField,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call Transpose('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + ,XField,x1,x2,y1,y2,z1,z2 & + ,i1,i2,j1,j2,k1,k2 ) + deallocate(XField, STAT=stat) + if(stat/= 0) then + Status = WRF_ERR_FATAL_DEALLOCATION_ERR + write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + return + endif + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + DH%first_operation = .FALSE. + return +end subroutine ext_ncdpar_read_field + +subroutine ext_ncdpar_inquire_opened( DataHandle, FileName , FileStatus, Status ) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(inout) :: FileName + integer ,intent(out) :: FileStatus + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + + !call upgrade_filename(FileName) + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + FileStatus = WRF_FILE_NOT_OPENED + return + endif + if(trim(FileName) /= trim(DH%FileName)) then + FileStatus = WRF_FILE_NOT_OPENED + else + FileStatus = DH%FileStatus + endif + Status = WRF_NO_ERR + return +end subroutine ext_ncdpar_inquire_opened + +subroutine ext_ncdpar_inquire_filename( Datahandle, FileName, FileStatus, Status ) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(out) :: FileName + integer ,intent(out) :: FileStatus + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + FileStatus = WRF_FILE_NOT_OPENED + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + FileName = trim(DH%FileName) + FileStatus = DH%FileStatus + Status = WRF_NO_ERR + return +end subroutine ext_ncdpar_inquire_filename + +subroutine ext_ncdpar_set_time(DataHandle, DateStr, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: DateStr + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: i + + call DateCheck(DateStr,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_FILE_NOT_COMMITTED + write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + do i=1,MaxTimes + if(DH%Times(i)==DateStr) then + DH%CurrentTime = i + exit + endif + if(i==MaxTimes) then + Status = WRF_WARN_TIME_NF + return + endif + enddo + DH%CurrentVariable = 0 + Status = WRF_NO_ERR + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + return +end subroutine ext_ncdpar_set_time + +subroutine ext_ncdpar_get_next_time(DataHandle, DateStr, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(out) :: DateStr + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then + if(DH%CurrentTime >= DH%NumberTimes) then + Status = WRF_WARN_TIME_EOF + return + endif + DH%CurrentTime = DH%CurrentTime +1 + DateStr = DH%Times(DH%CurrentTime) + DH%CurrentVariable = 0 + Status = WRF_NO_ERR + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'DH%FileStatus ',DH%FileStatus + call wrf_debug ( FATAL , msg) + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + return +end subroutine ext_ncdpar_get_next_time + +subroutine ext_ncdpar_get_previous_time(DataHandle, DateStr, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(out) :: DateStr + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then + if(DH%CurrentTime.GT.0) then + DH%CurrentTime = DH%CurrentTime -1 + endif + DateStr = DH%Times(DH%CurrentTime) + DH%CurrentVariable = 0 + Status = WRF_NO_ERR + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + return +end subroutine ext_ncdpar_get_previous_time + +subroutine ext_ncdpar_get_next_var(DataHandle, VarName, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'wrf_status_codes.h' + include 'netcdf.inc' + integer ,intent(in) :: DataHandle + character*(*) ,intent(out) :: VarName + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: stat + character (80) :: Name + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + + DH%CurrentVariable = DH%CurrentVariable +1 + if(DH%CurrentVariable > DH%NumVars) then + Status = WRF_WARN_VAR_EOF + return + endif + VarName = DH%VarNames(DH%CurrentVariable) + Status = WRF_NO_ERR + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + return +end subroutine ext_ncdpar_get_next_var + +subroutine ext_ncdpar_end_of_frame(DataHandle, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'netcdf.inc' + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + + call GetDH(DataHandle,DH,Status) + return +end subroutine ext_ncdpar_end_of_frame + +! NOTE: For scalar variables NDim is set to zero and DomainStart and +! NOTE: DomainEnd are left unmodified. +subroutine ext_ncdpar_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'netcdf.inc' + include 'wrf_status_codes.h' + integer ,intent(in) :: DataHandle + character*(*) ,intent(in) :: Name + integer ,intent(out) :: NDim + character*(*) ,intent(out) :: MemoryOrder + character*(*) :: Stagger ! Dummy for now + integer ,dimension(*) ,intent(out) :: DomainStart, DomainEnd + integer ,intent(out) :: WrfType + integer ,intent(out) :: Status + type(wrf_data_handle) ,pointer :: DH + integer :: VarID + integer ,dimension(NVarDims) :: VDimIDs + integer :: j + integer :: stat + integer :: XType + + call GetDH(DataHandle,DH,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + if(DH%FileStatus == WRF_FILE_NOT_OPENED) then + Status = WRF_WARN_FILE_NOT_OPENED + write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then + Status = WRF_WARN_DRYRUN_READ + write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then + Status = WRF_WARN_READ_WONLY_FILE + write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then + stat = NF_INQ_VARID(DH%NCID,Name,VarID) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VARTYPE(DH%NCID,VarID,XType) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_GET_ATT_INT(DH%NCID,VarID,'FieldType',WrfType) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + select case (XType) + case (NF_BYTE) + Status = WRF_WARN_BAD_DATA_TYPE + write(msg,*) 'Warning BYTE IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + case (NF_CHAR) + Status = WRF_WARN_BAD_DATA_TYPE + write(msg,*) 'Warning CHAR IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + case (NF_SHORT) + Status = WRF_WARN_BAD_DATA_TYPE + write(msg,*) 'Warning SHORT IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + case (NF_INT) + if(WrfType /= WRF_INTEGER .and. WrfType /= WRF_LOGICAL) then + Status = WRF_WARN_BAD_DATA_TYPE + write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + case (NF_FLOAT) + if(WrfType /= WRF_REAL) then + Status = WRF_WARN_BAD_DATA_TYPE + write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + case (NF_DOUBLE) + if(WrfType /= WRF_DOUBLE) then + Status = WRF_WARN_BAD_DATA_TYPE + write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + case default + Status = WRF_WARN_DATA_TYPE_NOT_FOUND + write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + end select + + stat = NF_GET_ATT_TEXT(DH%NCID,VarID,'MemoryOrder',MemoryOrder) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + call GetDim(MemoryOrder,NDim,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'Warning BAD MEMORY ORDER ',TRIM(MemoryOrder),' in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + stat = NF_INQ_VARDIMID(DH%NCID,VarID,VDimIDs) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + do j = 1, NDim + DomainStart(j) = 1 + stat = NF_INQ_DIMLEN(DH%NCID,VDimIDs(j),DomainEnd(j)) + call netcdf_err(stat,Status) + if(Status /= WRF_NO_ERR) then + write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ + call wrf_debug ( WARN , TRIM(msg)) + return + endif + enddo + else + Status = WRF_ERR_FATAL_BAD_FILE_STATUS + write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ + call wrf_debug ( FATAL , msg) + endif + return +end subroutine ext_ncdpar_get_var_info + +subroutine ext_ncdpar_warning_str( Code, ReturnString, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'netcdf.inc' + include 'wrf_status_codes.h' + + integer , intent(in) ::Code + character *(*), intent(out) :: ReturnString + integer, intent(out) ::Status + + SELECT CASE (Code) + CASE (0) + ReturnString='No error' + Status=WRF_NO_ERR + return + CASE (-1) + ReturnString= 'File not found (or file is incomplete)' + Status=WRF_NO_ERR + return + CASE (-2) + ReturnString='Metadata not found' + Status=WRF_NO_ERR + return + CASE (-3) + ReturnString= 'Timestamp not found' + Status=WRF_NO_ERR + return + CASE (-4) + ReturnString= 'No more timestamps' + Status=WRF_NO_ERR + return + CASE (-5) + ReturnString= 'Variable not found' + Status=WRF_NO_ERR + return + CASE (-6) + ReturnString= 'No more variables for the current time' + Status=WRF_NO_ERR + return + CASE (-7) + ReturnString= 'Too many open files' + Status=WRF_NO_ERR + return + CASE (-8) + ReturnString= 'Data type mismatch' + Status=WRF_NO_ERR + return + CASE (-9) + ReturnString= 'Attempt to write read-only file' + Status=WRF_NO_ERR + return + CASE (-10) + ReturnString= 'Attempt to read write-only file' + Status=WRF_NO_ERR + return + CASE (-11) + ReturnString= 'Attempt to access unopened file' + Status=WRF_NO_ERR + return + CASE (-12) + ReturnString= 'Attempt to do 2 trainings for 1 variable' + Status=WRF_NO_ERR + return + CASE (-13) + ReturnString= 'Attempt to read past EOF' + Status=WRF_NO_ERR + return + CASE (-14) + ReturnString= 'Bad data handle' + Status=WRF_NO_ERR + return + CASE (-15) + ReturnString= 'Write length not equal to training length' + Status=WRF_NO_ERR + return + CASE (-16) + ReturnString= 'More dimensions requested than training' + Status=WRF_NO_ERR + return + CASE (-17) + ReturnString= 'Attempt to read more data than exists' + Status=WRF_NO_ERR + return + CASE (-18) + ReturnString= 'Input dimensions inconsistent' + Status=WRF_NO_ERR + return + CASE (-19) + ReturnString= 'Input MemoryOrder not recognized' + Status=WRF_NO_ERR + return + CASE (-20) + ReturnString= 'A dimension name with 2 different lengths' + Status=WRF_NO_ERR + return + CASE (-21) + ReturnString= 'String longer than provided storage' + Status=WRF_NO_ERR + return + CASE (-22) + ReturnString= 'Function not supportable' + Status=WRF_NO_ERR + return + CASE (-23) + ReturnString= 'Package implements this routine as NOOP' + Status=WRF_NO_ERR + return + +!netcdf-specific warning messages + CASE (-1007) + ReturnString= 'Bad data type' + Status=WRF_NO_ERR + return + CASE (-1008) + ReturnString= 'File not committed' + Status=WRF_NO_ERR + return + CASE (-1009) + ReturnString= 'File is opened for reading' + Status=WRF_NO_ERR + return + CASE (-1011) + ReturnString= 'Attempt to write metadata after open commit' + Status=WRF_NO_ERR + return + CASE (-1010) + ReturnString= 'I/O not initialized' + Status=WRF_NO_ERR + return + CASE (-1012) + ReturnString= 'Too many variables requested' + Status=WRF_NO_ERR + return + CASE (-1013) + ReturnString= 'Attempt to close file during a dry run' + Status=WRF_NO_ERR + return + CASE (-1014) + ReturnString= 'Date string not 19 characters in length' + Status=WRF_NO_ERR + return + CASE (-1015) + ReturnString= 'Attempt to read zero length words' + Status=WRF_NO_ERR + return + CASE (-1016) + ReturnString= 'Data type not found' + Status=WRF_NO_ERR + return + CASE (-1017) + ReturnString= 'Badly formatted date string' + Status=WRF_NO_ERR + return + CASE (-1018) + ReturnString= 'Attempt at read during a dry run' + Status=WRF_NO_ERR + return + CASE (-1019) + ReturnString= 'Attempt to get zero words' + Status=WRF_NO_ERR + return + CASE (-1020) + ReturnString= 'Attempt to put zero length words' + Status=WRF_NO_ERR + return + CASE (-1021) + ReturnString= 'NetCDF error' + Status=WRF_NO_ERR + return + CASE (-1022) + ReturnString= 'Requested length <= 1' + Status=WRF_NO_ERR + return + CASE (-1023) + ReturnString= 'More data available than requested' + Status=WRF_NO_ERR + return + CASE (-1024) + ReturnString= 'New date less than previous date' + Status=WRF_NO_ERR + return + + CASE DEFAULT + ReturnString= 'This warning code is not supported or handled directly by WRF and NetCDF. & + & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need & + & to be calling a package-specific routine to return a message for this warning code.' + Status=WRF_NO_ERR + END SELECT + + return +end subroutine ext_ncdpar_warning_str + +!returns message string for all WRF and netCDF warning/error status codes +!Other i/o packages must provide their own routines to return their own status messages +subroutine ext_ncdpar_error_str( Code, ReturnString, Status) + use wrf_data_ncpar + use ext_ncdpar_support_routines + implicit none + include 'netcdf.inc' + include 'wrf_status_codes.h' + + integer , intent(in) ::Code + character *(*), intent(out) :: ReturnString + integer, intent(out) ::Status + + SELECT CASE (Code) + CASE (-100) + ReturnString= 'Allocation Error' + Status=WRF_NO_ERR + return + CASE (-101) + ReturnString= 'Deallocation Error' + Status=WRF_NO_ERR + return + CASE (-102) + ReturnString= 'Bad File Status' + Status=WRF_NO_ERR + return + CASE (-1004) + ReturnString= 'Variable on disk is not 3D' + Status=WRF_NO_ERR + return + CASE (-1005) + ReturnString= 'Metadata on disk is not 1D' + Status=WRF_NO_ERR + return + CASE (-1006) + ReturnString= 'Time dimension too small' + Status=WRF_NO_ERR + return + CASE DEFAULT + ReturnString= 'This error code is not supported or handled directly by WRF and NetCDF. & + & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need & + & to be calling a package-specific routine to return a message for this error code.' + Status=WRF_NO_ERR + END SELECT + + return +end subroutine ext_ncdpar_error_str From 8d30f4d9c372f28664f418cb2037ae6ede80cf3f Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Wed, 8 Sep 2021 19:32:02 -0500 Subject: [PATCH 03/17] Draft README for compiling/using parallel netcdf-4 --- README.netcdf4par | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 README.netcdf4par diff --git a/README.netcdf4par b/README.netcdf4par new file mode 100644 index 0000000000..1961d989ce --- /dev/null +++ b/README.netcdf4par @@ -0,0 +1,33 @@ +Using parallel IO through the netCDF-4 interface (io_form = 13) + +If you don't need variable-level compression, stop and go use pnetcdf +(parallel-netcdf-1.9.0), which will have better IO performance. + +To use parallel netcdf-4, set the environment variable NETCDFPAR to the +directory containingthe lib and include directories, e.g., + +setenv NETCDFPAR /usr/local/netcdf474par + +(This will also cause configure to set NETCDF = NETCDFPAR to prevent +conflicting libraries, and also will force NETCDF4=1 and USENETCDFPAR=1) + +The code assumes you want compression turned on, so netcdf-c version 4.7.4 +or later is required. (Because otherwise just use pnetcdf since it is +faster.) This in turn requires HDF5 1.10.3 or later. Netcdf-c can be build +with or without pnetcdf enabled, but it is not used here through the netcdf-4 +interface. (There is a separate IO option for PNETCDF that can be used). + +Tests for development used the following: + +parallel-netcdf 1.9.0 (--enable-relax-coord-bound --disable-cxx) +Hdf5 version 1.10.7 (--enable-fortran --enable-parallel) +netcdf-c 4.7.4 (--enable-netcdf-4 --enable-pnetcdf --disable-dap) +netcdf-fortran 4.5.3 (--enable-parallel-tests) + +Other options as needed: FC=mpif90 F90=mpif90 CC=mpicc F77=mpif90 + +IO output form for parallel netcdf-4 is 13 (io_netcdfpar=13 in Registry). + +Performance seems to vary with how 'regular' the domain decomposition is +(i.e., patch size). Some experimentation with manually setting the decomposition +may be needed for optimal writing times. From 634bc75a3651071cb06e05fa367f00df4231eea4 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Fri, 10 Sep 2021 11:16:40 -0500 Subject: [PATCH 04/17] Updated README --- README.netcdf4par | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/README.netcdf4par b/README.netcdf4par index 1961d989ce..a4f50e1a07 100644 --- a/README.netcdf4par +++ b/README.netcdf4par @@ -1,7 +1,8 @@ Using parallel IO through the netCDF-4 interface (io_form = 13) If you don't need variable-level compression, stop and go use pnetcdf -(parallel-netcdf-1.9.0), which will have better IO performance. +(parallel-netcdf-1.9.0), which will have better IO performance. (Also +should be using a parallel file system to gain benefits.) To use parallel netcdf-4, set the environment variable NETCDFPAR to the directory containingthe lib and include directories, e.g., @@ -17,6 +18,14 @@ faster.) This in turn requires HDF5 1.10.3 or later. Netcdf-c can be build with or without pnetcdf enabled, but it is not used here through the netcdf-4 interface. (There is a separate IO option for PNETCDF that can be used). +Usage: io_form is 13, and must turn off colons from the filename (as for pnetcdf) +For example: + +&time_control + nocolons = .true. + io_form_history = 13 + + Tests for development used the following: parallel-netcdf 1.9.0 (--enable-relax-coord-bound --disable-cxx) @@ -30,4 +39,6 @@ IO output form for parallel netcdf-4 is 13 (io_netcdfpar=13 in Registry). Performance seems to vary with how 'regular' the domain decomposition is (i.e., patch size). Some experimentation with manually setting the decomposition -may be needed for optimal writing times. +may be needed for optimal writing times. Also pay attention to file system +striping (Lustre), where setting the number stripes should not exceed the +number of nodes used by the job. \ No newline at end of file From a2e85bb625adef09a455d3f37c310aadfe26bfd1 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Tue, 14 Sep 2021 12:15:48 -0500 Subject: [PATCH 05/17] Moved readme file to doc folder --- README.netcdf4par => doc/README.netcdf4par | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename README.netcdf4par => doc/README.netcdf4par (100%) diff --git a/README.netcdf4par b/doc/README.netcdf4par similarity index 100% rename from README.netcdf4par rename to doc/README.netcdf4par From 346ef78b5bb1d1f2504a03ce23c43fec7a406792 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 16 Sep 2021 12:24:41 -0600 Subject: [PATCH 06/17] parnetcdf4 trigger reggie without NMM --- external/io_netcdfpar/ext_ncdpar_get_dom_ti.code | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code index 0e41b521f8..49b9edf3cc 100644 --- a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code +++ b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code @@ -1,5 +1,5 @@ !*------------------------------------------------------------------------------ -!* Standard Disclaimer +!* Standard Disclaimer !* !* Forecast Systems Laboratory !* NOAA/OAR/ERL/FSL From 4bb5d9cd7af5e59b26740d2cc098bc0086006fec Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 16 Sep 2021 13:37:28 -0600 Subject: [PATCH 07/17] parnetcdf trigger #2 --- external/io_netcdfpar/ext_ncdpar_get_dom_ti.code | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code index 49b9edf3cc..0e41b521f8 100644 --- a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code +++ b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code @@ -1,5 +1,5 @@ !*------------------------------------------------------------------------------ -!* Standard Disclaimer +!* Standard Disclaimer !* !* Forecast Systems Laboratory !* NOAA/OAR/ERL/FSL From 94fb542b51935653e3c523563dd91f4fbc6312c8 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 16 Sep 2021 13:47:41 -0600 Subject: [PATCH 08/17] par2 test #3 reggie 13:47 --- external/io_netcdfpar/ext_ncdpar_get_dom_ti.code | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code index 0e41b521f8..49b9edf3cc 100644 --- a/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code +++ b/external/io_netcdfpar/ext_ncdpar_get_dom_ti.code @@ -1,5 +1,5 @@ !*------------------------------------------------------------------------------ -!* Standard Disclaimer +!* Standard Disclaimer !* !* Forecast Systems Laboratory !* NOAA/OAR/ERL/FSL From f177aa89d368b85a8767a15f63a4b802dd858398 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 3 Nov 2021 13:33:30 -0600 Subject: [PATCH 09/17] Fix logic so that 4.7.4 is minimum for NETCDFPAR usage The NetCDF version 4.7.4 is the earliest that permits the usage of the parallel and compressed options together. modified: configure --- configure | 37 +++++++++++++++++++++++++++++++++---- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/configure b/configure index 6d11819e69..b7900a40ea 100755 --- a/configure +++ b/configure @@ -159,10 +159,31 @@ if test -n "$PERL" ; then fi - +PROBS=FALSE if [ -n "$NETCDFPAR" ] ; then - echo "Will use NETCDFPAR in dir: $NETCDFPAR, which should be the same as $NETCDF" NETCDF="$NETCDFPAR" + if [ ! -e $NETCDF/bin/nc-config ] ; then + PROBS=TRUE + else + ncversion=`nc-config --version | awk '{print $2}'` + ncversiona=`echo $ncversion | cut -c 1` + ncversionb=`echo $ncversion | cut -c 3` + ncversionc=`echo $ncversion | cut -c 5` + ncversiona=`expr $ncversiona \* 100` + ncversionb=`expr $ncversionb \* 10` + ncversionabc=`expr $ncversiona + $ncversionb` + ncversionabc=`expr $ncversionabc + $ncversionc` + if [ $ncversionabc -lt 474 ] ; then + PROBS=TRUE + fi + fi + if [ "$PROBS" == "TRUE" ] ; then + echo + echo Cannot activate NETCDFPAR with this version of NetCDF: $ncversion + echo Need NetCDF v4.7.4 or greater + echo + exit + fi NETCDF4="1" USENETCDFPAR="1" export NETCDF @@ -908,6 +929,16 @@ EOF echo " C compiler is $SCC_arch" echo " Fortran compiler is $SFC_arch" echo " It will build in $netcdf_arch" + echo " " + if [ -e $NETCDF/bin/nc-config ] ; then + echo "NetCDF version: ${ncversion}" + echo "Enabled NetCDF-4/HDF-5: `nc-config --has-nc4`" + echo "NetCDF built with PnetCDF: `nc-config --has-pnetcdf`" + if [ "$USENETCDFPAR" == "1" ] ; then + echo "Using parallel NetCDF via NETCDFPAR option" + fi + echo " " + fi fi echo fi @@ -1022,11 +1053,9 @@ fi if [ -f /usr/include/rpc/types.h ] ; then sed -e '/^ARCH_LOCAL/s/$/ -DRPC_TYPES=1/' configure.wrf > configure.wrf.edit mv configure.wrf.edit configure.wrf -echo standard location of RPC elif [ -f /usr/include/tirpc/rpc/types.h ] ; then sed -e '/^ARCH_LOCAL/s/$/ -DRPC_TYPES=2/' configure.wrf > configure.wrf.edit mv configure.wrf.edit configure.wrf -echo newer location of RPC else echo "************************** W A R N I N G ************************************" echo " " From a79a72c7b29f8646274466630a4528829448bcc3 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 3 Nov 2021 14:59:09 -0600 Subject: [PATCH 10/17] Feature testing --- configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure b/configure index b7900a40ea..e0c485de6d 100755 --- a/configure +++ b/configure @@ -180,7 +180,7 @@ if [ -n "$NETCDFPAR" ] ; then if [ "$PROBS" == "TRUE" ] ; then echo echo Cannot activate NETCDFPAR with this version of NetCDF: $ncversion - echo Need NetCDF v4.7.4 or greater + echo You need NetCDF v4.7.4 or newer echo exit fi From 35cb651104276658f43373ee5b8bc055f6d80fc8 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 3 Nov 2021 16:05:41 -0600 Subject: [PATCH 11/17] Hmm, once more --- configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure b/configure index e0c485de6d..3ebb80e17e 100755 --- a/configure +++ b/configure @@ -180,7 +180,7 @@ if [ -n "$NETCDFPAR" ] ; then if [ "$PROBS" == "TRUE" ] ; then echo echo Cannot activate NETCDFPAR with this version of NetCDF: $ncversion - echo You need NetCDF v4.7.4 or newer + echo You need NetCDF version 4.7.4 or newer echo exit fi From 7065a83bac4eea6233107f2cc7584ab54eb45d43 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 4 Nov 2021 09:55:07 -0600 Subject: [PATCH 12/17] Try a push from command line with Feature label modified: configure --- configure | 1 + 1 file changed, 1 insertion(+) diff --git a/configure b/configure index 3ebb80e17e..192f609496 100755 --- a/configure +++ b/configure @@ -181,6 +181,7 @@ if [ -n "$NETCDFPAR" ] ; then echo echo Cannot activate NETCDFPAR with this version of NetCDF: $ncversion echo You need NetCDF version 4.7.4 or newer + echo Use a newer version of NetCDF, or unset the env variable NETCDFPAR echo exit fi From 09a3fe2acbbe7a9c79d4bfbf2a563a545ee60997 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 10 Nov 2021 00:54:12 -0700 Subject: [PATCH 13/17] Fix diffwrf with NETCDFPAR modified: Makefile modified: external/io_netcdfpar/Makefile modified: external/io_netcdfpar/wrf_io.F90 --- Makefile | 12 ++++++++++++ external/io_netcdfpar/Makefile | 10 +++++----- external/io_netcdfpar/wrf_io.F90 | 2 +- 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/Makefile b/Makefile index 60b61b0ae9..90e0df0f34 100644 --- a/Makefile +++ b/Makefile @@ -1012,6 +1012,18 @@ framework : CPP="$(CPP)" LDFLAGS="$(LDFLAGS)" TRADFLAG="$(TRADFLAG)" ESMF_IO_LIB_EXT="$(ESMF_IO_LIB_EXT)" \ LIB_LOCAL="$(LIB_LOCAL)" \ ESMF_MOD_DEPENDENCE="$(ESMF_MOD_DEPENDENCE)" AR="INTERNAL_BUILD_ERROR_SHOULD_NOT_NEED_AR"; \ + cd ../io_netcdfpar ; \ + $(MAKE) NETCDFPARPATH="$(NETCDFPATH)" \ + FC="$(FC) $(FCBASEOPTS) $(PROMOTION) $(FCDEBUG) $(OMP)" RANLIB="$(RANLIB)" \ + CPP="$(CPP)" LDFLAGS="$(LDFLAGS)" TRADFLAG="$(TRADFLAG)" ESMF_IO_LIB_EXT="$(ESMF_IO_LIB_EXT)" \ + LIB_LOCAL="$(LIB_LOCAL)" \ + ESMF_MOD_DEPENDENCE="$(ESMF_MOD_DEPENDENCE)" AR="INTERNAL_BUILD_ERROR_SHOULD_NOT_NEED_AR" diffwrf; \ + cd ../io_netcdfpar ; \ + $(MAKE) NETCDFPARPATH="$(NETCDFPATH)" \ + FC="$(SFC) $(FCBASEOPTS) $(PROMOTION) $(FCDEBUG) $(OMP)" RANLIB="$(RANLIB)" \ + CPP="$(CPP)" LDFLAGS="$(LDFLAGS)" TRADFLAG="$(TRADFLAG)" ESMF_IO_LIB_EXT="$(ESMF_IO_LIB_EXT)" \ + LIB_LOCAL="$(LIB_LOCAL)" \ + ESMF_MOD_DEPENDENCE="$(ESMF_MOD_DEPENDENCE)" AR="INTERNAL_BUILD_ERROR_SHOULD_NOT_NEED_AR"; \ cd ../io_pio ; \ echo SKIPPING PIO BUILD $(MAKE) NETCDFPATH="$(PNETCDFPATH)" \ FC="$(SFC) $(FCBASEOPTS) $(PROMOTION) $(FCDEBUG) $(OMP)" RANLIB="$(RANLIB)" \ diff --git a/external/io_netcdfpar/Makefile b/external/io_netcdfpar/Makefile index 1e2f4c31a2..87000c2a1a 100644 --- a/external/io_netcdfpar/Makefile +++ b/external/io_netcdfpar/Makefile @@ -24,7 +24,7 @@ libwrfio_nfpar.a: $(OBJS) $(CODE) $(RANLIB) $@ wrf_io.o: wrf_io.F90 $(CODE) - grep nf_format_64bit $(NETCDFPATH)/include/netcdf.inc ;\ + grep nf_format_64bit $(NETCDFPARPATH)/include/netcdf.inc ;\ a=$$? ; export a ; \ if [ $$a -a "$$WRFIO_NCD_LARGE_FILE_SUPPORT" = "1" ] ; then \ $(CPP1) -DWRFIO_NCD_LARGE_FILE_SUPPORT -I../ioapi_share wrf_io.F90 | $(M4) - > wrf_io.f ; \ @@ -43,14 +43,14 @@ diffwrf: diffwrf.F90 x=`echo "$(FC)" | awk '{print $$1}'` ; export x ; \ if [ $$x = "gfortran" ] ; then \ echo removing external declaration of iargc for gfortran ; \ - $(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share diffwrf.F90 | sed '/integer *, *external.*iargc/d' > diffwrf.f ;\ + $(CPP1) -I$(NETCDFPARPATH)/include -I../ioapi_share diffwrf.F90 | sed '/integer *, *external.*iargc/d' > diffwrf.f ;\ else \ - $(CPP1) -I$(NETCDFPATH)/include -I../ioapi_share diffwrf.F90 > diffwrf.f ; \ + $(CPP1) -I$(NETCDFPARPATH)/include -I../ioapi_share diffwrf.F90 > diffwrf.f ; \ fi $(FC) -c $(FFLAGS) diffwrf.f @if [ \( -f ../../frame/wrf_debug.o \) -a \( -f ../../frame/module_wrf_error.o \) -a \( -f $(ESMF_MOD_DEPENDENCE) \) -a \( -f ../../frame/clog.o \) ] ; then \ - echo "diffwrf io_netcdf is being built now. " ; \ - if [ \( -f $(NETCDFPATH)/lib/libnetcdff.a -o -f $(NETCDFPATH)/lib/libnetcdff.so \) ] ; then \ + echo "diffwrf io_netcdfpar is being built now. " ; \ + if [ \( -f $(NETCDFPARPATH)/lib/libnetcdff.a -o -f $(NETCDFPARPATH)/lib/libnetcdff.so \) ] ; then \ $(FC) $(FFLAGS) $(LDFLAGS) -o diffwrf diffwrf.o $(OBJSL) ../../frame/wrf_debug.o ../../frame/module_wrf_error.o ../../frame/clog.o $(ESMF_IO_LIB_EXT) $(LIBFFS) ;\ else \ $(FC) $(FFLAGS) $(LDFLAGS) -o diffwrf diffwrf.o $(OBJSL) ../../frame/wrf_debug.o ../../frame/module_wrf_error.o ../../frame/clog.o $(ESMF_IO_LIB_EXT) $(LIBS) ;\ diff --git a/external/io_netcdfpar/wrf_io.F90 b/external/io_netcdfpar/wrf_io.F90 index 10090e6cb0..a76ec5d82d 100644 --- a/external/io_netcdfpar/wrf_io.F90 +++ b/external/io_netcdfpar/wrf_io.F90 @@ -3191,7 +3191,7 @@ subroutine ext_ncdpar_write_field_orig(DataHandle,DateStr,Var,Field,FieldTypeIn, return endif if (DH%R4OnOutput .and. FieldTypeIn == WRF_DOUBLE) then - call TransposeToR4('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & + call TransposeToR4a('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & ,XField,x1,x2,y1,y2,z1,z2 & ,i1,i2,j1,j2,k1,k2 ) else From 618fd5e5597495741a62b1c4f9922155ec3fb1b6 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 10 Nov 2021 01:03:34 -0700 Subject: [PATCH 14/17] oops, add diffwrf.F90 for netcdfpar, oops new file: external/io_netcdfpar/diffwrf.F90 --- external/io_netcdfpar/diffwrf.F90 | 518 ++++++++++++++++++++++++++++++ 1 file changed, 518 insertions(+) create mode 100644 external/io_netcdfpar/diffwrf.F90 diff --git a/external/io_netcdfpar/diffwrf.F90 b/external/io_netcdfpar/diffwrf.F90 new file mode 100644 index 0000000000..ad70262968 --- /dev/null +++ b/external/io_netcdfpar/diffwrf.F90 @@ -0,0 +1,518 @@ +module read_util_module + +contains + + subroutine arguments(v2file, lmore) + implicit none + character(len=*) :: v2file + character(len=120) :: harg + logical :: lmore + + integer :: ierr, i, numarg + + numarg = command_argument_count() + + i = 1 + lmore = .false. + + do while ( i < numarg) + call get_command_argument(number=i, value=harg) + print*, 'harg = ', trim(harg) + + if (harg == "-v") then + i = i + 1 + lmore = .true. + elseif (harg == "-h") then + call help + endif + + enddo + + call get_command_argument(number=i, value=harg) + v2file = harg + end subroutine arguments + + subroutine help + implicit none + character(len=120) :: cmd + call get_command_argument(number=0, value=cmd) + + write(*,'(/,"Usage: ", A, " [-v] v2file ")') trim(cmd) + write(*,'(8x, "-v : Print extra info")') + write(*,'(8x, "v3file : MM5v3 file name to read.")') + write(*,'(8x, "-h : print this help message and exit.",/)') + stop + end subroutine help +end module read_util_module + + + + program readv3 + use wrf_data_ncpar + use read_util_module + implicit none +#include "wrf_status_codes.h" +#include "netcdf.inc" + character(len=255) :: flnm + character(len=255) :: flnm2 + character(len=120) :: arg3 + character(len=19) :: DateStr + character(len=19) :: DateStr2 + character(len=31) :: VarName + character(len=31) :: VarName2 + integer dh1, dh2 + + integer :: flag, flag2 + integer :: iunit, iunit2 + + integer :: i,j,k + integer :: levlim + integer :: cross + integer :: ndim, ndim2 + integer :: WrfType, WrfType2 + real :: time, time2 + real*8 :: a, b + real*8 :: sumE, sum1, sum2, diff1, diff2, serr, perr, rmse, rms1, rms2, tmp1, tmp2 + integer digits,d1, d2 + integer, dimension(4) :: start_index, end_index, start_index2, end_index2 + integer , Dimension(3) :: MemS,MemE,PatS,PatE + character (len= 4) :: staggering, staggering2 + character (len= 3) :: ordering, ordering2, ord + character (len=24) :: start_date, start_date2 + character (len=24) :: current_date, current_date2 + character (len=31) :: name, name2, tmpname + character (len=25) :: units, units2 + character (len=46) :: description, description2 + + character (len=80), dimension(3) :: dimnames + character (len=80) :: SysDepInfo + + logical :: first, searchcoords + integer :: l, n, ntimes + integer :: ikdiffs, ifdiffs + integer :: icenter, prev_icenter, jcenter, prev_jcenter,ntries + real :: searchlat, searchlong + + real, allocatable, dimension(:,:,:,:) :: data,data2 + real, allocatable, dimension(:,:) :: xlat,xlong + + integer :: ierr, ierr2, ier, ier2, Status, Status_next_time, Status_next_time2, Status_next_var, Status_next_var_2 + integer :: nargs + + logical :: newtime = .TRUE. + logical :: justplot, efound + + logical, external :: iveceq + + levlim = -1 + + call ext_ncdpar_ioinit(SysDepInfo,Status) + call set_wrf_debug_level ( 1 ) + + nargs = command_argument_count() + + Justplot = .false. + searchcoords = .false. +! get arguments + if ( nargs .ge. 2 ) then + call get_command_argument(number=1, value=flnm) + call get_command_argument(number=2, value=flnm2) + IF ( flnm2(1:4) .EQ. '-lat' ) THEN +print*,'reading ',TRIM(flnm2(5:)) + read(flnm2(5:),*)searchlat + call get_command_argument(number=3, value=flnm2) + IF ( flnm2(1:5) .EQ. '-long' ) THEN +print*,'reading ',TRIM(flnm2(6:)) + read(flnm2(6:),*)searchlong + ELSE + write(*,*)'missing -long argument (no spaces after -lat or -long, either)' + STOP + ENDIF + nargs = 0 + Justplot = .true. + searchcoords = .true. + call ext_ncdpar_open_for_read( trim(flnm), 0, 0, "", dh1, Status) + goto 924 + ENDIF + ierr = 0 + call ext_ncdpar_open_for_read( trim(flnm), 0, 0, "", dh1, Status) + if ( Status /= 0 ) then + print*,'error opening ',flnm, ' Status = ', Status ; stop + endif + call ext_ncdpar_open_for_read( trim(flnm2), 0, 0, "", dh2, Status) + if ( Status /= 0 ) go to 923 + goto 924 +923 continue + +! bounce here if second name is not openable -- this would mean that +! it is a field name instead. + + print*,'could not open ',flnm2 + name = flnm2 + Justplot = .true. +924 continue + if ( nargs .eq. 3 ) then + call get_command_argument(number=3, value=arg3) + read(arg3,*)levlim + print*,'LEVLIM = ',LEVLIM + endif + else + print*,'Usage: command file1 file2' + stop + endif + +print*,'Just plot ',Justplot + +if ( Justplot ) then + print*, 'flnm = ', trim(flnm) + first = .TRUE. + + call ext_ncdpar_get_next_time(dh1, DateStr, Status_next_time) + + ntimes = 0 + DO WHILE ( Status_next_time .eq. 0 ) + write(*,*)'Next Time ',TRIM(Datestr) + ntimes = ntimes + 1 + call ext_ncdpar_get_next_var (dh1, VarName, Status_next_var) + DO WHILE ( Status_next_var .eq. 0 ) +! write(*,*)'Next Var |',TRIM(VarName),'|' + + start_index = 1 + end_index = 1 + call ext_ncdpar_get_var_info (dh1,VarName,ndim,ordering,staggering,start_index,end_index, WrfType, ierr ) + if(WrfType /= WRF_REAL .AND. WrfType /= WRF_DOUBLE) then + call ext_ncdpar_get_next_var (dh1, VarName, Status_next_var) + cycle + endif + IF ( .NOT. searchcoords ) THEN + write(*,'(A9,1x,I1,3(1x,I5),1x,A,1x,A)')& + VarName, ndim, end_index(1), end_index(2), end_index(3), & + trim(ordering), trim(DateStr) + ENDIF + + if ( VarName .eq. name .OR. TRIM(VarName) .EQ. 'XLAT' .OR. TRIM(VarName) .EQ. 'XLONG' ) then + write(*,*)'Writing fort.88 file for ', trim(name) + + allocate(data(end_index(1), end_index(2), end_index(3), 1)) + + if ( ndim .eq. 3 ) then + ord = 'XYZ' + else if ( ndim .eq. 2 ) then + ord = 'XY' + else if ( ndim .eq. 1 ) then + ord = 'Z' + else if ( ndim .eq. 0 ) then + ord = '0' + endif + + call ext_ncdpar_read_field(dh1,DateStr,TRIM(VarName),data,WRF_REAL,0,0,0,ord, & + staggering, dimnames , & + start_index,end_index, & !dom + start_index,end_index, & !mem + start_index,end_index, & !pat + ierr) + + if ( ierr/=0 ) then + write(*,*)'error reading data record' + write(*,*)' ndim = ', ndim + write(*,*)' end_index(1) ',end_index(1) + write(*,*)' end_index(2) ',end_index(2) + write(*,*)' end_index(3) ',end_index(3) + endif + +write(*,*)'name: ',TRIM(VarName) + IF ( TRIM(VarName) .EQ. 'XLAT' .AND. .NOT. ALLOCATED(xlat)) THEN +write(*,*)'allocating xlat' + ALLOCATE(xlat(end_index(1), end_index(2))) + xlat = data(:,:,1,1) + ENDIF + IF ( TRIM(VarName) .EQ. 'XLONG' .AND. .NOT. ALLOCATED(xlong)) THEN +write(*,*)'allocating xlong' + ALLOCATE(xlong(end_index(1), end_index(2))) + xlong = data(:,:,1,1) + ENDIF + + + if ( VarName .eq. name ) then +#if 0 +! uncomment this to have the code give i-slices + do i = 1, end_index(1) + if ( levlim .eq. -1 .or. i .eq. levlim ) then + write(88,*)end_index(2),end_index(3),' ',trim(name),' ',k,' time ',TRIM(Datestr) + do k = start_index(3), end_index(3) + do j = 1, end_index(2) + write(88,*) data(i,j,k,1) + enddo + enddo + endif + enddo +#else +! give k-slices + do k = start_index(3), end_index(3) + if ( levlim .eq. -1 .or. k .eq. levlim ) then + write(88,*)end_index(1),end_index(2),' ',trim(name),' ',k,' time ',TRIM(Datestr) + do j = 1, end_index(2) + do i = 1, end_index(1) + write(88,*) data(i,j,k,1) + enddo + enddo + endif + enddo +#endif + endif + + deallocate(data) + endif + call ext_ncdpar_get_next_var (dh1, VarName, Status_next_var) + IF ( ntimes .EQ. 1 .AND. ALLOCATED(xlong) .AND. ALLOCATED(xlat) .AND. first ) THEN + first = .FALSE. + icenter = 1 + jcenter = 1 + ntries = 0 + prev_icenter = 0 + prev_jcenter = 0 + DO WHILE ( ntries .LT. 10 .AND. (icenter .NE. prev_icenter .OR. jcenter .NE. prev_jcenter )) + prev_icenter = icenter + prev_jcenter = jcenter + DO j = start_index(2), end_index(2)-1 + IF ( xlat(icenter,j) .LE. searchlat .AND. searchlat .LT. xlat(icenter,j+1) ) THEN + jcenter = j +!write(*,*)'xlat ',ntries,icenter,jcenter,xlat(icenter,j),searchlat + exit + ENDIF + ENDDO + DO i = start_index(1), end_index(1)-1 + IF ( xlong(i,jcenter) .LE. searchlong .AND. searchlong .LT. xlong(i+1,jcenter)) THEN + icenter = i +!write(*,*)'xlon ',ntries,icenter,jcenter,xlong(i,jcenter),searchlong + exit + ENDIF + ENDDO + ntries = ntries + 1 + ENDDO + write(*,*)'Lon ',searchlong,' Lat ',searchlat,' : ',icenter,jcenter + write(*,*)'Coordinates at that point ',xlong(icenter,jcenter),xlat(icenter,jcenter) + write(*,*)'Coordinates at next point ',xlong(icenter+1,jcenter+1),xlat(icenter+1,jcenter+1) + write(*,*)'Ntries : ',ntries + if ( ntries .GE. 10 ) write(*,*)'max tries exceeded. Probably did not find' + ENDIF + enddo + call ext_ncdpar_get_next_time(dh1, DateStr, Status_next_time) + enddo +else + write (6,FMT='(4A)') 'Diffing ',trim(flnm),' ',trim(flnm2) + + call ext_ncdpar_get_next_time(dh1, DateStr, Status_next_time) + call ext_ncdpar_get_next_time(dh2, DateStr2, Status_next_time2) + + IF ( DateStr .NE. DateStr2 ) THEN + print*,'They differ big time. Dates do not match' + print*,' ',flnm,' ',DateStr + print*,' ',flnm2,' ',DateStr2 + Status_next_time = 1 + ENDIF + + DO WHILE ( Status_next_time .eq. 0 .AND. Status_next_time2 .eq. 0 ) + write(*,*)'Next Time ',TRIM(Datestr) + print 76 + call ext_ncdpar_get_next_var (dh1, VarName, Status_next_var) + DO WHILE ( Status_next_var .eq. 0 ) +! write(*,*)'Next Var |',TRIM(VarName),'|' + + start_index = 1 + end_index = 1 + start_index2 = 1 + end_index2 = 1 + + call ext_ncdpar_get_var_info (dh1,VarName,ndim,ordering,staggering,start_index,end_index, WrfType, ierr ) + call ext_ncdpar_get_var_info (dh2,VarName,ndim2,ordering2,staggering2,start_index2,end_index2, WrfType2, ierr ) + IF ( ierr /= 0 ) THEN + write(*,*)'Big difference: ',VarName,' not found in ',flnm2 + GOTO 1234 + ENDIF + IF ( ndim /= ndim2 ) THEN + write(*,*)'Big difference: Number of dimensions for ',Varname,' differs in ',flnm2,'(',ndim,') /= (',ndim2 + GOTO 1234 + ENDIF + IF ( WrfType /= WrfType2 ) THEN + write(*,*)'Big difference: The types do not match' + GOTO 1234 + ENDIF + if( WrfType == WRF_REAL) then + DO i = 1, ndim + IF ( end_index(i) /= end_index2(i) ) THEN + write(*,*)'Big difference: dim ',i,' lengths differ for ',Varname,' differ in ',flnm2 + GOTO 1234 + ENDIF + ENDDO + DO i = ndim+1,3 + start_index(i) = 1 + end_index(i) = 1 + start_index2(i) = 1 + end_index2(i) = 1 + ENDDO + +! write(*,'(A9,1x,I1,3(1x,I3),1x,A,1x,A)')& +! VarName, ndim, end_index(1), end_index(2), end_index(3), & +! trim(ordering), trim(DateStr) + + allocate(data (end_index(1), end_index(2), end_index(3), 1)) + allocate(data2(end_index(1), end_index(2), end_index(3), 1)) + + if ( ndim .eq. 3 ) then + ord = 'XYZ' + else if ( ndim .eq. 2 ) then + ord = 'XY' + else if ( ndim .eq. 1 ) then + ord = 'Z' + else if ( ndim .eq. 0 ) then + ord = '0' + endif + + call ext_ncdpar_read_field(dh1,DateStr,TRIM(VarName),data,WRF_REAL,0,0,0,ord,& + staggering, dimnames , & + start_index,end_index, & !dom + start_index,end_index, & !mem + start_index,end_index, & !pat + ierr) + + IF ( ierr /= 0 ) THEN + write(*,*)'Error reading ',Varname,' from ',flnm + write(*,*)' ndim = ', ndim + write(*,*)' end_index(1) ',end_index(1) + write(*,*)' end_index(2) ',end_index(2) + write(*,*)' end_index(3) ',end_index(3) + ENDIF + call ext_ncdpar_read_field(dh2,DateStr,TRIM(VarName),data2,WRF_REAL,0,0,0,ord,& + staggering, dimnames , & + start_index,end_index, & !dom + start_index,end_index, & !mem + start_index,end_index, & !pat + ierr) + IF ( ierr /= 0 ) THEN + write(*,*)'Error reading ',Varname,' from ',flnm2 + write(*,*)' ndim = ', ndim + write(*,*)' end_index(1) ',end_index(1) + write(*,*)' end_index(2) ',end_index(2) + write(*,*)' end_index(3) ',end_index(3) + ENDIF + + IFDIFFS=0 + sumE = 0.0 + sum1 = 0.0 + sum2 = 0.0 + diff1 = 0.0 + diff2 = 0.0 + n = 0 + DO K = 1,end_index(3)-start_index(3)+1 + IF (LEVLIM.EQ.-1.OR.K.EQ.LEVLIM.OR.NDIM.eq.2) THEN + cross = 0 + IKDIFFS = 0 + do i = 1, end_index(1)-cross + do j = 1, end_index(2)-cross + a = data(I,J,K,1) + b = data2(I,J,K,1) + ! borrowed from Thomas Oppe's comp program + sumE = sumE + ( a - b ) * ( a - b ) + sum1 = sum1 + a * a + sum2 = sum2 + b * b + diff1 = max ( diff1 , abs ( a - b ) ) + diff2 = max ( diff2 , abs ( b ) ) + n = n + 1 + IF (a .ne. b) then + IKDIFFS = IKDIFFS + 1 + IFDIFFS = IFDIFFS + 1 + ENDIF + ENDDO + ENDDO + ENDIF + enddo + rmsE = sqrt ( sumE / dble( n ) ) + rms1 = sqrt ( sum1 / dble( n ) ) + rms2 = sqrt ( sum2 / dble( n ) ) + serr = 0.0 + IF ( sum2 .GT. 0.0d0 ) THEN + serr = sqrt ( sumE / sum2 ) + ELSE + IF ( sumE .GT. 0.0d0 ) serr = 1.0 + ENDIF + perr = 0.0 + IF ( diff2 .GT. 0.0d0 ) THEN + perr = diff1/diff2 + ELSE + IF ( diff1 .GT. 0.0d0 ) perr = 1.0 + ENDIF + + IF ( rms1 - rms2 .EQ. 0.0d0 ) THEN + digits = 15 + ELSE + IF ( rms2 .NE. 0 ) THEN + tmp1 = 1.0d0/( ( abs( rms1 - rms2 ) ) / rms2 ) + IF ( tmp1 .NE. 0 ) THEN + digits = log10(tmp1) + ENDIF + ENDIF + ENDIF + + IF (IFDIFFS .NE. 0 ) THEN + ! create the fort.88 and fort.98 files because regression scripts will + ! look for these to see if there were differences. + write(88,*)trim(varname) + write(98,*)trim(varname) + PRINT 77,trim(varname), IFDIFFS, ndim, rms1, rms2, digits, rmsE, perr + 76 FORMAT (5x,'Field ',2x,'Ndifs',4x,'Dims ',6x,'RMS (1)',12x,'RMS (2)',5x,'DIGITS',4x,'RMSE',5x,'pntwise max') + 77 FORMAT ( A10,1x,I9,2x,I3,1x,e18.10,1x,e18.10,1x,i3,1x,e12.4,1x,e12.4 ) + ENDIF + deallocate(data) + deallocate(data2) + + endif + 1234 CONTINUE + call ext_ncdpar_get_next_var (dh1, VarName, Status_next_var) + enddo + call ext_ncdpar_get_next_time(dh1, DateStr, Status_next_time) + call ext_ncdpar_get_next_time(dh2, DateStr2, Status_next_time2) + IF ( DateStr .NE. DateStr2 ) THEN + print*,'They differ big time. Dates do not match' + print*,'They differ big time. Dates do not match' + print*,' ',flnm,' ',DateStr + print*,' ',flnm2,' ',DateStr2 + Status_next_time = 1 + ENDIF + enddo + +endif + +end program readv3 + +logical function wrf_dm_on_monitor() + wrf_dm_on_monitor=.true. +end function wrf_dm_on_monitor + +logical function iveceq( a, b, n ) + implicit none + integer n + integer a(n), b(n) + integer i + iveceq = .true. + do i = 1,n + if ( a(i) .ne. b(i) ) iveceq = .false. + enddo + return +end function iveceq + +! stubs for routines called by module_wrf_error (used by netcdf implementation of IO api) +SUBROUTINE wrf_abort + STOP +END SUBROUTINE wrf_abort + +SUBROUTINE get_current_time_string( time_str ) + CHARACTER(LEN=*), INTENT(OUT) :: time_str + time_str = '' +END SUBROUTINE get_current_time_string + +SUBROUTINE get_current_grid_name( grid_str ) + CHARACTER(LEN=*), INTENT(OUT) :: grid_str + grid_str = '' +END SUBROUTINE get_current_grid_name + From 9711a5a7f35fa8a4f4c0350ad7821ce5a029d919 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 8 Dec 2021 07:55:37 -0700 Subject: [PATCH 15/17] Error codes from NETCDF are larger than I3 modified: share/mediation_integrate.F --- share/mediation_integrate.F | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/share/mediation_integrate.F b/share/mediation_integrate.F index 4ad05543ce..0aec92b25e 100644 --- a/share/mediation_integrate.F +++ b/share/mediation_integrate.F @@ -2367,7 +2367,7 @@ SUBROUTINE open_aux_u ( grid , config_flags, stream, alarm_id, & config_flags , insub , n2, ierr ) ENDIF IF ( ierr .NE. 0 ) THEN - WRITE ( message , '("open_aux_u : error opening ",A," for reading. ",I3)') & + WRITE ( message , '("open_aux_u : error opening ",A," for reading. ",I5)') & TRIM ( fname ), ierr CALL wrf_message( message ) ENDIF @@ -2463,8 +2463,8 @@ SUBROUTINE open_hist_w ( grid , config_flags, stream, alarm_id, & config_flags , outsub , n2, ierr ) ENDIF IF ( ierr .NE. 0 ) THEN - WRITE ( message , '("open_hist_w : error opening ",A," for writing. ",I3)') & - TRIM ( fname ), ierr + WRITE ( message , '("open_hist_w : error opening ",A," for writing. ",I5)') & + TRIM ( fname ), ierr CALL wrf_message( message ) ENDIF From 279617637de5e115ea86c1e0fd86c6db081d51ed Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 8 Dec 2021 22:43:49 -0700 Subject: [PATCH 16/17] netcdf4 22:43 --- configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure b/configure index 192f609496..946288c3fd 100755 --- a/configure +++ b/configure @@ -1093,7 +1093,7 @@ if [ -n "$NETCDF4" ] ; then echo "!!! configure.wrf has been REMOVED !!!" echo echo "*****************************************************************************" - # rm -f configure.wrf + rm -f configure.wrf else echo "*****************************************************************************" echo "This build of WRF will use NETCDF4 with HDF5 compression" From 3cd4713b40124919107a05801e2ce1d244769f60 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Wed, 22 Dec 2021 20:39:35 -0600 Subject: [PATCH 17/17] Added missing changes to md_calls.m4, which fixes missing metadata in netcdf output. --- arch/md_calls.inc | 522 ++++++++++++++++++++++++++++++++++++++++++++++ frame/md_calls.m4 | 14 ++ 2 files changed, 536 insertions(+) diff --git a/arch/md_calls.inc b/arch/md_calls.inc index 46acd2b7d4..88e0722fbb 100644 --- a/arch/md_calls.inc +++ b/arch/md_calls.inc @@ -278,6 +278,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_dom_ti_double ( Hndl, Element, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_dom_ti_real ( Hndl, Element, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -481,6 +492,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_dom_ti_double ( Hndl, Element, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_dom_ti_real ( Hndl, Element, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -686,6 +708,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_dom_ti_double ( Hndl, Element, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_dom_ti_real ( Hndl, Element, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -889,6 +922,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_dom_ti_double ( Hndl, Element, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_dom_ti_real ( Hndl, Element, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -1089,6 +1133,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_double ( Hndl, Element, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_double ( Hndl, Element, Data, & @@ -1247,6 +1297,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_double ( Hndl, Element, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_double ( Hndl, Element, Data, & @@ -1407,6 +1463,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_double ( Hndl, Element, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_double ( Hndl, Element, Data, & @@ -1565,6 +1627,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_double ( Hndl, Element, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_double ( Hndl, Element, Data, & @@ -1725,6 +1793,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_integer ( Hndl, Element, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_integer ( Hndl, Element, Data, & @@ -1883,6 +1957,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_integer ( Hndl, Element, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_integer ( Hndl, Element, Data, & @@ -2043,6 +2123,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_integer ( Hndl, Element, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_integer ( Hndl, Element, Data, & @@ -2201,6 +2287,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_integer ( Hndl, Element, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_integer ( Hndl, Element, Data, & @@ -2361,6 +2453,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_logical ( Hndl, Element, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_logical ( Hndl, Element, Data, & @@ -2519,6 +2617,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_logical ( Hndl, Element, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_logical ( Hndl, Element, Data, & @@ -2679,6 +2783,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_logical ( Hndl, Element, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_logical ( Hndl, Element, Data, & @@ -2837,6 +2947,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_logical ( Hndl, Element, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_logical ( Hndl, Element, Data, & @@ -2997,6 +3113,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_ti_char ( Hndl, Element, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_ti_char ( Hndl, Element, Data, & @@ -3157,6 +3279,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_ti_char ( Hndl, Element, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_ti_char ( Hndl, Element, Data, & @@ -3323,6 +3451,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_dom_td_real ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -3526,6 +3665,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_dom_td_real ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -3731,6 +3881,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_dom_td_real ( Hndl, Element, DateStr, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -3934,6 +4095,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_dom_td_real ( Hndl, Element, DateStr, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -4134,6 +4306,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_double ( Hndl, Element, DateStr, Data, & @@ -4292,6 +4470,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_double ( Hndl, Element, DateStr, Data, & @@ -4452,6 +4636,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_double ( Hndl, Element, DateStr, Data, & @@ -4610,6 +4800,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_double ( Hndl, Element, DateStr, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_double ( Hndl, Element, DateStr, Data, & @@ -4770,6 +4966,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_integer ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_integer ( Hndl, Element, DateStr, Data, & @@ -4928,6 +5130,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_integer ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_integer ( Hndl, Element, DateStr, Data, & @@ -5088,6 +5296,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_integer ( Hndl, Element, DateStr, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_integer ( Hndl, Element, DateStr, Data, & @@ -5246,6 +5460,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_integer ( Hndl, Element, DateStr, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_integer ( Hndl, Element, DateStr, Data, & @@ -5406,6 +5626,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_logical ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_logical ( Hndl, Element, DateStr, Data, & @@ -5564,6 +5790,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_logical ( Hndl, Element, DateStr, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_logical ( Hndl, Element, DateStr, Data, & @@ -5724,6 +5956,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_logical ( Hndl, Element, DateStr, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_logical ( Hndl, Element, DateStr, Data, & @@ -5882,6 +6120,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_logical ( Hndl, Element, DateStr, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_logical ( Hndl, Element, DateStr, Data, & @@ -6042,6 +6286,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_dom_td_char ( Hndl, Element, DateStr, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_dom_td_char ( Hndl, Element, DateStr, Data, & @@ -6202,6 +6452,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_dom_td_char ( Hndl, Element, DateStr, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_dom_td_char ( Hndl, Element, DateStr, Data, & @@ -6368,6 +6624,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_var_ti_real ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -6571,6 +6838,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_var_ti_real ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -6581,6 +6859,16 @@ IF ( Hndl .GT. -1 ) THEN locCount, Outcount, Status ) # endif #endif +#ifdef PIO + CASE ( IO_PIO ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_pnc_get_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +# else + CALL ext_pnc_get_var_ti_real ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +# endif +#endif #ifdef PHDF5 CASE ( IO_PHDF5 ) # if ( RWORDSIZE == DWORDSIZE ) @@ -6776,6 +7064,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_var_ti_real ( Hndl, Element, Varname, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -6979,6 +7278,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_var_ti_real ( Hndl, Element, Varname, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -7179,6 +7489,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_double ( Hndl, Element, Varname, Data, & @@ -7337,6 +7653,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_double ( Hndl, Element, Varname, Data, & @@ -7497,6 +7819,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_double ( Hndl, Element, Varname, Data, & @@ -7655,6 +7983,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_double ( Hndl, Element, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_double ( Hndl, Element, Varname, Data, & @@ -7815,6 +8149,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_integer ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_integer ( Hndl, Element, Varname, Data, & @@ -7973,6 +8313,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_integer ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_integer ( Hndl, Element, Varname, Data, & @@ -8133,6 +8479,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_integer ( Hndl, Element, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_integer ( Hndl, Element, Varname, Data, & @@ -8291,6 +8643,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_integer ( Hndl, Element, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_integer ( Hndl, Element, Varname, Data, & @@ -8451,6 +8809,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_logical ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_logical ( Hndl, Element, Varname, Data, & @@ -8609,6 +8973,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_logical ( Hndl, Element, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_logical ( Hndl, Element, Varname, Data, & @@ -8769,6 +9139,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_logical ( Hndl, Element, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_logical ( Hndl, Element, Varname, Data, & @@ -8927,6 +9303,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_logical ( Hndl, Element, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_logical ( Hndl, Element, Varname, Data, & @@ -9087,6 +9469,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_ti_char ( Hndl, Element, Varname, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_ti_char ( Hndl, Element, Varname, Data, & @@ -9247,6 +9635,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_ti_char ( Hndl, Element, Varname, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_ti_char ( Hndl, Element, Varname, Data, & @@ -9413,6 +9807,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_var_td_real ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -9616,6 +10021,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_get_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +# else + CALL ext_ncdpar_get_var_td_real ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -9821,6 +10237,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_var_td_real ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -10024,6 +10451,17 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_put_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +# else + CALL ext_ncdpar_put_var_td_real ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +# endif +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) # if ( RWORDSIZE == DWORDSIZE ) @@ -10224,6 +10662,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_double ( Hndl, Element, DateStr, Varname, Data, & @@ -10382,6 +10826,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_double ( Hndl, Element, DateStr, Varname, Data, & @@ -10542,6 +10992,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_double ( Hndl, Element, DateStr, Varname, Data, & @@ -10700,6 +11156,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_double ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_double ( Hndl, Element, DateStr, Varname, Data, & @@ -10860,6 +11322,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & @@ -11018,6 +11486,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & @@ -11178,6 +11652,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & @@ -11336,6 +11816,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_integer ( Hndl, Element, DateStr, Varname, Data, & @@ -11496,6 +11982,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & @@ -11654,6 +12146,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & + locCount, Outcount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & @@ -11814,6 +12312,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & @@ -11972,6 +12476,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & + locCount, Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_logical ( Hndl, Element, DateStr, Varname, Data, & @@ -12132,6 +12642,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_get_var_td_char ( Hndl, Element, DateStr, Varname, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_get_var_td_char ( Hndl, Element, DateStr, Varname, Data, & @@ -12292,6 +12808,12 @@ IF ( Hndl .GT. -1 ) THEN CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) + CALL ext_ncdpar_put_var_td_char ( Hndl, Element, DateStr, Varname, Data, & + Status ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) CALL ext_pnc_put_var_td_char ( Hndl, Element, DateStr, Varname, Data, & diff --git a/frame/md_calls.m4 b/frame/md_calls.m4 index 307bb8bb18..84a52c8fec 100644 --- a/frame/md_calls.m4 +++ b/frame/md_calls.m4 @@ -84,6 +84,20 @@ ifelse($3,real, CALL wrf_dm_bcast_bytes( Status, IWORDSIZE ) ENDIF #endif +#ifdef NETCDFPAR + CASE ( IO_NETCDFPAR ) +ifelse($3,real, +`# if ( RWORDSIZE == DWORDSIZE ) + CALL ext_ncdpar_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, & + ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status ) +# else + CALL ext_ncdpar_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, & + ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status ) +# endif', +` CALL ext_ncdpar_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, & + ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' ) +#endif + #ifdef PNETCDF CASE ( IO_PNETCDF ) ifelse($3,real,