From 091b2fe4622278b622af6336c70164ce7c79139c Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:38:33 -0600 Subject: [PATCH 01/20] Modifying #ifdef structure for cmake syntax --- external/atm_ocn/cmpcomm.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/atm_ocn/cmpcomm.F b/external/atm_ocn/cmpcomm.F index a78e285337..89cd554e1c 100644 --- a/external/atm_ocn/cmpcomm.F +++ b/external/atm_ocn/cmpcomm.F @@ -1,4 +1,4 @@ -#if defined( DM_PARALLEL ) +#ifdef DM_PARALLEL MODULE CMP_COMM implicit none From 82ed6c100d9bf927e8bb8c11fe5708efe83d0038 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:39:04 -0600 Subject: [PATCH 02/20] Modifying #ifdef structure for cmake syntax --- frame/module_configure.F | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/frame/module_configure.F b/frame/module_configure.F index 4e0ae808c3..8554a7d92a 100644 --- a/frame/module_configure.F +++ b/frame/module_configure.F @@ -15,7 +15,8 @@ SUBROUTINE init_module_scalar_tables END SUBROUTINE init_module_scalar_tables END MODULE module_scalar_tables -#if( WRF_CHEM == 1 && WRF_KPP == 1 ) +#ifdef WRF_CHEM +#ifdef WRF_KPP MODULE module_irr_diag INTEGER, parameter :: max_eqn = 1200 @@ -45,6 +46,7 @@ END SUBROUTINE init_module_irr_diag END MODULE module_irr_diag #endif +#endif MODULE module_configure From 8f252f86bdf2b4f04a608272b99b89931018d9ea Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:40:50 -0600 Subject: [PATCH 03/20] Ignoring _build directory --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index eca261d36e..c47fe3e850 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ configure.wrf* *.backup *.f90 +_build/ \ No newline at end of file From a6676c49f71694e3546d3cd6178e623ce883273e Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:42:10 -0600 Subject: [PATCH 04/20] Fairly confident this was a bug --- tools/gen_allocs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/gen_allocs.c b/tools/gen_allocs.c index c7e7953257..abafbcb893 100644 --- a/tools/gen_allocs.c +++ b/tools/gen_allocs.c @@ -659,7 +659,7 @@ gen_dealloc2 ( FILE * fp , char * structname , node_t * node ) fprintf(fp, " DEALLOCATE(%s%s,STAT=ierr)\n if (ierr.ne.0) then\n CALL wrf_error_fatal ( &\n'frame/module_domain.f: Failed to deallocate %s%s. ')\n endif\n", structname, fname, structname, fname ) ; -#ifdef USE_ALLOCATABLES +#ifndef USE_ALLOCATABLES fprintf(fp, " NULLIFY(%s%s)\n",structname, fname ) ; #endif From 6497be377297af1992ff918ed88968bc2c1926c1 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:42:41 -0600 Subject: [PATCH 05/20] Adding nonzero macro check for function returns rather than failing silently --- tools/registry.c | 75 +++++++++++++++++++++++++----------------------- 1 file changed, 39 insertions(+), 36 deletions(-) diff --git a/tools/registry.c b/tools/registry.c index 79f7983ed7..937cef5a18 100644 --- a/tools/registry.c +++ b/tools/registry.c @@ -18,6 +18,9 @@ #include "data.h" #include "sym.h" +// Helper macro to actually do return checks +#define NON_ZERO_RETURN( A ) { int result = A; if ( result != 0 ) { printf( "Error in %s, non-zero return expected", #A ); exit(result); } } + /* SamT: bug fix: main returns int */ int main( int argc, char *argv[], char *env[] ) @@ -132,11 +135,11 @@ main( int argc, char *argv[], char *env[] ) argv++ ; } - gen_io_boilerplate() ; /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ + NON_ZERO_RETURN( gen_io_boilerplate() ); /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ - init_parser() ; - init_type_table() ; - init_dim_table() ; + NON_ZERO_RETURN( init_parser() ); + NON_ZERO_RETURN( init_type_table() ); + NON_ZERO_RETURN( init_dim_table() ); // // possible IRR diagnostcis? // @@ -230,45 +233,45 @@ main( int argc, char *argv[], char *env[] ) } - reg_parse(fp_tmp) ; + NON_ZERO_RETURN( reg_parse(fp_tmp) ); fclose(fp_tmp) ; - check_dimspecs() ; + NON_ZERO_RETURN( check_dimspecs() ); - gen_state_struct( "inc" ) ; - gen_state_subtypes( "inc" ) ; - gen_alloc( "inc" ) ; + NON_ZERO_RETURN( gen_state_struct( "inc" ) ); + NON_ZERO_RETURN( gen_state_subtypes( "inc" ) ); + NON_ZERO_RETURN( gen_alloc( "inc" ) ); /* gen_alloc_count( "inc" ) ; */ - gen_dealloc( "inc" ) ; - gen_scalar_indices( "inc" ) ; - gen_module_state_description( "frame" ) ; - gen_actual_args( "inc" ) ; - gen_actual_args_new( "inc" ) ; - gen_dummy_args( "inc" ) ; - gen_dummy_args_new( "inc" ) ; - gen_dummy_decls( "inc" ) ; - gen_dummy_decls_new( "inc" ) ; - gen_i1_decls( "inc" ) ; - gen_namelist_statements("inc") ; - gen_namelist_defines ( "inc", 0 ) ; /* without dimension statements */ - gen_namelist_defines ( "inc", 1 ) ; /* with dimension statements */ - gen_namelist_defaults ( "inc" ) ; - gen_namelist_script ( "inc" ) ; - gen_get_nl_config( "inc" ) ; - gen_config_assigns( "inc" ) ; - gen_config_reads( "inc" ) ; - gen_wrf_io( "inc" ) ; - gen_model_data_ord( "inc" ) ; - gen_nest_interp( "inc" ) ; - gen_nest_v_interp( "inc") ; /*KAL added this for vertical interpolation*/ - gen_scalar_derefs( "inc" ) ; - gen_streams("inc") ; + NON_ZERO_RETURN( gen_dealloc( "inc" ) ) ; + NON_ZERO_RETURN( gen_scalar_indices( "inc" ) ) ; + NON_ZERO_RETURN( gen_module_state_description( "frame" ) ) ; + NON_ZERO_RETURN( gen_actual_args( "inc" ) ) ; + NON_ZERO_RETURN( gen_actual_args_new( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_args( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_args_new( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_decls( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_decls_new( "inc" ) ) ; + NON_ZERO_RETURN( gen_i1_decls( "inc" ) ) ; + NON_ZERO_RETURN( gen_namelist_statements("inc") ; ) + NON_ZERO_RETURN( gen_namelist_defines ( "inc", 0 ) ) ; /* without dimension statements */ + NON_ZERO_RETURN( gen_namelist_defines ( "inc", 1 ) ) ; /* with dimension statements */ + NON_ZERO_RETURN( gen_namelist_defaults ( "inc" ) ) ; + NON_ZERO_RETURN( gen_namelist_script ( "inc" ) ) ; + NON_ZERO_RETURN( gen_get_nl_config( "inc" ) ) ; + NON_ZERO_RETURN( gen_config_assigns( "inc" ) ) ; + NON_ZERO_RETURN( gen_config_reads( "inc" ) ) ; + NON_ZERO_RETURN( gen_wrf_io( "inc" ) ) ; + NON_ZERO_RETURN( gen_model_data_ord( "inc" ) ) ; + NON_ZERO_RETURN( gen_nest_interp( "inc" ) ) ; + NON_ZERO_RETURN( gen_nest_v_interp( "inc") ; ) /*KAL added this for vertical interpolation*/ + NON_ZERO_RETURN( gen_scalar_derefs( "inc" ) ) ; + NON_ZERO_RETURN( gen_streams("inc") ; ) /* this has to happen after gen_nest_interp, which adds halos to the AST */ - gen_comms( "inc" ) ; /* this is either package supplied (by copying a */ - /* gen_comms.c file into this directory) or a */ - /* stubs routine. */ + NON_ZERO_RETURN( gen_comms( "inc" ) ); /* this is either package supplied (by copying a */ + /* gen_comms.c file into this directory) or a */ + /* stubs routine. */ cleanup: #ifdef _WIN32 From 3998795bb38a2e15f470f72f8a565df45e9f5960 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Mon, 8 May 2023 19:01:59 -0600 Subject: [PATCH 06/20] Making registry work in out of source build --- tools/gen_streams.c | 4 +++- tools/reg_parse.c | 15 +++++++++++---- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/tools/gen_streams.c b/tools/gen_streams.c index f93cf3989d..e6cbda002d 100644 --- a/tools/gen_streams.c +++ b/tools/gen_streams.c @@ -607,12 +607,14 @@ gen_med_find_esmf_coupling ( FILE *fp ) for each stream. This file is then included by the registry.io_boilerplate file when the registry actually runs. As with the other mods above, this allows a variable, compile-time number of io streams. Note that this one is self contained and dirname is hard-coded. + AI: In an effort to delineate true source files from autogen stuff this is now not going into hard-coded + Registry so that we can use ./ as an alternate include location */ int gen_io_boilerplate () { FILE * fp ; - char * dirname = "Registry" ; + char * dirname = "./" ; char fname[NAMELEN] ; char * fn ; char * aux , *streamtype , streamno[5] ; diff --git a/tools/reg_parse.c b/tools/reg_parse.c index 01176c0ea4..5321b58402 100644 --- a/tools/reg_parse.c +++ b/tools/reg_parse.c @@ -116,21 +116,28 @@ pre_parse( char * dir, FILE * infile, FILE * outfile ) for ( p = inln ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( !strncmp( p , "include", 7 ) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) { FILE *include_fp ; + char include_file_name_dir[128] ; char include_file_name[128] ; p += 7 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; } else { - sprintf( include_file_name , "%s/%s", dir , p ) ; + + sprintf( include_file_name, "%s", p ) ; if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ; + sprintf( include_file_name_dir, "%s/%s", dir , include_file_name ) ; + fprintf(stderr,"opening %s\n",include_file_name) ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { + if ( ( ( include_fp = fopen( include_file_name, "r" ) ) != NULL ) || // Use short circuit logic here to try both sequentially + ( ( include_fp = fopen( include_file_name_dir, "r" ) ) != NULL ) ) + { fprintf(stderr,"including %s\n",include_file_name ) ; pre_parse( dir , include_fp , outfile ) ; fclose( include_fp ) ; - } else { - fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ; + } + else { + fprintf(stderr,"Registry warning: cannot open %s. Tried %s and %s Ignoring.\n", include_file_name, include_file_name, include_file_name_dir ) ; } } } From 3eb5cb6d3317a40d37e6265e3ddb6f00df57e3f3 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:33:59 -0600 Subject: [PATCH 07/20] Simplifying #if[n]defs --- dyn_em/module_advect_em.F | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dyn_em/module_advect_em.F b/dyn_em/module_advect_em.F index ff03d1a695..2913ac5a9c 100644 --- a/dyn_em/module_advect_em.F +++ b/dyn_em/module_advect_em.F @@ -1,7 +1,7 @@ !WRF:MODEL_LAYER:DYNAMICS ! -#if ( defined(ADVECT_KERNEL) ) +#ifdef ADVECT_KERNEL ! cpp -traditional-cpp -P -DADVECT_KERNEL module_advect_em.F > advection_kernel.f90 ! gfortran -ffree-form -ffree-line-length-none advection_kernel.f90 ! ./a.out @@ -111,7 +111,7 @@ SUBROUTINE column (loop , data_list, its,ite) END SUBROUTINE column !---------------------------------------------------------------- -#elif ( ! defined(ADVECT_KERNEL) ) +#else MODULE module_advect_em @@ -4357,7 +4357,7 @@ SUBROUTINE advect_scalar ( field, field_old, tendency, & ENDIF vert_order_test END SUBROUTINE advect_scalar -#if ( ! defined(ADVECT_KERNEL) ) +#ifndef ADVECT_KERNEL !--------------------------------------------------------------------------------- @@ -10543,7 +10543,7 @@ END SUBROUTINE advect_scalar_mono !----------------------------------------------------------- -#if ( defined(ADVECT_KERNEL) ) +#ifdef ADVECT_KERNEL END MODULE advection_kernel !================================================================ @@ -10851,7 +10851,7 @@ PROGRAM feeder END PROGRAM feeder #endif -#if ( !defined(ADVECT_KERNEL) ) +#ifndef ADVECT_KERNEL !--------------------------------------------------------------------------------- From af7f3a4f4ac600e3fc5c80781a3a5c450cd87b00 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:34:34 -0600 Subject: [PATCH 08/20] Adding missing & --- dyn_em/module_first_rk_step_part1.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index f5eb26734d..157f260be8 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -925,7 +925,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & & ,iopt_crop=config_flags%opt_crop, iopt_irr=config_flags%opt_irr & & ,iopt_irrm=config_flags%opt_irrm & & ,iopt_infdv=config_flags%opt_infdv,iopt_tdrn=config_flags%opt_tdrn & - & ,soiltstep=config_flags%soiltstep + & ,soiltstep=config_flags%soiltstep & & , isnowxy=grid%isnowxy , tvxy=grid%tvxy , tgxy=grid%tgxy & & ,canicexy=grid%canicexy ,canliqxy=grid%canliqxy, eahxy=grid%eahxy & & , tahxy=grid%tahxy , cmxy=grid%cmxy , chxy=grid%chxy & From f2b882a23087cc0a8f481c4e17c4d2581e7c7219 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:45:19 -0600 Subject: [PATCH 09/20] I believe this was a bug, no idea how it was even working before --- external/io_grib2/g2lib/dec_png.c | 2 +- external/io_grib2/g2lib/enc_png.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/external/io_grib2/g2lib/dec_png.c b/external/io_grib2/g2lib/dec_png.c index aa85184b36..a33c0c0ac6 100644 --- a/external/io_grib2/g2lib/dec_png.c +++ b/external/io_grib2/g2lib/dec_png.c @@ -88,7 +88,7 @@ int DEC_PNG(unsigned char *pngbuf,g2int *width,g2int *height,char *cout) /* Set new custom read function */ - png_set_read_fn(png_ptr,(voidp)&read_io_ptr,(png_rw_ptr)user_read_data); + png_set_read_fn(png_ptr,(png_voidp)&read_io_ptr,(png_rw_ptr)user_read_data); /* png_init_io(png_ptr, fptr); */ /* Read and decode PNG stream */ diff --git a/external/io_grib2/g2lib/enc_png.c b/external/io_grib2/g2lib/enc_png.c index 7d2ef1d287..97d0b961a9 100644 --- a/external/io_grib2/g2lib/enc_png.c +++ b/external/io_grib2/g2lib/enc_png.c @@ -88,7 +88,7 @@ int ENC_PNG(char *data,g2int *width,g2int *height,g2int *nbits,char *pngbuf) /* Set new custom write functions */ - png_set_write_fn(png_ptr,(voidp)&write_io_ptr,(png_rw_ptr)user_write_data, + png_set_write_fn(png_ptr,(png_voidp)&write_io_ptr,(png_rw_ptr)user_write_data, (png_flush_ptr)user_flush_data); /* png_init_io(png_ptr, fptr); */ /* png_set_compression_level(png_ptr, Z_BEST_COMPRESSION); */ From d541360fec9fd499ad4b2f58e5b3cf772daa8396 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:49:00 -0600 Subject: [PATCH 10/20] Switching io_int/intio tags to #defines --- external/io_int/io_int.F90 | 116 ++++++++++++++++++----------------- external/io_int/io_int_idx.c | 2 +- inc/intio_tags.h | 68 ++++++++++---------- 3 files changed, 94 insertions(+), 92 deletions(-) diff --git a/external/io_int/io_int.F90 b/external/io_int/io_int.F90 index e57224b51e..ab95b49a45 100644 --- a/external/io_int/io_int.F90 +++ b/external/io_int/io_int.F90 @@ -9,6 +9,8 @@ ! Uses header manipulation routines in module_io_quilt.F ! +#include "intio_tags.h" + MODULE module_ext_internal USE module_internal_header_util @@ -168,7 +170,7 @@ SUBROUTINE ext_int_open_for_write( FileName , Comm_compute, Comm_io, SysDepInfo, DataHandle , Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + CHARACTER*(*) :: FileName INTEGER , INTENT(IN) :: Comm_compute , Comm_io CHARACTER*(*) :: SysDepInfo @@ -187,7 +189,7 @@ SUBROUTINE ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDe DataHandle , Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + #include "wrf_io_flags.h" CHARACTER*(*) :: FileName INTEGER , INTENT(IN) :: Comm_compute , Comm_io @@ -221,7 +223,7 @@ END SUBROUTINE ext_int_open_for_write_begin SUBROUTINE ext_int_open_for_write_commit( DataHandle , Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + #include "wrf_io_flags.h" INTEGER , INTENT(IN ) :: DataHandle INTEGER , INTENT(OUT) :: Status @@ -362,7 +364,7 @@ SUBROUTINE ext_int_ioexit( Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(OUT) :: Status INTEGER :: DataHandle INTEGER i,ierr @@ -375,7 +377,7 @@ END SUBROUTINE ext_int_ioexit SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: DateStr INTEGER , INTENT(OUT) :: Status @@ -417,7 +419,7 @@ SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status ) READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , locMemoryOrder , locStagger , locDimNames , & @@ -433,7 +435,7 @@ SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status ) ELSE READ( unit=DataHandle, iostat=istat ) ENDIF - ELSE IF ( code .EQ. int_dom_td_char ) THEN + ELSE IF ( code .EQ. INT_DOM_TD_CHAR ) THEN CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locDateStr, locElement, locData, loccode ) IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN ! control break, return this date @@ -460,13 +462,13 @@ END SUBROUTINE ext_int_get_next_time SUBROUTINE ext_int_set_time ( DataHandle, DateStr, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: DateStr INTEGER , INTENT(OUT) :: Status CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, "TIMESTAMP", "", TRIM(DateStr), int_set_time ) + DataHandle, "TIMESTAMP", "", TRIM(DateStr), INT_SET_TIME ) WRITE( unit=DataHandle ) hdrbuf Status = 0 RETURN @@ -477,7 +479,7 @@ SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , St DomainStart , DomainEnd , WrfType, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: VarName integer ,intent(out) :: NDim @@ -519,7 +521,7 @@ SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , St READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , MemoryOrder , locStagger , locDimNames , & @@ -561,7 +563,7 @@ END SUBROUTINE ext_int_get_var_info SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status ) USE module_ext_internal IMPLICIT NONE - include 'intio_tags.h' + include 'wrf_status_codes.h' INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: VarName @@ -606,20 +608,20 @@ SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status ) IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) #if 1 - IF ( code .EQ. int_dom_ti_char ) THEN + IF ( code .EQ. INT_DOM_TI_CHAR ) THEN CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locElement, dumstr, strData, loccode ) ENDIF - IF ( code .EQ. int_dom_ti_integer ) THEN + IF ( code .EQ. INT_DOM_TI_INTEGER ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, iData, loccount, code ) ENDIF - IF ( code .EQ. int_dom_ti_real ) THEN + IF ( code .EQ. INT_DOM_TI_REAL ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, rData, loccount, code ) ENDIF #endif - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , locMemoryOrder , locStagger , locDimNames , & @@ -660,7 +662,7 @@ END SUBROUTINE ext_int_get_next_var SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element REAL , INTENT(OUT) :: Data(*) @@ -681,7 +683,7 @@ SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount READ( unit=DataHandle , iostat = istat ) hdrbuf IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_ti_real ) THEN + IF ( code .EQ. INT_DOM_TI_REAL ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, Data, loccount, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN @@ -690,11 +692,11 @@ SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount ENDIF keepgoing = .false. ; Status = 0 ENDIF - ELSE IF ( .NOT. ( code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_logical .OR. & - code .EQ. int_dom_ti_char .OR. code .EQ. int_dom_ti_double .OR. & - code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_logical .OR. & - code .EQ. int_dom_td_char .OR. code .EQ. int_dom_td_double .OR. & - code .EQ. int_dom_td_real ) ) THEN + ELSE IF ( .NOT. ( code .EQ. INT_DOM_TI_INTEGER .OR. code .EQ. INT_DOM_TI_LOGICAL .OR. & + code .EQ. INT_DOM_TI_CHAR .OR. code .EQ. INT_DOM_TI_DOUBLE .OR. & + code .EQ. INT_DOM_TD_INTEGER .OR. code .EQ. INT_DOM_TD_LOGICAL .OR. & + code .EQ. INT_DOM_TD_CHAR .OR. code .EQ. INT_DOM_TD_DOUBLE .OR. & + code .EQ. INT_DOM_TD_REAL ) ) THEN BACKSPACE ( unit=DataHandle ) keepgoing = .false. ; Status = 2 ENDIF @@ -712,7 +714,7 @@ END SUBROUTINE ext_int_get_dom_ti_real SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element, Data, Count, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element REAL , INTENT(IN) :: Data(*) @@ -726,7 +728,7 @@ SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element, Data, Count, Status ! Do nothing unless it is time to write time-independent domain metadata. IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & - DataHandle, Element, Data, Count, int_dom_ti_real ) + DataHandle, Element, Data, Count, INT_DOM_TI_REAL ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -772,7 +774,7 @@ END SUBROUTINE ext_int_put_dom_ti_double SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outcount, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element integer , INTENT(OUT) :: Data(*) @@ -793,7 +795,7 @@ SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outco READ( unit=DataHandle , iostat = istat ) hdrbuf IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_ti_integer ) THEN + IF ( code .EQ. INT_DOM_TI_INTEGER ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, Data, loccount, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN @@ -803,11 +805,11 @@ SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outco keepgoing = .false. ; Status = 0 ENDIF - ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real .OR. code .EQ. int_dom_ti_logical .OR. & - code .EQ. int_dom_ti_char .OR. code .EQ. int_dom_ti_double .OR. & - code .EQ. int_dom_td_real .OR. code .EQ. int_dom_td_logical .OR. & - code .EQ. int_dom_td_char .OR. code .EQ. int_dom_td_double .OR. & - code .EQ. int_dom_td_integer ) ) THEN + ELSE IF ( .NOT. ( code .EQ. INT_DOM_TI_REAL .OR. code .EQ. INT_DOM_TI_LOGICAL .OR. & + code .EQ. INT_DOM_TI_CHAR .OR. code .EQ. INT_DOM_TI_DOUBLE .OR. & + code .EQ. INT_DOM_TD_REAL .OR. code .EQ. INT_DOM_TD_LOGICAL .OR. & + code .EQ. INT_DOM_TD_CHAR .OR. code .EQ. INT_DOM_TD_DOUBLE .OR. & + code .EQ. INT_DOM_TD_INTEGER ) ) THEN BACKSPACE ( unit=DataHandle ) keepgoing = .false. ; Status = 1 ENDIF @@ -825,7 +827,7 @@ END SUBROUTINE ext_int_get_dom_ti_integer SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element, Data, Count, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element INTEGER , INTENT(IN) :: Data(*) @@ -838,7 +840,7 @@ SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element, Data, Count, Stat ! Do nothing unless it is time to write time-independent domain metadata. IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, itypesize, & - DataHandle, Element, Data, Count, int_dom_ti_integer ) + DataHandle, Element, Data, Count, INT_DOM_TI_INTEGER ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -884,7 +886,7 @@ END SUBROUTINE ext_int_put_dom_ti_logical SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data @@ -905,17 +907,17 @@ SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element, Data, Status ) IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_ti_char ) THEN + IF ( code .EQ. INT_DOM_TI_CHAR ) THEN CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locElement, dumstr, Data, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN keepgoing = .false. ; Status = 0 ENDIF - ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real .OR. code .EQ. int_dom_ti_logical .OR. & - code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_double .OR. & - code .EQ. int_dom_td_real .OR. code .EQ. int_dom_td_logical .OR. & - code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_double .OR. & - code .EQ. int_dom_td_char ) ) THEN + ELSE IF ( .NOT. ( code .EQ. INT_DOM_TI_REAL .OR. code .EQ. INT_DOM_TI_LOGICAL .OR. & + code .EQ. INT_DOM_TI_INTEGER .OR. code .EQ. INT_DOM_TI_DOUBLE .OR. & + code .EQ. INT_DOM_TD_REAL .OR. code .EQ. INT_DOM_TD_LOGICAL .OR. & + code .EQ. INT_DOM_TD_INTEGER .OR. code .EQ. INT_DOM_TD_DOUBLE .OR. & + code .EQ. INT_DOM_TD_CHAR ) ) THEN BACKSPACE ( unit=DataHandle ) keepgoing = .false. ; Status = 1 ENDIF @@ -933,7 +935,7 @@ END SUBROUTINE ext_int_get_dom_ti_char SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data @@ -947,7 +949,7 @@ SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element, Data, Status ) ! Do nothing unless it is time to write time-independent domain metadata. IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, Element, "", Data, int_dom_ti_char ) + DataHandle, Element, "", Data, INT_DOM_TI_CHAR ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1062,7 +1064,7 @@ END SUBROUTINE ext_int_put_dom_td_logical SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data, DateStr @@ -1080,7 +1082,7 @@ SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr, Data, Status IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_td_char ) THEN + IF ( code .EQ. INT_DOM_TD_CHAR ) THEN CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locDateStr, locElement, Data, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN @@ -1103,7 +1105,7 @@ END SUBROUTINE ext_int_get_dom_td_char SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data, DateStr @@ -1114,7 +1116,7 @@ SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr, Data, Status IF ( int_valid_handle ( Datahandle ) ) THEN IF ( int_handle_in_use( DataHandle ) ) THEN CALL int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, DateStr, Element, Data, int_dom_td_char ) + DataHandle, DateStr, Element, Data, INT_DOM_TD_CHAR ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1178,7 +1180,7 @@ END SUBROUTINE ext_int_put_var_ti_double SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element, Varname, Data, Count, Outcount, Status ) USE module_ext_internal IMPLICIT NONE -#include "intio_tags.h" + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1192,7 +1194,7 @@ SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element, Varname, Data, Coun IF ( int_handle_in_use( DataHandle ) ) THEN READ( unit=DataHandle ) hdrbuf code=hdrbuf(2) - IF ( code .NE. int_var_ti_integer ) THEN + IF ( code .NE. INT_VAR_TI_INTEGER ) THEN BACKSPACE ( unit=DataHandle ) write(*,*) 'unexpected code=',code,' in ext_int_get_var_ti_integer' Status = 1 @@ -1219,7 +1221,7 @@ SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element, Varname, Data, Coun USE module_ext_internal USE module_internal_header_util, only: int_gen_ti_header_integer_varna IMPLICIT NONE -#include "intio_tags.h" + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1230,7 +1232,7 @@ SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element, Varname, Data, Coun IF ( int_handle_in_use( DataHandle ) ) THEN CALL int_gen_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize,4, & DataHandle, TRIM(Element), TRIM(VarName), Data, Count, & - int_var_ti_integer ) + INT_VAR_TI_INTEGER ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1267,7 +1269,7 @@ END SUBROUTINE ext_int_put_var_ti_logical SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element, Varname, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1279,7 +1281,7 @@ SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element, Varname, Data, Status IF ( int_handle_in_use( DataHandle ) ) THEN READ( unit=DataHandle ) hdrbuf code=hdrbuf(2) - IF ( code .NE. int_var_ti_char ) THEN + IF ( code .NE. INT_VAR_TI_CHAR ) THEN BACKSPACE ( unit=DataHandle ) Status = 1 return @@ -1302,7 +1304,7 @@ END SUBROUTINE ext_int_get_var_ti_char SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element, Varname, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1313,7 +1315,7 @@ SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element, Varname, Data, Status IF ( int_valid_handle (DataHandle) ) THEN IF ( int_handle_in_use( DataHandle ) ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), int_var_ti_char ) + DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), INT_VAR_TI_CHAR ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1465,7 +1467,7 @@ SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldTy USE module_ext_internal IMPLICIT NONE #include "wrf_io_flags.h" - include 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: DateStr CHARACTER*(*) :: VarName @@ -1519,7 +1521,7 @@ SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldTy READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , locMemoryOrder , locStagger , locDimNames , & diff --git a/external/io_int/io_int_idx.c b/external/io_int/io_int_idx.c index 8f812dd356..772263359e 100644 --- a/external/io_int/io_int_idx.c +++ b/external/io_int/io_int_idx.c @@ -19,7 +19,7 @@ #include #include "io_int_idx.h" -#include "io_int_idx_tags.h" +#include "intio_tags.h" /* Static/Private functions within this file */ diff --git a/inc/intio_tags.h b/inc/intio_tags.h index 3808968cf5..daa130ef5f 100644 --- a/inc/intio_tags.h +++ b/inc/intio_tags.h @@ -1,34 +1,34 @@ - INTEGER, PARAMETER :: int_ioexit = 10 - INTEGER, PARAMETER :: int_open_for_write_begin = 20 - INTEGER, PARAMETER :: int_open_for_write_commit = 30 - INTEGER, PARAMETER :: int_open_for_read = 40 - INTEGER, PARAMETER :: int_inquire_opened = 60 - INTEGER, PARAMETER :: int_inquire_filename = 70 - INTEGER, PARAMETER :: int_iosync = 80 - INTEGER, PARAMETER :: int_ioclose = 90 - INTEGER, PARAMETER :: int_next_time = 100 - INTEGER, PARAMETER :: int_set_time = 110 - INTEGER, PARAMETER :: int_next_var = 120 - INTEGER, PARAMETER :: int_dom_ti_real = 140 - INTEGER, PARAMETER :: int_dom_ti_double = 160 - INTEGER, PARAMETER :: int_dom_ti_integer = 180 - INTEGER, PARAMETER :: int_dom_ti_logical = 200 - INTEGER, PARAMETER :: int_dom_ti_char = 220 - INTEGER, PARAMETER :: int_dom_td_real = 240 - INTEGER, PARAMETER :: int_dom_td_double = 260 - INTEGER, PARAMETER :: int_dom_td_integer = 280 - INTEGER, PARAMETER :: int_dom_td_logical = 300 - INTEGER, PARAMETER :: int_dom_td_char = 320 - INTEGER, PARAMETER :: int_var_ti_real = 340 - INTEGER, PARAMETER :: int_var_ti_double = 360 - INTEGER, PARAMETER :: int_var_ti_integer = 380 - INTEGER, PARAMETER :: int_var_ti_logical = 400 - INTEGER, PARAMETER :: int_var_ti_char = 420 - INTEGER, PARAMETER :: int_var_td_real = 440 - INTEGER, PARAMETER :: int_var_td_double = 460 - INTEGER, PARAMETER :: int_var_td_integer = 480 - INTEGER, PARAMETER :: int_var_td_logical = 500 - INTEGER, PARAMETER :: int_var_td_char = 520 - INTEGER, PARAMETER :: int_field = 530 - INTEGER, PARAMETER :: int_var_info = 540 - INTEGER, PARAMETER :: int_noop = 550 +#define INT_IOEXIT 10 +#define INT_OPEN_FOR_WRITE_BEGIN 20 +#define INT_OPEN_FOR_WRITE_COMMIT 30 +#define INT_OPEN_FOR_READ 40 +#define INT_INQUIRE_OPENED 60 +#define INT_INQUIRE_FILENAME 70 +#define INT_IOSYNC 80 +#define INT_IOCLOSE 90 +#define INT_NEXT_TIME 100 +#define INT_SET_TIME 110 +#define INT_NEXT_VAR 120 +#define INT_DOM_TI_REAL 140 +#define INT_DOM_TI_DOUBLE 160 +#define INT_DOM_TI_INTEGER 180 +#define INT_DOM_TI_LOGICAL 200 +#define INT_DOM_TI_CHAR 220 +#define INT_DOM_TD_REAL 240 +#define INT_DOM_TD_DOUBLE 260 +#define INT_DOM_TD_INTEGER 280 +#define INT_DOM_TD_LOGICAL 300 +#define INT_DOM_TD_CHAR 320 +#define INT_VAR_TI_REAL 340 +#define INT_VAR_TI_DOUBLE 360 +#define INT_VAR_TI_INTEGER 380 +#define INT_VAR_TI_LOGICAL 400 +#define INT_VAR_TI_CHAR 420 +#define INT_VAR_TD_REAL 440 +#define INT_VAR_TD_DOUBLE 460 +#define INT_VAR_TD_INTEGER 480 +#define INT_VAR_TD_LOGICAL 500 +#define INT_VAR_TD_CHAR 520 +#define INT_FIELD 530 +#define INT_VAR_INFO 540 +#define INT_NOOP 550 From db27276c275ac77448f5093a157735c974821faf Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:50:50 -0600 Subject: [PATCH 11/20] Adjusting for new ioint tags --- frame/module_internal_header_util.F | 42 +++---- frame/module_io_quilt_old.F | 182 ++++++++++++++-------------- 2 files changed, 112 insertions(+), 112 deletions(-) diff --git a/frame/module_internal_header_util.F b/frame/module_internal_header_util.F index bfff25916a..35ad9d92b6 100644 --- a/frame/module_internal_header_util.F +++ b/frame/module_internal_header_util.F @@ -110,7 +110,7 @@ SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For a "write field" header it must be set to -! int_field. See file intio_tags.h for a complete list of +! INT_FIELD. See file intio_tags.h for a complete list of ! these tags. ! ftypesize: Size of field data type in bytes. ! DataHandle: Descriptor for an open data set. @@ -145,7 +145,7 @@ SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize hdrbuf(1) = 0 ! deferred -- this will be length of header - hdrbuf(2) = int_field + hdrbuf(2) = INT_FIELD hdrbuf(3) = ftypesize i = 4 @@ -215,8 +215,8 @@ SUBROUTINE int_get_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize INTEGER i, n hdrbufsize = hdrbuf(1) - IF ( hdrbuf(2) .NE. int_field ) THEN - write(mess,*)'int_get_write_field_header: hdrbuf(2) ne int_field ',hdrbuf(2),int_field + IF ( hdrbuf(2) .NE. INT_FIELD ) THEN + write(mess,*)'int_get_write_field_header: hdrbuf(2) ne INT_FIELD ',hdrbuf(2),INT_FIELD CALL wrf_error_fatal ( mess ) ENDIF ftypesize = hdrbuf(3) @@ -269,7 +269,7 @@ SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "open for read" header it must be set to -! int_open_for_read. See file intio_tags.h for a complete list of +! INT_OPEN_FOR_READ. See file intio_tags.h for a complete list of ! these tags. ! DataHandle: Descriptor for an open data set. ! FileName: File name. @@ -292,7 +292,7 @@ SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, & INTEGER i, n, i1 ! hdrbuf(1) = 0 !deferred - hdrbuf(2) = int_open_for_read + hdrbuf(2) = INT_OPEN_FOR_READ i = 3 hdrbuf(i) = DataHandle ; i = i+1 @@ -324,8 +324,8 @@ SUBROUTINE int_get_ofr_header( hdrbuf, hdrbufsize, itypesize, & INTEGER i, n ! hdrbufsize = hdrbuf(1) -! IF ( hdrbuf(2) .NE. int_open_for_read ) THEN -! CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne int_open_for_read") +! IF ( hdrbuf(2) .NE. INT_OPEN_FOR_READ ) THEN +! CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne INT_OPEN_FOR_READ") ! ENDIF i = 3 DataHandle = hdrbuf(i) ; i = i+1 @@ -356,7 +356,7 @@ SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "open for write begin" header it must be set to -! int_open_for_write_begin. See file intio_tags.h for a complete list of +! INT_OPEN_FOR_WRITE_BEGIN. See file intio_tags.h for a complete list of ! these tags. ! DataHandle: Descriptor for an open data set. ! io_form: I/O format for this file (netCDF, etc.). @@ -381,7 +381,7 @@ SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, & INTEGER i, n, j ! hdrbuf(1) = 0 !deferred - hdrbuf(2) = int_open_for_write_begin + hdrbuf(2) = INT_OPEN_FOR_WRITE_BEGIN i = 3 hdrbuf(i) = DataHandle ; i = i+1 hdrbuf(i) = io_form ; i = i+1 @@ -420,8 +420,8 @@ SUBROUTINE int_get_ofwb_header( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize = hdrbuf(1) !write(0,*)' int_get_ofwb_header next rec start ',hdrbuf(hdrbufsize+1) -! IF ( hdrbuf(2) .NE. int_open_for_write_begin ) THEN -! CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne int_open_for_write_begin") +! IF ( hdrbuf(2) .NE. INT_OPEN_FOR_WRITE_BEGIN ) THEN +! CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne INT_OPEN_FOR_WRITE_BEGIN") ! ENDIF i = 3 DataHandle = hdrbuf(i) ; i = i+1 @@ -529,7 +529,7 @@ SUBROUTINE int_gen_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-independent integer" header it must be -! set to int_dom_ti_integer. See file intio_tags.h for a complete +! set to INT_DOM_TI_INTEGER. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: Size in bytes of each element of Data. @@ -584,7 +584,7 @@ SUBROUTINE int_gen_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize, types ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-independent integer" header it must be -! set to int_dom_ti_integer. See file intio_tags.h for a complete +! set to INT_DOM_TI_INTEGER. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: Size in bytes of each element of Data. @@ -761,7 +761,7 @@ SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-independent string" header it must be -! set to int_dom_ti_char. See file intio_tags.h for a complete +! set to INT_DOM_TI_CHAR. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: 1 (size in bytes of a single CHARACTER). @@ -852,7 +852,7 @@ SUBROUTINE int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-dependent string" header it must be -! set to int_dom_td_char. See file intio_tags.h for a complete +! set to INT_DOM_TD_CHAR. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: 1 (size in bytes of a single CHARACTER). @@ -937,7 +937,7 @@ SUBROUTINE int_gen_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-dependent integer" header it must be -! set to int_dom_td_integer. See file intio_tags.h for a complete +! set to INT_DOM_TD_INTEGER. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: 1 (size in bytes of a single CHARACTER). @@ -1074,7 +1074,7 @@ SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize ) ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "no-operation" header it must be -! set to int_noop. See file intio_tags.h for a complete +! set to INT_NOOP. See file intio_tags.h for a complete ! list of these tags. ! ! @@ -1087,7 +1087,7 @@ SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize ) INTEGER i ! hdrbuf(1) = 0 !deferred - hdrbuf(2) = int_noop + hdrbuf(2) = INT_NOOP i = 3 hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize @@ -1110,8 +1110,8 @@ SUBROUTINE int_get_noop_header( hdrbuf, hdrbufsize, itypesize ) INTEGER i ! hdrbufsize = hdrbuf(1) - IF ( hdrbuf(2) .NE. int_noop ) THEN - CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne int_noop") + IF ( hdrbuf(2) .NE. INT_NOOP ) THEN + CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne INT_NOOP") ENDIF i = 3 RETURN diff --git a/frame/module_io_quilt_old.F b/frame/module_io_quilt_old.F index e46d8b1095..69e443a69b 100644 --- a/frame/module_io_quilt_old.F +++ b/frame/module_io_quilt_old.F @@ -743,7 +743,7 @@ SUBROUTINE quilt ALLOCATE( obuf( 4096 ) ) ! DataHandle is provided as second element of reduced CALL int_gen_handle_header( obuf, obufsize, itypesize, & - reduced(2) , int_ioclose ) + reduced(2) , INT_IOCLOSE ) if(poll_servers) then ! Once we're done closing, we need to tell the master @@ -775,7 +775,7 @@ SUBROUTINE quilt DO WHILE ( icurs .lt. obufsize ) ! { hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -806,7 +806,7 @@ SUBROUTINE quilt call add_to_bufsize_for_field( VarName, chunksize ) icurs = icurs + chunksize ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call add_to_bufsize_for_field( 'COMMIT', hdrbufsize ) @@ -851,14 +851,14 @@ SUBROUTINE quilt ! call to collect_on_comm: 1 bona fide output record from server task ! 0 and noops from the rest. - IF ((hdr_tag.EQ.int_noop.AND.mytask_local.NE.0.AND.num_noops.LE.0) & - .OR.hdr_tag.NE.int_noop) THEN + IF ((hdr_tag.EQ.INT_NOOP.AND.mytask_local.NE.0.AND.num_noops.LE.0) & + .OR.hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'X-2', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call add_to_bufsize_for_field( VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT ENDDO ! } @@ -874,7 +874,7 @@ SUBROUTINE quilt !write(0,*) 'A icurs ', icurs, ' obufsize ', obufsize hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -902,7 +902,7 @@ SUBROUTINE quilt call store_piece_of_field( obuf(icurs/itypesize), VarName, chunksize ) icurs = icurs + chunksize ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call store_piece_of_field( obuf(icurs/itypesize), 'COMMIT', hdrbufsize ) @@ -911,14 +911,14 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize CASE DEFAULT hdrbufsize = obuf(icurs/itypesize) - IF ((hdr_tag.EQ.int_noop.AND.mytask_local.NE.0.AND.num_noops.LE.0) & - .OR.hdr_tag.NE.int_noop) THEN + IF ((hdr_tag.EQ.INT_NOOP.AND.mytask_local.NE.0.AND.num_noops.LE.0) & + .OR.hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'A-2b', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call store_piece_of_field( obuf(icurs/itypesize), VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT ENDDO !} @@ -981,12 +981,12 @@ SUBROUTINE quilt ! actually quite easy. "Noop" requests exist to help avoid race conditions. ! In some cases, only one compute task will everything about a request so ! other compute tasks send "noop" requests. - CASE ( int_noop ) + CASE ( INT_NOOP ) CALL int_get_noop_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize ) icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_dom_td_real" request. - CASE ( int_dom_td_real ) + CASE ( INT_DOM_TD_REAL ) CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_td_header( bigbuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1020,8 +1020,8 @@ SUBROUTINE quilt DEALLOCATE( RData ) ! The I/O server "root" handles the "put_dom_ti_real" request. - CASE ( int_dom_ti_real ) -!write(0,*)' int_dom_ti_real ' + CASE ( INT_DOM_TI_REAL ) +!write(0,*)' INT_DOM_TI_REAL ' CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_ti_header( bigbuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1057,8 +1057,8 @@ SUBROUTINE quilt DEALLOCATE( RData ) ! The I/O server "root" handles the "put_dom_td_integer" request. - CASE ( int_dom_td_integer ) -!write(0,*)' int_dom_td_integer ' + CASE ( INT_DOM_TD_INTEGER ) +!write(0,*)' INT_DOM_TD_INTEGER ' CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_td_header( bigbuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1093,8 +1093,8 @@ SUBROUTINE quilt DEALLOCATE( IData ) ! The I/O server "root" handles the "put_dom_ti_integer" request. - CASE ( int_dom_ti_integer ) -!write(0,*)' int_dom_ti_integer ' + CASE ( INT_DOM_TI_INTEGER ) +!write(0,*)' INT_DOM_TI_INTEGER ' CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -1131,8 +1131,8 @@ SUBROUTINE quilt DEALLOCATE( IData) ! The I/O server "root" handles the "set_time" request. - CASE ( int_set_time ) -!write(0,*)' int_set_time ' + CASE ( INT_SET_TIME ) +!write(0,*)' INT_SET_TIME ' CALL int_get_ti_header_char( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) SELECT CASE (use_package(io_form(DataHandle))) @@ -1147,7 +1147,7 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_dom_ti_char" request. - CASE ( int_dom_ti_char ) + CASE ( INT_DOM_TI_CHAR ) !write(0,*)' before int_get_ti_header_char ' CALL int_get_ti_header_char( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -1181,8 +1181,8 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_var_ti_char" request. - CASE ( int_var_ti_char ) -!write(0,*)' int_var_ti_char ' + CASE ( INT_VAR_TI_CHAR ) +!write(0,*)' INT_VAR_TI_CHAR ' CALL int_get_ti_header_char( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -1213,12 +1213,12 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize - CASE ( int_ioexit ) + CASE ( INT_IOEXIT ) ! ioexit is now handled by sending negative message length to server CALL wrf_error_fatal( & - "quilt: should have handled int_ioexit already") + "quilt: should have handled INT_IOEXIT already") ! The I/O server "root" handles the "ioclose" request. - CASE ( int_ioclose ) + CASE ( INT_IOCLOSE ) CALL int_get_handle_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -1281,17 +1281,17 @@ SUBROUTINE quilt ENDIF ! The I/O server "root" handles the "open_for_write_begin" request. - CASE ( int_open_for_write_begin ) + CASE ( INT_OPEN_FOR_WRITE_BEGIN ) CALL int_get_ofwb_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & FileName,SysDepInfo,io_form_arg,DataHandle ) -!write(0,*)' int_open_for_write_begin itypesize ',itypesize,' itypesize ',itypesize -!write(0,*)' int_open_for_write_begin icurs ', icurs, hdrbufsize -!JMDEBUGwrite(0,*)' int_open_for_write_begin FileName ',TRIM(FileName) , ' DataHandle ', DataHandle -!write(0,*)' int_open_for_write_begin SysDepInfo ',TRIM(SysDepInfo) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN itypesize ',itypesize,' itypesize ',itypesize +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN icurs ', icurs, hdrbufsize +!JMDEBUGwrite(0,*)' INT_OPEN_FOR_WRITE_BEGIN FileName ',TRIM(FileName) , ' DataHandle ', DataHandle +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN SysDepInfo ',TRIM(SysDepInfo) icurs = icurs + hdrbufsize -!write(0,*)' int_open_for_write_begin new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) io_form(DataHandle) = io_form_arg @@ -1327,14 +1327,14 @@ SUBROUTINE quilt ! In this case, the "okay_to_commit" is simply set to .true. so "write_field" ! requests will initiate writes to disk. Actual commit will be done after ! all requests in this batch have been handled. - CASE ( int_open_for_write_commit ) + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) CALL int_get_handle_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize okay_to_commit(DataHandle) = .true. -! The I/O server "root" handles the "write_field" (int_field) request. +! The I/O server "root" handles the "write_field" (INT_FIELD) request. ! If okay_to_write(DataHandle) is .true. then the patch in the ! header (bigbuf) is written to a globally-sized internal output buffer via ! the call to store_patch_in_outbuf(). Note that this is where the actual @@ -1342,9 +1342,9 @@ SUBROUTINE quilt ! okay_to_write(DataHandle) is .false. then external I/O package interfaces ! are called to write metadata for I/O formats that support native metadata. ! -! NOTE that the I/O server "root" will only see write_field (int_field) +! NOTE that the I/O server "root" will only see write_field (INT_FIELD) ! requests AFTER an "iosync" request. - CASE ( int_field ) + CASE ( INT_FIELD ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) CALL int_get_write_field_header ( bigbuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & @@ -1352,7 +1352,7 @@ SUBROUTINE quilt DomainStart , DomainEnd , & MemoryStart , MemoryEnd , & PatchStart , PatchEnd ) -!write(0,*)' int_field ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) +!write(0,*)' INT_FIELD ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) icurs = icurs + hdrbufsize IF ( okay_to_write(DataHandle) ) THEN @@ -1418,7 +1418,7 @@ SUBROUTINE quilt Status = 0 END SELECT ENDIF - CASE ( int_iosync ) + CASE ( INT_IOSYNC ) CALL int_get_handle_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -1436,7 +1436,7 @@ SUBROUTINE quilt ! (via a call to store_patch_in_outbuf()) then call write_outbuf() to write ! them to disk now. ! NOTE that the I/O server "root" will only have called -! store_patch_in_outbuf() when handling write_field (int_field) +! store_patch_in_outbuf() when handling write_field (INT_FIELD) ! commands which only arrive AFTER an "iosync" command. ! CALL start_timing CALL write_outbuf ( handle(DataHandle), use_package(io_form(DataHandle))) @@ -1745,7 +1745,7 @@ SUBROUTINE quilt_pnc ALLOCATE( obuf( 4096 ) ) ! DataHandle is provided as second element of reduced CALL int_gen_handle_header( obuf, obufsize, itypesize, & - reduced(2) , int_ioclose ) + reduced(2) , INT_IOCLOSE ) ENDIF !write(0,*)'calling init_store_piece_of_field' @@ -1772,7 +1772,7 @@ SUBROUTINE quilt_pnc DO WHILE ( icurs .lt. obufsize ) ! { hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -1803,7 +1803,7 @@ SUBROUTINE quilt_pnc call add_to_bufsize_for_field( VarName, chunksize ) icurs = icurs + chunksize ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call add_to_bufsize_for_field( 'COMMIT', hdrbufsize ) @@ -1841,13 +1841,13 @@ SUBROUTINE quilt_pnc ! 5. Logic below does not allow any noop records through since each IO ! server task now receives a valid record (from the 'compute-group master' ! when doing replicated output - IF (hdr_tag.NE.int_noop) THEN + IF (hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'X-2', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call add_to_bufsize_for_field( VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT @@ -1864,7 +1864,7 @@ SUBROUTINE quilt_pnc !write(0,*) 'A icurs ', icurs, ' obufsize ', obufsize hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -1892,7 +1892,7 @@ SUBROUTINE quilt_pnc icurs = icurs + chunksize !write(0,*) 'A-1a',TRIM(VarName),' icurs ',icurs,PatchStart(1:3),PatchEnd(1:3) ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call store_piece_of_field( obuf(icurs/itypesize), 'COMMIT', hdrbufsize ) @@ -1901,14 +1901,14 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize CASE DEFAULT hdrbufsize = obuf(icurs/itypesize) - IF (hdr_tag.NE.int_noop) THEN + IF (hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'A-2b', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call store_piece_of_field( obuf(icurs/itypesize), VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT ENDDO !} while(icurs < obufsize) @@ -1942,13 +1942,13 @@ SUBROUTINE quilt_pnc SELECT CASE ( get_hdr_tag( obuf(icurs/itypesize) ) ) ! The I/O server handles the "noop" (do nothing) request. This is ! actually quite easy. "Noop" requests exist to help avoid race conditions. - CASE ( int_noop ) + CASE ( INT_NOOP ) CALL int_get_noop_header( obuf(icurs/itypesize), & hdrbufsize, itypesize ) icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_dom_td_real" request. - CASE ( int_dom_td_real ) + CASE ( INT_DOM_TD_REAL ) CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_td_header( obuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1986,7 +1986,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( RData ) ! Every I/O server handles the "put_dom_ti_real" request. - CASE ( int_dom_ti_real ) + CASE ( INT_DOM_TI_REAL ) CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -2026,7 +2026,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( RData ) ! Every I/O server handles the "put_dom_td_integer" request. - CASE ( int_dom_td_integer ) + CASE ( INT_DOM_TD_INTEGER ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -2066,7 +2066,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( IData ) ! Every I/O server handles the "put_dom_ti_integer" request. - CASE ( int_dom_ti_integer ) + CASE ( INT_DOM_TI_INTEGER ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -2106,7 +2106,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( IData) ! Every I/O server handles the "set_time" request. - CASE ( int_set_time ) + CASE ( INT_SET_TIME ) CALL int_get_ti_header_char( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -2122,7 +2122,7 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize ! Every I/O server handles the "put_dom_ti_char" request. - CASE ( int_dom_ti_char ) + CASE ( INT_DOM_TI_CHAR ) CALL int_get_ti_header_char( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -2159,7 +2159,7 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize ! Every I/O server handles the "put_var_ti_char" request. - CASE ( int_var_ti_char ) + CASE ( INT_VAR_TI_CHAR ) CALL int_get_ti_header_char( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -2195,12 +2195,12 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize - CASE ( int_ioexit ) + CASE ( INT_IOEXIT ) ! ioexit is now handled by sending negative message length to server CALL wrf_error_fatal( & - "quilt: should have handled int_ioexit already") + "quilt: should have handled INT_IOEXIT already") ! Every I/O server handles the "ioclose" request. - CASE ( int_ioclose ) + CASE ( INT_IOCLOSE ) CALL int_get_handle_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -2256,17 +2256,17 @@ SUBROUTINE quilt_pnc ENDIF ! Every I/O server handles the "open_for_write_begin" request. - CASE ( int_open_for_write_begin ) + CASE ( INT_OPEN_FOR_WRITE_BEGIN ) CALL int_get_ofwb_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & FileName,SysDepInfo,io_form_arg,DataHandle ) -!write(0,*)' int_open_for_write_begin itypesize ',itypesize,' itypesize ',itypesize -!write(0,*)' int_open_for_write_begin icurs ', icurs, hdrbufsize -!JMDEBUGwrite(0,*)' int_open_for_write_begin FileName ',TRIM(FileName) , ' DataHandle ', DataHandle -!write(0,*)' int_open_for_write_begin SysDepInfo ',TRIM(SysDepInfo) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN itypesize ',itypesize,' itypesize ',itypesize +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN icurs ', icurs, hdrbufsize +!JMDEBUGwrite(0,*)' INT_OPEN_FOR_WRITE_BEGIN FileName ',TRIM(FileName) , ' DataHandle ', DataHandle +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN SysDepInfo ',TRIM(SysDepInfo) icurs = icurs + hdrbufsize -!write(0,*)' int_open_for_write_begin new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) io_form(DataHandle) = io_form_arg @@ -2304,25 +2304,25 @@ SUBROUTINE quilt_pnc ! Every I/O server handles the "open_for_write_commit" request. ! In this case, the "okay_to_commit" is simply set to .true. so "write_field" -! (int_field) requests will initiate writes to disk. Actual commit will be done after +! (INT_FIELD) requests will initiate writes to disk. Actual commit will be done after ! all requests in this batch have been handled. - CASE ( int_open_for_write_commit ) + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) CALL int_get_handle_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize okay_to_commit(DataHandle) = .true. -! Every I/O server handles the "write_field" (int_field) request. +! Every I/O server handles the "write_field" (INT_FIELD) request. ! If okay_to_write(DataHandle) is .true. then the patch in the ! header (bigbuf) is written to disk using pNetCDF. Note that this is where the actual ! "quilting" (reassembly of patches onto a full-size domain) is done. If ! okay_to_write(DataHandle) is .false. then external I/O package interfaces ! are called to write metadata for I/O formats that support native metadata. ! -! NOTE that the I/O servers will only see write_field (int_field) +! NOTE that the I/O servers will only see write_field (INT_FIELD) ! requests AFTER an "iosync" request. - CASE ( int_field ) + CASE ( INT_FIELD ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & @@ -2330,7 +2330,7 @@ SUBROUTINE quilt_pnc DomainStart , DomainEnd , & MemoryStart , MemoryEnd , & PatchStart , PatchEnd ) -!write(0,*)' int_field ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) +!write(0,*)' INT_FIELD ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) icurs = icurs + hdrbufsize IF ( okay_to_write(DataHandle) ) THEN @@ -2445,7 +2445,7 @@ SUBROUTINE quilt_pnc Status = 0 END SELECT ENDIF - CASE ( int_iosync ) + CASE ( INT_IOSYNC ) CALL int_get_handle_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -2465,7 +2465,7 @@ SUBROUTINE quilt_pnc ! (via a call to store_patch_in_outbuf_pnc()) then call write_outbuf_pnc() ! to write them to disk now. ! NOTE that the I/O server will only have called -! store_patch_in_outbuf() when handling write_field (int_field) +! store_patch_in_outbuf() when handling write_field (INT_FIELD) ! commands which only arrive AFTER an "iosync" command. ! CALL start_timing #ifdef PNETCDF_QUILT @@ -3088,7 +3088,7 @@ SUBROUTINE wrf_quilt_open_for_write_commit( DataHandle , Status ) !ARP parallel IO IF(compute_group_master(1)) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_open_for_write_commit ) + DataHandle, INT_OPEN_FOR_WRITE_COMMIT ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF @@ -3096,7 +3096,7 @@ SUBROUTINE wrf_quilt_open_for_write_commit( DataHandle , Status ) IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_open_for_write_commit ) + DataHandle, INT_OPEN_FOR_WRITE_COMMIT ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3336,14 +3336,14 @@ SUBROUTINE wrf_quilt_ioclose ( DataHandle, Status ) #ifdef PNETCDF_QUILT IF ( compute_group_master(1) )THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_ioclose ) + DataHandle, INT_IOCLOSE ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle , int_ioclose ) + DataHandle , INT_IOCLOSE ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3420,7 +3420,7 @@ SUBROUTINE wrf_quilt_ioexit( Status ) !ARP Send the ioexit message just once to each IOServer when using parallel IO IF( compute_group_master(1) ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_ioexit ) + DataHandle, INT_IOEXIT ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF @@ -3428,7 +3428,7 @@ SUBROUTINE wrf_quilt_ioexit( Status ) IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle , int_ioexit ) ! Handle is dummy + DataHandle , INT_IOEXIT ) ! Handle is dummy ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3532,14 +3532,14 @@ SUBROUTINE wrf_quilt_set_time ( DataHandle, Data, Status ) ! can't tell that's what they are on the IO servers themselves - therefore use ! the compute_group_master process. CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, "TIMESTAMP", "", Data, int_set_time ) + DataHandle, "TIMESTAMP", "", Data, INT_SET_TIME ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, "TIMESTAMP", "", Data, int_set_time ) + DataHandle, "TIMESTAMP", "", Data, INT_SET_TIME ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3648,14 +3648,14 @@ SUBROUTINE wrf_quilt_put_dom_ti_real ( DataHandle,Element, Data, Count, Statu #ifdef PNETCDF_QUILT IF ( compute_group_master(1) ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & - DataHandle, locElement, Data, Count, int_dom_ti_real ) + DataHandle, locElement, Data, Count, INT_DOM_TI_REAL ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & - DataHandle, locElement, Data, Count, int_dom_ti_real ) + DataHandle, locElement, Data, Count, INT_DOM_TI_REAL ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3806,7 +3806,7 @@ SUBROUTINE wrf_quilt_put_dom_ti_integer ( DataHandle,Element, Data, Count, St IF ( compute_group_master(1) )THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, locElement, Data, Count, & - int_dom_ti_integer ) + INT_DOM_TI_INTEGER ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3814,7 +3814,7 @@ SUBROUTINE wrf_quilt_put_dom_ti_integer ( DataHandle,Element, Data, Count, St IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, locElement, Data, Count, & - int_dom_ti_integer ) + INT_DOM_TI_INTEGER ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3966,14 +3966,14 @@ SUBROUTINE wrf_quilt_put_dom_ti_char ( DataHandle, Element, Data, Status ) IF(compute_group_master(1))THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, Element, "", Data, & - int_dom_ti_char ) + INT_DOM_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, Element, "", Data, int_dom_ti_char ) + DataHandle, Element, "", Data, INT_DOM_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -4510,7 +4510,7 @@ SUBROUTINE wrf_quilt_put_var_ti_char ( DataHandle,Element, Varname, Data, Stat IF ( compute_group_master(1) ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, TRIM(Element), & - TRIM(VarName), TRIM(Data), int_var_ti_char ) + TRIM(VarName), TRIM(Data), INT_VAR_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -4518,7 +4518,7 @@ SUBROUTINE wrf_quilt_put_var_ti_char ( DataHandle,Element, Varname, Data, Stat IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, TRIM(Element), & - TRIM(VarName), TRIM(Data), int_var_ti_char ) + TRIM(VarName), TRIM(Data), INT_VAR_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -4852,7 +4852,7 @@ SUBROUTINE wrf_quilt_write_field ( DataHandle , DateStr , VarName , Field , Fiel ! During a "real" write, this routine begins by allocating ! int_local_output_buffer if it has not already been allocated. Sizes ! accumulated during "training" are used to determine how big -! int_local_output_buffer must be. This routine then stores "int_field" +! int_local_output_buffer must be. This routine then stores "INT_FIELD" ! headers and associated field data in int_local_output_buffer. The contents ! of int_local_output_buffer are actually sent to the I/O quilt server in ! routine wrf_quilt_iosync(). This scheme allows output of multiple variables From 5a9d615e3ac57df4ee31db84212d02ad06600c71 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 17 May 2023 16:51:30 -0600 Subject: [PATCH 12/20] Removing redundant files --- external/io_grib1/wrf_status_codes.h | 133 -------------------- external/io_grib_share/wrf_io_flags.h | 16 --- external/io_grib_share/wrf_status_codes.h | 142 ---------------------- 3 files changed, 291 deletions(-) delete mode 100644 external/io_grib1/wrf_status_codes.h delete mode 100644 external/io_grib_share/wrf_io_flags.h delete mode 100644 external/io_grib_share/wrf_status_codes.h diff --git a/external/io_grib1/wrf_status_codes.h b/external/io_grib1/wrf_status_codes.h deleted file mode 100644 index 059d9ea719..0000000000 --- a/external/io_grib1/wrf_status_codes.h +++ /dev/null @@ -1,133 +0,0 @@ - -!WRF Error and Warning messages (1-999) -!All i/o package-specific status codes you may want to add must be handled by your package (see below) -! WRF handles these and netCDF messages only - integer, parameter :: WRF_NO_ERR = 0 !no error - integer, parameter :: WRF_WARN_FILE_NF = -1 !file not found, or incomplete - integer, parameter :: WRF_WARN_MD_NF = -2 !metadata not found - integer, parameter :: WRF_WARN_TIME_NF = -3 !timestamp not found - integer, parameter :: WRF_WARN_TIME_EOF = -4 !no more timestamps - integer, parameter :: WRF_WARN_VAR_NF = -5 !variable not found - integer, parameter :: WRF_WARN_VAR_EOF = -6 !no more variables for the current time - integer, parameter :: WRF_WARN_TOO_MANY_FILES = -7 !too many open files - integer, parameter :: WRF_WARN_TYPE_MISMATCH = -8 !data type mismatch - integer, parameter :: WRF_WARN_WRITE_RONLY_FILE = -9 !attempt to write readonly file - integer, parameter :: WRF_WARN_READ_WONLY_FILE = -10 !attempt to read writeonly file - integer, parameter :: WRF_WARN_FILE_NOT_OPENED = -11 !attempt to access unopened file - integer, parameter :: WRF_WARN_2DRYRUNS_1VARIABLE = -12 !attempt to do 2 trainings for 1 variable - integer, parameter :: WRF_WARN_READ_PAST_EOF = -13 !attempt to read past EOF - integer, parameter :: WRF_WARN_BAD_DATA_HANDLE = -14 !bad data handle - integer, parameter :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15 !write length not equal to training length - integer, parameter :: WRF_WARN_TOO_MANY_DIMS = -16 !more dimensions requested than training - integer, parameter :: WRF_WARN_COUNT_TOO_LONG = -17 !attempt to read more data than exists - integer, parameter :: WRF_WARN_DIMENSION_ERROR = -18 !input dimension inconsistent - integer, parameter :: WRF_WARN_BAD_MEMORYORDER = -19 !input MemoryOrder not recognized - integer, parameter :: WRF_WARN_DIMNAME_REDEFINED = -20 !a dimension name with 2 different lengths - integer, parameter :: WRF_WARN_CHARSTR_GT_LENDATA = -21 !string longer than provided storage - integer, parameter :: WRF_WARN_NOTSUPPORTED = -22 !function not supportable - integer, parameter :: WRF_WARN_NOOP = -23 !package implements this routine as NOOP - -!Fatal errors - integer, parameter :: WRF_ERR_FATAL_ALLOCATION_ERROR = -100 !allocation error - integer, parameter :: WRF_ERR_FATAL_DEALLOCATION_ERR = -101 !dealloc error - integer, parameter :: WRF_ERR_FATAL_BAD_FILE_STATUS = -102 !bad file status - - -!Package specific errors (1000+) -!Netcdf status codes -!WRF will accept status codes of 1000+, but it is up to the package to handle -! and return the status to the user. - - integer, parameter :: WRF_ERR_FATAL_BAD_VARIABLE_DIM = -1004 - integer, parameter :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D = -1005 - integer, parameter :: WRF_ERR_FATAL_TOO_MANY_TIMES = -1006 - integer, parameter :: WRF_WARN_BAD_DATA_TYPE = -1007 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_NOT_COMMITTED = -1008 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_OPEN_FOR_READ = -1009 - integer, parameter :: WRF_IO_NOT_INITIALIZED = -1010 - integer, parameter :: WRF_WARN_MD_AFTER_OPEN = -1011 - integer, parameter :: WRF_WARN_TOO_MANY_VARIABLES = -1012 - integer, parameter :: WRF_WARN_DRYRUN_CLOSE = -1013 - integer, parameter :: WRF_WARN_DATESTR_BAD_LENGTH = -1014 - integer, parameter :: WRF_WARN_ZERO_LENGTH_READ = -1015 - integer, parameter :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016 - integer, parameter :: WRF_WARN_DATESTR_ERROR = -1017 - integer, parameter :: WRF_WARN_DRYRUN_READ = -1018 - integer, parameter :: WRF_WARN_ZERO_LENGTH_GET = -1019 - integer, parameter :: WRF_WARN_ZERO_LENGTH_PUT = -1020 - integer, parameter :: WRF_WARN_NETCDF = -1021 - integer, parameter :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022 - integer, parameter :: WRF_WARN_MORE_DATA_IN_FILE = -1023 - integer, parameter :: WRF_WARN_DATE_LT_LAST_DATE = -1024 - -! For HDF5 only - integer, parameter :: WRF_HDF5_ERR_FILE = -200 - integer, parameter :: WRF_HDF5_ERR_MD = -201 - integer, parameter :: WRF_HDF5_ERR_TIME = -202 - integer, parameter :: WRF_HDF5_ERR_TIME_EOF = -203 - integer, parameter :: WRF_HDF5_ERR_MORE_DATA_IN_FILE = -204 - integer, parameter :: WRF_HDF5_ERR_DATE_LT_LAST_DATE = -205 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_FILES = -206 - integer, parameter :: WRF_HDF5_ERR_TYPE_MISMATCH = -207 - integer, parameter :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1 = -208 - integer, parameter :: WRF_HDF5_ERR_WRITE_RONLY_FILE = -209 - integer, parameter :: WRF_HDF5_ERR_READ_WONLY_FILE = -210 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_OPENED = -211 - integer, parameter :: WRF_HDF5_ERR_DATESTR_ERROR = -212 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_READ = -213 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_GET = -214 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_PUT = -215 - integer, parameter :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE = -216 - integer, parameter :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND = -217 - integer, parameter :: WRF_HDF5_ERR_READ_PAST_EOF = -218 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_HANDLE = -219 - integer, parameter :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN = -220 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_CLOSE = -221 - integer, parameter :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH = -222 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_READ = -223 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_DIMS = -224 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_VARIABLES = -225 - integer, parameter :: WRF_HDF5_ERR_COUNT_TOO_LONG = -226 - integer, parameter :: WRF_HDF5_ERR_DIMENSION_ERROR = -227 - integer, parameter :: WRF_HDF5_ERR_BAD_MEMORYORDER = -228 - integer, parameter :: WRF_HDF5_ERR_DIMNAME_REDEFINED = -229 - integer, parameter :: WRF_HDF5_ERR_MD_AFTER_OPEN = -230 - integer, parameter :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA = -231 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_TYPE = -232 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_COMMITTED = -233 - - integer, parameter :: WRF_HDF5_ERR_ALLOCATION = -2001 - integer, parameter :: WRF_HDF5_ERR_DEALLOCATION = -2002 - integer, parameter :: WRF_HDF5_ERR_BAD_FILE_STATUS = -2003 - integer, parameter :: WRF_HDF5_ERR_BAD_VARIABLE_DIM = -2004 - integer, parameter :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D = -2005 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_TIMES = -2006 - integer, parameter :: WRF_HDF5_ERR_DATA_ID_NOTFOUND = -2007 - - integer, parameter :: WRF_HDF5_ERR_DATASPACE = -300 - integer, parameter :: WRF_HDF5_ERR_DATATYPE = -301 - integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST = -302 - - integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE = -303 - integer, parameter :: WRF_HDF5_ERR_DATASET_READ = -304 - integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE = -305 - integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN = -306 - integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL = -307 - integer, parameter :: WRF_HDF5_ERR_GROUP = -308 - - integer, parameter :: WRF_HDF5_ERR_FILE_OPEN = -309 - integer, parameter :: WRF_HDF5_ERR_FILE_CREATE = -310 - integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE = -311 - integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE = -312 - integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL = -313 - - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE = -314 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ = -315 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE = -316 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN = -317 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL = -318 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE = -319 - - integer, parameter :: WRF_HDF5_ERR_OTHERS = -320 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321 - diff --git a/external/io_grib_share/wrf_io_flags.h b/external/io_grib_share/wrf_io_flags.h deleted file mode 100644 index 708939f914..0000000000 --- a/external/io_grib_share/wrf_io_flags.h +++ /dev/null @@ -1,16 +0,0 @@ - integer, parameter :: WRF_FILE_NOT_OPENED = 100 - integer, parameter :: WRF_FILE_OPENED_NOT_COMMITTED = 101 - integer, parameter :: WRF_FILE_OPENED_FOR_WRITE = 102 - integer, parameter :: WRF_FILE_OPENED_FOR_READ = 103 - integer, parameter :: WRF_REAL = 104 - integer, parameter :: WRF_DOUBLE = 105 -#ifdef PROMOTE_FLOAT - integer, parameter :: WRF_FLOAT=WRF_DOUBLE -#else - integer, parameter :: WRF_FLOAT=WRF_REAL -#endif - integer, parameter :: WRF_INTEGER = 106 - integer, parameter :: WRF_LOGICAL = 107 - integer, parameter :: WRF_COMPLEX = 108 - integer, parameter :: WRF_DOUBLE_COMPLEX = 109 - integer, parameter :: WRF_FILE_OPENED_FOR_UPDATE = 110 diff --git a/external/io_grib_share/wrf_status_codes.h b/external/io_grib_share/wrf_status_codes.h deleted file mode 100644 index 008ac5ce76..0000000000 --- a/external/io_grib_share/wrf_status_codes.h +++ /dev/null @@ -1,142 +0,0 @@ - -!WRF Error and Warning messages (1-999) -!All i/o package-specific status codes you may want to add must be handled by your package (see below) -! WRF handles these and netCDF messages only - integer, parameter :: WRF_NO_ERR = 0 !no error - integer, parameter :: WRF_WARN_FILE_NF = -1 !file not found, or incomplete - integer, parameter :: WRF_WARN_MD_NF = -2 !metadata not found - integer, parameter :: WRF_WARN_TIME_NF = -3 !timestamp not found - integer, parameter :: WRF_WARN_TIME_EOF = -4 !no more timestamps - integer, parameter :: WRF_WARN_VAR_NF = -5 !variable not found - integer, parameter :: WRF_WARN_VAR_EOF = -6 !no more variables for the current time - integer, parameter :: WRF_WARN_TOO_MANY_FILES = -7 !too many open files - integer, parameter :: WRF_WARN_TYPE_MISMATCH = -8 !data type mismatch - integer, parameter :: WRF_WARN_WRITE_RONLY_FILE = -9 !attempt to write readonly file - integer, parameter :: WRF_WARN_READ_WONLY_FILE = -10 !attempt to read writeonly file - integer, parameter :: WRF_WARN_FILE_NOT_OPENED = -11 !attempt to access unopened file - integer, parameter :: WRF_WARN_2DRYRUNS_1VARIABLE = -12 !attempt to do 2 trainings for 1 variable - integer, parameter :: WRF_WARN_READ_PAST_EOF = -13 !attempt to read past EOF - integer, parameter :: WRF_WARN_BAD_DATA_HANDLE = -14 !bad data handle - integer, parameter :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15 !write length not equal to training length - integer, parameter :: WRF_WARN_TOO_MANY_DIMS = -16 !more dimensions requested than training - integer, parameter :: WRF_WARN_COUNT_TOO_LONG = -17 !attempt to read more data than exists - integer, parameter :: WRF_WARN_DIMENSION_ERROR = -18 !input dimension inconsistent - integer, parameter :: WRF_WARN_BAD_MEMORYORDER = -19 !input MemoryOrder not recognized - integer, parameter :: WRF_WARN_DIMNAME_REDEFINED = -20 !a dimension name with 2 different lengths - integer, parameter :: WRF_WARN_CHARSTR_GT_LENDATA = -21 !string longer than provided storage - integer, parameter :: WRF_WARN_NOTSUPPORTED = -22 !function not supportable - integer, parameter :: WRF_WARN_NOOP = -23 !package implements this routine as NOOP - -!Fatal errors - integer, parameter :: WRF_ERR_FATAL_ALLOCATION_ERROR = -100 !allocation error - integer, parameter :: WRF_ERR_FATAL_DEALLOCATION_ERR = -101 !dealloc error - integer, parameter :: WRF_ERR_FATAL_BAD_FILE_STATUS = -102 !bad file status - - -!Package specific errors (1000+) -!Netcdf status codes -!WRF will accept status codes of 1000+, but it is up to the package to handle -! and return the status to the user. - - integer, parameter :: WRF_ERR_FATAL_BAD_VARIABLE_DIM = -1004 - integer, parameter :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D = -1005 - integer, parameter :: WRF_ERR_FATAL_TOO_MANY_TIMES = -1006 - integer, parameter :: WRF_WARN_BAD_DATA_TYPE = -1007 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_NOT_COMMITTED = -1008 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_OPEN_FOR_READ = -1009 - integer, parameter :: WRF_IO_NOT_INITIALIZED = -1010 - integer, parameter :: WRF_WARN_MD_AFTER_OPEN = -1011 - integer, parameter :: WRF_WARN_TOO_MANY_VARIABLES = -1012 - integer, parameter :: WRF_WARN_DRYRUN_CLOSE = -1013 - integer, parameter :: WRF_WARN_DATESTR_BAD_LENGTH = -1014 - integer, parameter :: WRF_WARN_ZERO_LENGTH_READ = -1015 - integer, parameter :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016 - integer, parameter :: WRF_WARN_DATESTR_ERROR = -1017 - integer, parameter :: WRF_WARN_DRYRUN_READ = -1018 - integer, parameter :: WRF_WARN_ZERO_LENGTH_GET = -1019 - integer, parameter :: WRF_WARN_ZERO_LENGTH_PUT = -1020 - integer, parameter :: WRF_WARN_NETCDF = -1021 - integer, parameter :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022 - integer, parameter :: WRF_WARN_MORE_DATA_IN_FILE = -1023 - integer, parameter :: WRF_WARN_DATE_LT_LAST_DATE = -1024 - -! For HDF5 only - integer, parameter :: WRF_HDF5_ERR_FILE = -200 - integer, parameter :: WRF_HDF5_ERR_MD = -201 - integer, parameter :: WRF_HDF5_ERR_TIME = -202 - integer, parameter :: WRF_HDF5_ERR_TIME_EOF = -203 - integer, parameter :: WRF_HDF5_ERR_MORE_DATA_IN_FILE = -204 - integer, parameter :: WRF_HDF5_ERR_DATE_LT_LAST_DATE = -205 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_FILES = -206 - integer, parameter :: WRF_HDF5_ERR_TYPE_MISMATCH = -207 - integer, parameter :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1 = -208 - integer, parameter :: WRF_HDF5_ERR_WRITE_RONLY_FILE = -209 - integer, parameter :: WRF_HDF5_ERR_READ_WONLY_FILE = -210 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_OPENED = -211 - integer, parameter :: WRF_HDF5_ERR_DATESTR_ERROR = -212 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_READ = -213 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_GET = -214 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_PUT = -215 - integer, parameter :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE = -216 - integer, parameter :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND = -217 - integer, parameter :: WRF_HDF5_ERR_READ_PAST_EOF = -218 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_HANDLE = -219 - integer, parameter :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN = -220 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_CLOSE = -221 - integer, parameter :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH = -222 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_READ = -223 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_DIMS = -224 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_VARIABLES = -225 - integer, parameter :: WRF_HDF5_ERR_COUNT_TOO_LONG = -226 - integer, parameter :: WRF_HDF5_ERR_DIMENSION_ERROR = -227 - integer, parameter :: WRF_HDF5_ERR_BAD_MEMORYORDER = -228 - integer, parameter :: WRF_HDF5_ERR_DIMNAME_REDEFINED = -229 - integer, parameter :: WRF_HDF5_ERR_MD_AFTER_OPEN = -230 - integer, parameter :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA = -231 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_TYPE = -232 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_COMMITTED = -233 - - integer, parameter :: WRF_HDF5_ERR_ALLOCATION = -2001 - integer, parameter :: WRF_HDF5_ERR_DEALLOCATION = -2002 - integer, parameter :: WRF_HDF5_ERR_BAD_FILE_STATUS = -2003 - integer, parameter :: WRF_HDF5_ERR_BAD_VARIABLE_DIM = -2004 - integer, parameter :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D = -2005 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_TIMES = -2006 - integer, parameter :: WRF_HDF5_ERR_DATA_ID_NOTFOUND = -2007 - - integer, parameter :: WRF_HDF5_ERR_DATASPACE = -300 - integer, parameter :: WRF_HDF5_ERR_DATATYPE = -301 - integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST = -302 - - integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE = -303 - integer, parameter :: WRF_HDF5_ERR_DATASET_READ = -304 - integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE = -305 - integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN = -306 - integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL = -307 - integer, parameter :: WRF_HDF5_ERR_GROUP = -308 - - integer, parameter :: WRF_HDF5_ERR_FILE_OPEN = -309 - integer, parameter :: WRF_HDF5_ERR_FILE_CREATE = -310 - integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE = -311 - integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE = -312 - integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL = -313 - - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE = -314 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ = -315 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE = -316 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN = -317 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL = -318 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE = -319 - - integer, parameter :: WRF_HDF5_ERR_OTHERS = -320 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321 - - integer, parameter :: WRF_GRIB2_ERR_GRIBCREATE = -401 - integer, parameter :: WRF_GRIB2_ERR_ADDLOCAL = -402 - integer, parameter :: WRF_GRIB2_ERR_ADDGRIB = -403 - integer, parameter :: WRF_GRIB2_ERR_ADDFIELD = -404 - integer, parameter :: WRF_GRIB2_ERR_GRIBEND = -405 - integer, parameter :: WRF_GRIB2_ERR_WRITE = -406 - integer, parameter :: WRF_GRIB2_ERR_GRIB2MAP = -407 - integer, parameter :: WRF_GRIB2_ERR_GETGB2 = -408 - integer, parameter :: WRF_GRIB2_ERR_READ = -409 From 051e2290dcd0a8a2872c0328b7e2a6006cb94c7d Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 17 May 2023 16:55:53 -0600 Subject: [PATCH 13/20] Reworking external/ build --- external/io_netcdf/wrf_io.F90 | 4 ++-- external/io_netcdfpar/wrf_io.F90 | 4 ++-- external/ioapi_share/wrf_status_codes.h | 9 +++++++++ 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/external/io_netcdf/wrf_io.F90 b/external/io_netcdf/wrf_io.F90 index ec2162d2d5..e29c8b4271 100644 --- a/external/io_netcdf/wrf_io.F90 +++ b/external/io_netcdf/wrf_io.F90 @@ -755,7 +755,7 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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(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') @@ -941,7 +941,7 @@ subroutine TransposeToR4(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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(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') diff --git a/external/io_netcdfpar/wrf_io.F90 b/external/io_netcdfpar/wrf_io.F90 index a76ec5d82d..60b6dff094 100644 --- a/external/io_netcdfpar/wrf_io.F90 +++ b/external/io_netcdfpar/wrf_io.F90 @@ -768,7 +768,7 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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(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') @@ -954,7 +954,7 @@ subroutine TransposeToR4a(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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(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') diff --git a/external/ioapi_share/wrf_status_codes.h b/external/ioapi_share/wrf_status_codes.h index 98484da413..8dfb44b53e 100644 --- a/external/ioapi_share/wrf_status_codes.h +++ b/external/ioapi_share/wrf_status_codes.h @@ -132,3 +132,12 @@ integer, parameter :: WRF_HDF5_ERR_OTHERS = -320 integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321 + integer, parameter :: WRF_GRIB2_ERR_GRIBCREATE = -401 + integer, parameter :: WRF_GRIB2_ERR_ADDLOCAL = -402 + integer, parameter :: WRF_GRIB2_ERR_ADDGRIB = -403 + integer, parameter :: WRF_GRIB2_ERR_ADDFIELD = -404 + integer, parameter :: WRF_GRIB2_ERR_GRIBEND = -405 + integer, parameter :: WRF_GRIB2_ERR_WRITE = -406 + integer, parameter :: WRF_GRIB2_ERR_GRIB2MAP = -407 + integer, parameter :: WRF_GRIB2_ERR_GETGB2 = -408 + integer, parameter :: WRF_GRIB2_ERR_READ = -409 From 96c9353c13615fda0c6db6d317ca2fe579e80dc3 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 23 May 2023 12:45:51 -0600 Subject: [PATCH 14/20] Adding runtime generated files to ignore list --- .gitignore | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index c47fe3e850..26a74951f6 100644 --- a/.gitignore +++ b/.gitignore @@ -17,4 +17,17 @@ configure.wrf* *.backup *.f90 -_build/ \ No newline at end of file +_build/ +# New (and old) things we should ignore +wrf_config.cmake +*.nc +rsl.out.* +rsl.error.* +ndown +real +tc +ideal +wrf +wrfbdy_d* +wrfinput_d* +wrfout_d* \ No newline at end of file From 553945592ec3197bfcd986556f815b77e14afa61 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 23 May 2023 12:51:25 -0600 Subject: [PATCH 15/20] Building pnetcdf io lib and re-enabling macro --- external/io_pnetcdf/wrf_io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/io_pnetcdf/wrf_io.F90 b/external/io_pnetcdf/wrf_io.F90 index 18f6ac078a..f6e382d93b 100644 --- a/external/io_pnetcdf/wrf_io.F90 +++ b/external/io_pnetcdf/wrf_io.F90 @@ -741,7 +741,7 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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(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') From 7ff2f7e4136fd159c7ee8d7f882f5a80b8f0ff01 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Fri, 23 Jun 2023 20:08:21 -0600 Subject: [PATCH 16/20] Reinstating old c preproc then m4 processing since gfortran is unable to --- external/io_adios2/wrf_io.F90 | 6 +++--- external/io_netcdf/wrf_io.F90 | 8 ++++---- external/io_netcdfpar/wrf_io.F90 | 8 ++++---- external/io_pnetcdf/wrf_io.F90 | 4 ++-- 4 files changed, 13 insertions(+), 13 deletions(-) diff --git a/external/io_adios2/wrf_io.F90 b/external/io_adios2/wrf_io.F90 index 99e9bfe2e0..b9bfe696d8 100644 --- a/external/io_adios2/wrf_io.F90 +++ b/external/io_adios2/wrf_io.F90 @@ -702,9 +702,9 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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)))) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#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)) diff --git a/external/io_netcdf/wrf_io.F90 b/external/io_netcdf/wrf_io.F90 index e29c8b4271..8863e4e29f 100644 --- a/external/io_netcdf/wrf_io.F90 +++ b/external/io_netcdf/wrf_io.F90 @@ -754,8 +754,8 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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)) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#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') @@ -940,8 +940,8 @@ subroutine TransposeToR4(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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)) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#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') diff --git a/external/io_netcdfpar/wrf_io.F90 b/external/io_netcdfpar/wrf_io.F90 index 60b6dff094..86e25dd2cb 100644 --- a/external/io_netcdfpar/wrf_io.F90 +++ b/external/io_netcdfpar/wrf_io.F90 @@ -767,8 +767,8 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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)) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#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') @@ -953,8 +953,8 @@ subroutine TransposeToR4a(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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)) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#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') diff --git a/external/io_pnetcdf/wrf_io.F90 b/external/io_pnetcdf/wrf_io.F90 index f6e382d93b..9d9c3733b4 100644 --- a/external/io_pnetcdf/wrf_io.F90 +++ b/external/io_pnetcdf/wrf_io.F90 @@ -740,8 +740,8 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & 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)) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#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') From 03966695b394c7858d205ed4c3bfa866464110d2 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 5 Jul 2023 18:24:30 -0600 Subject: [PATCH 17/20] Adjusting include paths for removal of redundant code --- external/io_grib1/Makefile | 2 +- external/io_grib_share/Makefile | 6 +++--- external/io_int/makefile | 5 +---- 3 files changed, 5 insertions(+), 8 deletions(-) diff --git a/external/io_grib1/Makefile b/external/io_grib1/Makefile index 6afcf4d760..a222b2dbfe 100644 --- a/external/io_grib1/Makefile +++ b/external/io_grib1/Makefile @@ -10,7 +10,7 @@ # # Specity location for Makefiles that are included. # -INCLUDEDIRS = -I. -I./MEL_grib1 -Igrib1_util -I../io_grib_share -I../ +INCLUDEDIRS = -I. -I./MEL_grib1 -Igrib1_util -I../io_grib_share -I../ -I../ioapi_share BUILD_DIR = $(IO_GRIB_SHARE_DIR)../io_grib_share/build # # Specify directory that output library is to be put in. diff --git a/external/io_grib_share/Makefile b/external/io_grib_share/Makefile index 41d3c96659..5e3a59db55 100644 --- a/external/io_grib_share/Makefile +++ b/external/io_grib_share/Makefile @@ -22,9 +22,9 @@ LIB_DEST = . # CXX_INCLUDES is for C++ files # C_INCLUDES is for C files # -C_INCLUDES = -I. -CXX_INCLUDES = -I. -F_INCLUDES = -I. +C_INCLUDES = -I. -I../ioapi_share +CXX_INCLUDES = -I. -I../ioapi_share +F_INCLUDES = -I. -I../ioapi_share AR = ar ARFLAGS = cruv diff --git a/external/io_int/makefile b/external/io_int/makefile index 3033670e32..7bc484968e 100644 --- a/external/io_int/makefile +++ b/external/io_int/makefile @@ -32,11 +32,8 @@ io_int.f: io_int.F90 module_internal_header_util.o io_int.o: io_int.f ../../inc/intio_tags.h $(FC) $(FCFLAGS) -I../../inc -I../ioapi_share -o $@ -c $*.f -io_int_idx_tags.h: ../../inc/intio_tags.h - awk '{print "#define", toupper($$4), $$6}' < ../../inc/intio_tags.h > $@ - io_int_idx.o: io_int_idx.c io_int_idx.h io_int_idx_tags.h - $(CC) -o $@ -c $(CFLAGS_LOCAL) $*.c + $(CC) -I../../inc -o $@ -c $(CFLAGS_LOCAL) $*.c module_io_int_idx.o: module_io_int_idx.f $(FC) $(FCFLAGS) -o $@ -c $*.f From 9a7618678e39896c22b7b3ea506cc69bd4646ba3 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 12 Jul 2023 16:06:53 -0600 Subject: [PATCH 18/20] Logic and fixes to allow for double precision compilation --- phys/module_mp_SBM_polar_radar.F | 5 +++++ phys/module_mp_fast_sbm.F | 14 ++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/phys/module_mp_SBM_polar_radar.F b/phys/module_mp_SBM_polar_radar.F index 4f94129271..a6ba4e4cc1 100644 --- a/phys/module_mp_SBM_polar_radar.F +++ b/phys/module_mp_SBM_polar_radar.F @@ -6,6 +6,11 @@ SUBROUTINE SBM_polar_radar dummy = 1 END SUBROUTINE SBM_polar_radar END MODULE module_mp_SBM_polar_radar + +! Stub module +module scatt_tables +end module scatt_tables + #else !****************** module scatt_tables diff --git a/phys/module_mp_fast_sbm.F b/phys/module_mp_fast_sbm.F index 184a9220ea..757f05db8c 100644 --- a/phys/module_mp_fast_sbm.F +++ b/phys/module_mp_fast_sbm.F @@ -6,6 +6,20 @@ SUBROUTINE SBM_fast dummy = 1 END SUBROUTINE SBM_fast END MODULE module_mp_fast_sbm + +! Stub modules +module module_mp_SBM_BreakUp +end module module_mp_SBM_BreakUp + +module module_mp_SBM_Collision +end module module_mp_SBM_Collision + +module module_mp_SBM_Auxiliary +end module module_mp_SBM_Auxiliary + +module module_mp_SBM_Nucleation +end module module_mp_SBM_Nucleation + #else ! +-----------------------------------------------------------------------------+ ! +-----------------------------------------------------------------------------+ From 5eaa938f5155feb2e2c55e5f4834370441053746 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Mon, 17 Jul 2023 15:44:09 -0600 Subject: [PATCH 19/20] Remove all references to idx tags autogen file --- external/io_int/makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/external/io_int/makefile b/external/io_int/makefile index 7bc484968e..e52b7c7bef 100644 --- a/external/io_int/makefile +++ b/external/io_int/makefile @@ -32,7 +32,7 @@ io_int.f: io_int.F90 module_internal_header_util.o io_int.o: io_int.f ../../inc/intio_tags.h $(FC) $(FCFLAGS) -I../../inc -I../ioapi_share -o $@ -c $*.f -io_int_idx.o: io_int_idx.c io_int_idx.h io_int_idx_tags.h +io_int_idx.o: io_int_idx.c io_int_idx.h $(CC) -I../../inc -o $@ -c $(CFLAGS_LOCAL) $*.c module_io_int_idx.o: module_io_int_idx.f @@ -88,5 +88,5 @@ test_io_mpi: test_io_mpi.f90 $(LIB) $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $@.f90 -L. -lwrfio_int superclean: - @$(RM) *.f *.o *.obj *.i *.mod $(LIB) diffwrf io_int_idx_tags.h \ - test_io_idx test_io_mpi io_int_idx_tags.h + @$(RM) *.f *.o *.obj *.i *.mod $(LIB) diffwrf \ + test_io_idx test_io_mpi From d102f6de85f98c045da0492b5ad92b40e20e4dcd Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 19 Jul 2023 13:37:29 -0600 Subject: [PATCH 20/20] Removing dimspec check since some configurations fail silently --- tools/registry.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/registry.c b/tools/registry.c index 937cef5a18..97759b0942 100644 --- a/tools/registry.c +++ b/tools/registry.c @@ -237,7 +237,7 @@ main( int argc, char *argv[], char *env[] ) fclose(fp_tmp) ; - NON_ZERO_RETURN( check_dimspecs() ); + check_dimspecs(); NON_ZERO_RETURN( gen_state_struct( "inc" ) ); NON_ZERO_RETURN( gen_state_subtypes( "inc" ) );