diff --git a/definitions/Makefile.am b/definitions/Makefile.am index 8fc0853bd..c4c45c54b 100644 --- a/definitions/Makefile.am +++ b/definitions/Makefile.am @@ -14041,7 +14041,6 @@ dist_definitionsgrib2_DATA = \ grib2/template.7.6.def\ grib2/template.7.61.def\ grib2/template.7.second_order.def\ - grib2/template.second_order.def\ grib2/tiggeLocalVersion.table\ grib2/tigge_name.def\ grib2/tigge_parameter.def\ diff --git a/definitions/add_params_from_tsv.pl b/definitions/add_params_from_tsv.pl index 90302d85f..ba40c3661 100755 --- a/definitions/add_params_from_tsv.pl +++ b/definitions/add_params_from_tsv.pl @@ -22,11 +22,11 @@ # parameterNumber # # The following are optional keys # typeOfFirstFixedSurface -# typeOfSecondFixedSurface -# scaledValueOfFirstFixedSurface # scaleFactorOfFirstFixedSurface -# scaledValueOfSecondFixedSurface +# scaledValueOfFirstFixedSurface +# typeOfSecondFixedSurface # scaleFactorOfSecondFixedSurface +# scaledValueOfSecondFixedSurface # typeOfStatisticalProcessing # # It outputs the def files: @@ -57,6 +57,7 @@ write_or_append(\*OUT_CFVARNAME, "$CFVARNAME_FILENAME"); my $first = 1; while (<>) { chomp; + s/\r//g; # Remove DOS carriage returns if ($first == 1) { check_first_row_column_names($_); $first = 0; @@ -124,13 +125,12 @@ sub check_first_row_column_names { die "Error: 1st row column titles wrong: Column 7 should be 'parameterNumber'\n" if ($keys[6] ne "parameterNumber"); die "Error: 1st row column titles wrong: Column 8 should be 'typeOfFirstFixedSurface'\n" if ($keys[7] ne "typeOfFirstFixedSurface"); - die "Error: 1st row column titles wrong: Column 9 should be 'typeOfSecondFixedSurface'\n" if ($keys[8] ne "typeOfSecondFixedSurface"); - + die "Error: 1st row column titles wrong: Column 9 should be 'scaleFactorOfFirstFixedSurface'\n" if ($keys[8] ne "scaleFactorOfFirstFixedSurface"); die "Error: 1st row column titles wrong: Column 10 should be 'scaledValueOfFirstFixedSurface'\n" if ($keys[9] ne "scaledValueOfFirstFixedSurface"); - die "Error: 1st row column titles wrong: Column 11 should be 'scaleFactorOfFirstFixedSurface'\n" if ($keys[10] ne "scaleFactorOfFirstFixedSurface"); - - die "Error: 1st row column titles wrong: Column 12 should be 'scaledValueOfSecondFixedSurface'\n" if ($keys[11] ne "scaledValueOfSecondFixedSurface"); - die "Error: 1st row column titles wrong: Column 13 should be 'scaleFactorOfSecondFixedSurface'\n" if ($keys[12] ne "scaleFactorOfSecondFixedSurface"); + + die "Error: 1st row column titles wrong: Column 11 should be 'typeOfSecondFixedSurface'\n" if ($keys[10] ne "typeOfSecondFixedSurface"); + die "Error: 1st row column titles wrong: Column 12 should be 'scaleFactorOfSecondFixedSurface'\n" if ($keys[11] ne "scaleFactorOfSecondFixedSurface"); + die "Error: 1st row column titles wrong: Column 13 should be 'scaledValueOfSecondFixedSurface'\n" if ($keys[12] ne "scaledValueOfSecondFixedSurface"); die "Error: 1st row column titles wrong: Column 14 should be 'typeOfStatisticalProcessing'\n" if ($keys[13] ne "typeOfStatisticalProcessing"); } diff --git a/definitions/grib1/localConcepts/ecmf/typeOfLevel.def b/definitions/grib1/localConcepts/ecmf/typeOfLevel.def index c43d20a7f..70a13942c 100644 --- a/definitions/grib1/localConcepts/ecmf/typeOfLevel.def +++ b/definitions/grib1/localConcepts/ecmf/typeOfLevel.def @@ -1,37 +1,4 @@ # ECMWF concept type of level -'surface' = {indicatorOfTypeOfLevel=1;} -'cloudBase' = {indicatorOfTypeOfLevel=2;} -'cloudTop' = {indicatorOfTypeOfLevel=3;} -'isothermZero' = {indicatorOfTypeOfLevel=4;} -'adiabaticCondensation' = {indicatorOfTypeOfLevel=5;} -'maxWind' = {indicatorOfTypeOfLevel=6;} -'tropopause' = {indicatorOfTypeOfLevel=7;} -'nominalTop' = {indicatorOfTypeOfLevel=8;} -'seaBottom' = {indicatorOfTypeOfLevel=9;} -'isobaricInhPa' = {indicatorOfTypeOfLevel=100;} -'isobaricInPa' = {indicatorOfTypeOfLevel=210;} -'isobaricLayer' = {indicatorOfTypeOfLevel=101;} -'meanSea' = {indicatorOfTypeOfLevel=102;} -'isobaricLayerHighPrecision' = {indicatorOfTypeOfLevel=121;} -'isobaricLayerMixedPrecision' = {indicatorOfTypeOfLevel=141;} -'heightAboveSea' = {indicatorOfTypeOfLevel=103;} -'heightAboveSeaLayer' = {indicatorOfTypeOfLevel=104;} -'heightAboveGroundHighPrecision' = {indicatorOfTypeOfLevel=125;} -'heightAboveGround' = {indicatorOfTypeOfLevel=105;} -'heightAboveGroundLayer' = {indicatorOfTypeOfLevel=106;} -'sigma' = {indicatorOfTypeOfLevel=107;} -'sigmaLayer' = {indicatorOfTypeOfLevel=108;} -'sigmaLayerHighPrecision' = {indicatorOfTypeOfLevel=128;} -'hybrid' = {indicatorOfTypeOfLevel=109;} -'hybridLayer' = {indicatorOfTypeOfLevel=110;} -'depthBelowLand' = {indicatorOfTypeOfLevel=111;} -'depthBelowLandLayer' = {indicatorOfTypeOfLevel=112;} -'theta' = {indicatorOfTypeOfLevel=113;} -'thetaLayer' = {indicatorOfTypeOfLevel=114;} -'pressureFromGround' = {indicatorOfTypeOfLevel=115;} -'pressureFromGroundLayer' = {indicatorOfTypeOfLevel=116;} -'potentialVorticity' = {indicatorOfTypeOfLevel=117;} -'depthBelowSea' = {indicatorOfTypeOfLevel=160;} 'entireAtmosphere' = {indicatorOfTypeOfLevel=200;level=0;} 'entireOcean' = {indicatorOfTypeOfLevel=201;level=0;} 'oceanWave' = {indicatorOfTypeOfLevel=211;} diff --git a/definitions/grib2/localConcepts/kwbc/typeOfLevelConcept.def b/definitions/grib2/localConcepts/kwbc/typeOfLevelConcept.def new file mode 100644 index 000000000..7df005d2e --- /dev/null +++ b/definitions/grib2/localConcepts/kwbc/typeOfLevelConcept.def @@ -0,0 +1,33 @@ +# Concept typeOfLevel for kwbc +'atmosphereSingleLayer' = {typeOfFirstFixedSurface=200;} +'oceanSingleLayer' = {typeOfFirstFixedSurface=201;} +'highestTroposphericFreezing' = {typeOfFirstFixedSurface=204;} +'gridScaleCloudBottom' = {typeOfFirstFixedSurface=206;} +'gridScaleCloudTop' = {typeOfFirstFixedSurface=207;} +'boundaryLayerCloudBottom' = {typeOfFirstFixedSurface=209;} +'boundaryLayerCloudTop' = {typeOfFirstFixedSurface=210;} +'boundaryLayerCloudLayer' = {typeOfFirstFixedSurface=211;} +'lowCloudBottom' = {typeOfFirstFixedSurface=212;} +'lowCloudTop' = {typeOfFirstFixedSurface=213;} +'lowCloudLayer' = {typeOfFirstFixedSurface=214;} +'cloudCeiling' = {typeOfFirstFixedSurface=215;} +'planetaryBoundaryLayer' = {typeOfFirstFixedSurface=220;} +'layerBetween2Hybrids' = {typeOfFirstFixedSurface=221;} +'middleCloudBottom' = {typeOfFirstFixedSurface=222;} +'middleCloudTop' = {typeOfFirstFixedSurface=223;} +'middleCloudLayer' = {typeOfFirstFixedSurface=224;} +'highCloudBottom' = {typeOfFirstFixedSurface=232;} +'highCloudTop' = {typeOfFirstFixedSurface=233;} +'highCloudLayer' = {typeOfFirstFixedSurface=234;} +'oceanIsotherm' = {typeOfFirstFixedSurface=235;} +'oceanMixedLayer' = {typeOfFirstFixedSurface=240;} +'orderedSequenceData' = {typeOfFirstFixedSurface=241;} +'convectiveCloudBottom' = {typeOfFirstFixedSurface=242;} +'convectiveCloudTop' = {typeOfFirstFixedSurface=243;} +'convectiveCloudLayer' = {typeOfFirstFixedSurface=244;} +'lowestLevelWetBulb0' = {typeOfFirstFixedSurface=245;} +'equilibrium' = {typeOfFirstFixedSurface=247;} +'shallowConvectiveCloudBottom' = {typeOfFirstFixedSurface=248;} +'shallowConvectiveCloudTop' = {typeOfFirstFixedSurface=249;} +'deepConvectiveCloudBottom' = {typeOfFirstFixedSurface=251;} +'deepConvectiveCloudTop' = {typeOfFirstFixedSurface=252;} diff --git a/definitions/grib2/tables/local/kwbc/1/4.5.table b/definitions/grib2/tables/local/kwbc/1/4.5.table index 3a7c14355..f1cfbfbe6 100644 --- a/definitions/grib2/tables/local/kwbc/1/4.5.table +++ b/definitions/grib2/tables/local/kwbc/1/4.5.table @@ -71,19 +71,42 @@ # 192-254 Reserved for local use # See ECC-469 200 200 Entire atmosphere (considered as a single layer) +201 201 Entire ocean (considered as a single layer) 204 204 Highest tropospheric freezing level +206 206 Grid scale cloud bottom level +207 207 Grid scale cloud top level +209 209 Boundary layer cloud bottom level +210 210 Boundary layer cloud top level 211 211 Boundary layer cloud layer 212 212 Low cloud bottom level 213 213 Low cloud top level 214 214 Low cloud layer +215 215 Cloud ceiling 220 220 Planetary boundary layer +221 221 Layer between two hybrid levels 222 222 Middle cloud bottom level 223 223 Middle cloud top level 224 224 Middle cloud layer 232 232 High cloud bottom level 233 233 High cloud top level 234 234 High cloud layer +235 235 Ocean isotherm level (1/10 deg C) +236 236 Layer between two depths below ocean surface +237 237 Bottom of ocean mixed layer +238 238 Bottom of ocean isothermal layer +239 239 Layer ocean surface and 26C ocean isothermal level +240 240 Ocean mixed layer +241 241 Ordered sequence of data 242 242 Convective cloud bottom level 243 243 Convective cloud top level 244 244 Convective cloud layer -255 255 Missing +245 245 Lowest level of the wet bulb zero +246 246 Maximum equivalent potential temperature level +247 247 Equilibrium level +248 248 Shallow convective cloud bottom level +249 249 Shallow convective cloud top level +251 251 Deep convective cloud bottom level +252 252 Deep convective cloud top level +253 253 Lowest bottom level of supercooled liquid water layer +254 254 Highest top level of supercooled liquid water layer +255 255 Missing diff --git a/definitions/grib2/template.5.4.def b/definitions/grib2/template.5.4.def index 1413d60e6..a7dba6b2a 100644 --- a/definitions/grib2/template.5.4.def +++ b/definitions/grib2/template.5.4.def @@ -3,7 +3,7 @@ # TEMPLATE 5.4, Grid point data - IEEE packing # added for conversion from other packing transient bitsPerValue=0 : hidden; -transient referenceValue=0 : hidden; +transient referenceValue=0 : hidden; transient binaryScaleFactor=0 : hidden; transient decimalScaleFactor=0 : hidden; alias numberOfBits = bitsPerValue; diff --git a/definitions/grib2/template.7.4.def b/definitions/grib2/template.7.4.def index fda92a0c2..2ef305f6b 100644 --- a/definitions/grib2/template.7.4.def +++ b/definitions/grib2/template.7.4.def @@ -1,25 +1,22 @@ # (C) Copyright 2005- ECMWF. -# TEMPLATE 7.4, Grid point data - simple packing -# Octets 6-nn : Binary data values - binary string, with each -# (scaled) -# ???? data_values__binary_string_with_each +# TEMPLATE 7.4, Grid point data - IEEE floating point data -meta codedValues data_raw_packing( +meta codedValues data_raw_packing( section7Length, offsetBeforeData, offsetSection7, numberOfValues, precision - ): read_only; - -meta values data_apply_bitmap(codedValues, - bitmap, - missingValue, - binaryScaleFactor, - numberOfDataPoints, - numberOfValues) : dump; + ): read_only; + +meta values data_apply_bitmap(codedValues, + bitmap, + missingValue, + binaryScaleFactor, + numberOfDataPoints, + numberOfValues) : dump; + +alias data.packedValues = codedValues; -alias data.packedValues = codedValues; - template statistics "common/statistics_grid.def"; diff --git a/definitions/grib2/template.second_order.def b/definitions/grib2/template.second_order.def deleted file mode 100644 index f9bf1abc1..000000000 --- a/definitions/grib2/template.second_order.def +++ /dev/null @@ -1 +0,0 @@ -#TODO diff --git a/examples/C/grib_iterator.c b/examples/C/grib_iterator.c index 92d8650f6..2a8b274a2 100644 --- a/examples/C/grib_iterator.c +++ b/examples/C/grib_iterator.c @@ -12,7 +12,6 @@ * C Implementation: grib_iterator * * Description: how to use an iterator on lat/lon/values for GRIB messages - * */ #include @@ -33,6 +32,7 @@ int main(int argc, char** argv) double lat, lon, value; double missingValue = 1e+20; /* A value out of range */ int n = 0; + long bitmapPresent = 0; char* filename = NULL; /* Message handle. Required in all the ecCodes calls acting on a message.*/ @@ -55,9 +55,14 @@ int main(int argc, char** argv) /* Check of errors after reading a message. */ if (err != CODES_SUCCESS) CODES_CHECK(err, 0); - /* Set the double representing the missing value in the field. */ - /* Choose a missingValue that does not correspond to any real value in the data array */ - CODES_CHECK(codes_set_double(h, "missingValue", missingValue), 0); + /* Check if a bitmap applies */ + CODES_CHECK(codes_get_long(h, "bitmapPresent", &bitmapPresent), 0); + + if (bitmapPresent) { + /* Set the double representing the missing value in the field. */ + /* Choose a missingValue that does not correspond to any real value in the data array */ + CODES_CHECK(codes_set_double(h, "missingValue", missingValue), 0); + } /* A new iterator on lat/lon/values is created from the message handle h. */ iter = codes_grib_iterator_new(h, 0, &err); @@ -69,7 +74,7 @@ int main(int argc, char** argv) /* You can now print lat and lon, */ printf("- %d - lat=%f lon=%f value=", n, lat, lon); /* decide what to print if a missing value is found. */ - if (value == missingValue) printf("missing\n"); + if (bitmapPresent && value == missingValue) printf("missing\n"); /* and print the value if is not missing. */ else printf("%f\n", value); diff --git a/examples/C/grib_iterator.sh b/examples/C/grib_iterator.sh index 29c4cd042..76bce1e1a 100755 --- a/examples/C/grib_iterator.sh +++ b/examples/C/grib_iterator.sh @@ -8,8 +8,15 @@ # virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. . ./include.sh +temp=temp.c_grib_iterator.txt +# These two do not have any missing data ${examples_dir}/c_grib_iterator ${data_dir}/reduced_gaussian_model_level.grib1 > /dev/null - ${examples_dir}/c_grib_iterator ${data_dir}/regular_gaussian_model_level.grib1 > /dev/null +# Has missing data +${examples_dir}/c_grib_iterator ${data_dir}/reduced_latlon_surface.grib2 > $temp +count_miss=`grep -c missing $temp` +[ $count_miss = 98701 ] + +rm -f $temp diff --git a/examples/F90/bufr_attributes.f90 b/examples/F90/bufr_attributes.f90 index f1c3144dc..eb5a330ae 100644 --- a/examples/F90/bufr_attributes.f90 +++ b/examples/F90/bufr_attributes.f90 @@ -13,101 +13,100 @@ ! ! program bufr_attributes -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -integer(kind=4) :: iVal,conf -real(kind=8) :: t2m -character(len=32) :: units, confUnits + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: iVal, conf + real(kind=8) :: t2m + character(len=32) :: units, confUnits - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') ! the first bufr message is loaded from file ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! ---------------------------------------------------------------- + ! We will read the value and all the attributes available for + ! the 2m temperature. + ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! We will read the value and all the attributes available for - ! the 2m temperature. - ! ---------------------------------------------------------------- + ! Get the element's value as as real + call codes_get(ibufr, 'airTemperatureAt2M', t2m); + write (*, *) ' airTemperatureAt2M:', t2m - ! Get the element's value as as real - call codes_get(ibufr,'airTemperatureAt2M',t2m); - write(*,*) ' airTemperatureAt2M:',t2m + ! Get the element's code (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->code', iVal); + write (*, *) ' airTemperatureAt2M->code:', iVal - ! Get the element's code (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->code',iVal); - write(*,*) ' airTemperatureAt2M->code:',iVal + ! Get the element's units (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->units', units) + write (*, *) ' airTemperatureAt2M->units:', units - ! Get the element's units (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->units',units) - write(*,*) ' airTemperatureAt2M->units:',units + ! Get the element's scale (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->scale', iVal); + write (*, *) ' airTemperatureAt2M->code:', iVal - ! Get the element's scale (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->scale',iVal); - write(*,*) ' airTemperatureAt2M->code:',iVal + ! Get the element's reference (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->reference', iVal); + write (*, *) ' airTemperatureAt2M->reference:', iVal - ! Get the element's reference (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->reference',iVal); - write(*,*) ' airTemperatureAt2M->reference:',iVal + ! Get the element's width (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->width', iVal); + write (*, *) ' airTemperatureAt2M->width:', iVal - ! Get the element's width (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->width',iVal); - write(*,*) ' airTemperatureAt2M->width:',iVal + ! ------------------------------------------------------------------- + ! The 2m temperature data element in this message has an associated + ! field: percentConfidence. Its value and attributes can be accessed + ! in a similar manner as was shown above for 2m temperature. + ! ------------------------------------------------------------------- - ! ------------------------------------------------------------------- - ! The 2m temperature data element in this message has an associated - ! field: percentConfidence. Its value and attributes can be accessed - ! in a similar manner as was shown above for 2m temperature. - ! ------------------------------------------------------------------- + ! Get the element's value as as real + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence', conf); + write (*, *) ' airTemperatureAt2M->percentConfidence:', conf - ! Get the element's value as as real - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence',conf); - write(*,*) ' airTemperatureAt2M->percentConfidence:', conf + ! Get the element's code (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->code', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->code:', iVal - ! Get the element's code (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->code',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->code:',iVal + ! Get the element's units (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->units', confUnits) + write (*, *) ' airTemperatureAt2M->percentConfidence->units:', confUnits - ! Get the element's units (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->units',confUnits) - write(*,*) ' airTemperatureAt2M->percentConfidence->units:',confUnits + ! Get the element's scale (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->scale', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->code:', iVal - ! Get the element's scale (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->scale',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->code:',iVal + ! Get the element's reference (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->reference', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->reference:', iVal - ! Get the element's reference (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->reference',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->reference:',iVal + ! Get the element's width (see BUFR code table B) + call codes_get(ibufr, 'airTemperatureAt2M->percentConfidence->width', iVal); + write (*, *) ' airTemperatureAt2M->percentConfidence->width:', iVal - ! Get the element's width (see BUFR code table B) - call codes_get(ibufr,'airTemperatureAt2M->percentConfidence->width',iVal); - write(*,*) ' airTemperatureAt2M->percentConfidence->width:',iVal + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_attributes diff --git a/examples/F90/bufr_clone.f90 b/examples/F90/bufr_clone.f90 index a8567453d..1dc231d7b 100644 --- a/examples/F90/bufr_clone.f90 +++ b/examples/F90/bufr_clone.f90 @@ -13,45 +13,45 @@ ! ! program bufr_clone - use eccodes - implicit none - integer :: i,iret - integer :: infile,outfile - integer :: ibufr_in - integer :: ibufr_out + use eccodes + implicit none + integer :: i, iret + integer :: infile, outfile + integer :: ibufr_in + integer :: ibufr_out - ! Open source file - call codes_open_file(infile,'../../data/bufr/syno_multi.bufr','r') + ! Open source file + call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r') - ! Open target file - call codes_open_file(outfile,'bufr_clone_test_f.clone.bufr','w') + ! Open target file + call codes_open_file(outfile, 'bufr_clone_test_f.clone.bufr', 'w') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(infile,ibufr_in,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(infile, ibufr_in, iret) - ! Create several clones of this message and alter them - ! in different ways - do i=1,3 + ! Create several clones of this message and alter them + ! in different ways + do i = 1, 3 - ! Clone the current handle - call codes_clone(ibufr_in, ibufr_out) + ! Clone the current handle + call codes_clone(ibufr_in, ibufr_out) - ! This is the place where you may wish to modify the clone - ! E.g. we change the bufrHeaderCentre - call codes_set(ibufr_out,'bufrHeaderCentre',222) + ! This is the place where you may wish to modify the clone + ! E.g. we change the bufrHeaderCentre + call codes_set(ibufr_out, 'bufrHeaderCentre', 222) - ! Write cloned messages to a file - call codes_write(ibufr_out,outfile) + ! Write cloned messages to a file + call codes_write(ibufr_out, outfile) - ! Release the clone's handle - call codes_release(ibufr_out) - end do + ! Release the clone's handle + call codes_release(ibufr_out) + end do - ! Release the original handle - call codes_release(ibufr_in) + ! Release the original handle + call codes_release(ibufr_in) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) end program bufr_clone diff --git a/examples/F90/bufr_copy_data.f90 b/examples/F90/bufr_copy_data.f90 index e45e8fae8..66565fed4 100644 --- a/examples/F90/bufr_copy_data.f90 +++ b/examples/F90/bufr_copy_data.f90 @@ -15,72 +15,72 @@ ! program bufr_encode - use eccodes - implicit none - integer :: iret - integer :: outfile - integer :: ifile - integer :: ibufr - integer :: ibufrin - integer(kind=4), dimension(:), allocatable :: ivalues - integer, parameter :: max_strsize = 200 - character(len=max_strsize) :: infile_name - character(len=max_strsize) :: outfile_name + use eccodes + implicit none + integer :: iret + integer :: outfile + integer :: ifile + integer :: ibufr + integer :: ibufrin + integer(kind=4), dimension(:), allocatable :: ivalues + integer, parameter :: max_strsize = 200 + character(len=max_strsize) :: infile_name + character(len=max_strsize) :: outfile_name - call codes_bufr_new_from_samples(ibufr,'BUFR3',iret) - call getarg(1, infile_name) - call getarg(2, outfile_name) - call codes_open_file(ifile, infile_name, 'r') - call codes_bufr_new_from_file(ifile, ibufrin) + call codes_bufr_new_from_samples(ibufr, 'BUFR3', iret) + call getarg(1, infile_name) + call getarg(2, outfile_name) + call codes_open_file(ifile, infile_name, 'r') + call codes_bufr_new_from_file(ifile, ibufrin) - if (iret/=CODES_SUCCESS) then - print *,'ERROR creating BUFR from BUFR3' - stop 1 - endif - if(allocated(ivalues)) deallocate(ivalues) - allocate(ivalues(69)) - ivalues=(/ & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 0 /) - call codes_set(ibufr,'inputDataPresentIndicator',ivalues) - call codes_set(ibufr,'edition',3) - call codes_set(ibufr,'masterTableNumber',0) - call codes_set(ibufr,'bufrHeaderSubCentre',0) - call codes_set(ibufr,'bufrHeaderCentre',98) - call codes_set(ibufr,'updateSequenceNumber',1) - call codes_set(ibufr,'dataCategory',0) - call codes_set(ibufr,'dataSubCategory',140) - call codes_set(ibufr,'masterTablesVersionNumber',13) - call codes_set(ibufr,'localTablesVersionNumber',1) - call codes_set(ibufr,'typicalYearOfCentury',15) - call codes_set(ibufr,'typicalMonth',5) - call codes_set(ibufr,'typicalDay',4) - call codes_set(ibufr,'typicalHour',9) - call codes_set(ibufr,'typicalMinute',30) - call codes_set(ibufr,'numberOfSubsets',1) - call codes_set(ibufr,'observedData',1) - call codes_set(ibufr,'compressedData',0) - if(allocated(ivalues)) deallocate(ivalues) - allocate(ivalues(43)) - ivalues=(/ & - 307011,7006,10004,222000,101023,31031,1031,1032,101023,33007, & - 225000,236000,101023,31031,1031,1032,8024,101001,225255,225000, & - 236000,101023,31031,1031,1032,8024,101001,225255, & - 1063,2001,4001,4002,4003,4004,4005,5002, & - 6002,7001,7006,11001,11016,11017,11002 /) - call codes_set(ibufr,'unexpandedDescriptors',ivalues) + if (iret /= CODES_SUCCESS) then + print *, 'ERROR creating BUFR from BUFR3' + stop 1 + end if + if (allocated(ivalues)) deallocate (ivalues) + allocate (ivalues(69)) + ivalues = (/ & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 0/) + call codes_set(ibufr, 'inputDataPresentIndicator', ivalues) + call codes_set(ibufr, 'edition', 3) + call codes_set(ibufr, 'masterTableNumber', 0) + call codes_set(ibufr, 'bufrHeaderSubCentre', 0) + call codes_set(ibufr, 'bufrHeaderCentre', 98) + call codes_set(ibufr, 'updateSequenceNumber', 1) + call codes_set(ibufr, 'dataCategory', 0) + call codes_set(ibufr, 'dataSubCategory', 140) + call codes_set(ibufr, 'masterTablesVersionNumber', 13) + call codes_set(ibufr, 'localTablesVersionNumber', 1) + call codes_set(ibufr, 'typicalYearOfCentury', 15) + call codes_set(ibufr, 'typicalMonth', 5) + call codes_set(ibufr, 'typicalDay', 4) + call codes_set(ibufr, 'typicalHour', 9) + call codes_set(ibufr, 'typicalMinute', 30) + call codes_set(ibufr, 'numberOfSubsets', 1) + call codes_set(ibufr, 'observedData', 1) + call codes_set(ibufr, 'compressedData', 0) + if (allocated(ivalues)) deallocate (ivalues) + allocate (ivalues(43)) + ivalues = (/ & + 307011, 7006, 10004, 222000, 101023, 31031, 1031, 1032, 101023, 33007, & + 225000, 236000, 101023, 31031, 1031, 1032, 8024, 101001, 225255, 225000, & + 236000, 101023, 31031, 1031, 1032, 8024, 101001, 225255, & + 1063, 2001, 4001, 4002, 4003, 4004, 4005, 5002, & + 6002, 7001, 7006, 11001, 11016, 11017, 11002/) + call codes_set(ibufr, 'unexpandedDescriptors', ivalues) - call codes_set(ibufrin,'unpack',1) + call codes_set(ibufrin, 'unpack', 1) - call codes_bufr_copy_data(ibufrin, ibufr) + call codes_bufr_copy_data(ibufrin, ibufr) - call codes_open_file(outfile,outfile_name,'w') - call codes_write(ibufr,outfile) - call codes_close_file(outfile) - call codes_release(ibufr) + call codes_open_file(outfile, outfile_name, 'w') + call codes_write(ibufr, outfile) + call codes_close_file(outfile) + call codes_release(ibufr) end program bufr_encode diff --git a/examples/F90/bufr_copy_keys.f90 b/examples/F90/bufr_copy_keys.f90 index 119b08505..bbb679045 100644 --- a/examples/F90/bufr_copy_keys.f90 +++ b/examples/F90/bufr_copy_keys.f90 @@ -9,26 +9,26 @@ ! Description: how to copy a BUFR key from a message to another. ! program bufr_copy_keys - use eccodes - implicit none - integer :: file1, file2, file3 - integer :: ibufr1,ibufr2,ibufr3 + use eccodes + implicit none + integer :: file1, file2, file3 + integer :: ibufr1, ibufr2, ibufr3 - call codes_open_file(file1, '../../data/bufr/PraticaTemp.bufr', 'r') - call codes_open_file(file2, '../../data/bufr/aaen_55.bufr', 'r') - call codes_open_file(file3, 'out.bufr_copy_keys_test_f.bufr', 'w') + call codes_open_file(file1, '../../data/bufr/PraticaTemp.bufr', 'r') + call codes_open_file(file2, '../../data/bufr/aaen_55.bufr', 'r') + call codes_open_file(file3, 'out.bufr_copy_keys_test_f.bufr', 'w') - call codes_bufr_new_from_file(file1, ibufr1) - call codes_bufr_new_from_file(file2, ibufr2) + call codes_bufr_new_from_file(file1, ibufr1) + call codes_bufr_new_from_file(file2, ibufr2) - call codes_clone(ibufr2, ibufr3) + call codes_clone(ibufr2, ibufr3) - call codes_copy_key(ibufr1, 'bufrHeaderCentre', ibufr3) + call codes_copy_key(ibufr1, 'bufrHeaderCentre', ibufr3) - call codes_write(ibufr3, file3) + call codes_write(ibufr3, file3) - call codes_close_file(file1) - call codes_close_file(file2) - call codes_close_file(file3) + call codes_close_file(file1) + call codes_close_file(file2) + call codes_close_file(file3) end program bufr_copy_keys diff --git a/examples/F90/bufr_copy_message.f90 b/examples/F90/bufr_copy_message.f90 index 4c49fc50f..9c058aa60 100644 --- a/examples/F90/bufr_copy_message.f90 +++ b/examples/F90/bufr_copy_message.f90 @@ -11,43 +11,43 @@ ! ! program copy - use eccodes - implicit none - integer :: err, sub_centre - integer(kind=kindOfSize) :: byte_size - integer :: infile,outfile - integer :: ibufr_in - integer :: ibufr_out - character(len=1), dimension(:), allocatable :: message - character(len=32) :: product_kind + use eccodes + implicit none + integer :: err, sub_centre + integer(kind=kindOfSize) :: byte_size + integer :: infile, outfile + integer :: ibufr_in + integer :: ibufr_out + character(len=1), dimension(:), allocatable :: message + character(len=32) :: product_kind - call codes_open_file(infile,'../../data/bufr/syno_1.bufr', 'r') - call codes_open_file(outfile,'out.copy.bufr', 'w') + call codes_open_file(infile, '../../data/bufr/syno_1.bufr', 'r') + call codes_open_file(outfile, 'out.copy.bufr', 'w') - ! A new BUFR message is loaded from file, - ! ibufr_in is the BUFR id to be used in subsequent calls - call codes_bufr_new_from_file(infile, ibufr_in) + ! A new BUFR message is loaded from file, + ! ibufr_in is the BUFR id to be used in subsequent calls + call codes_bufr_new_from_file(infile, ibufr_in) - call codes_get_message_size(ibufr_in, byte_size) - allocate(message(byte_size), stat=err) + call codes_get_message_size(ibufr_in, byte_size) + allocate (message(byte_size), stat=err) - call codes_copy_message(ibufr_in, message) + call codes_copy_message(ibufr_in, message) - call codes_new_from_message(ibufr_out, message) + call codes_new_from_message(ibufr_out, message) - call codes_get(ibufr_out, 'kindOfProduct', product_kind) - write(*,*) 'kindOfProduct=',product_kind + call codes_get(ibufr_out, 'kindOfProduct', product_kind) + write (*, *) 'kindOfProduct=', product_kind - sub_centre=80 - call codes_set(ibufr_out,'bufrHeaderSubCentre', sub_centre) + sub_centre = 80 + call codes_set(ibufr_out, 'bufrHeaderSubCentre', sub_centre) - ! Write message to a file - call codes_write(ibufr_out, outfile) + ! Write message to a file + call codes_write(ibufr_out, outfile) - call codes_release(ibufr_out) - call codes_release(ibufr_in) - call codes_close_file(infile) - call codes_close_file(outfile) - deallocate(message) + call codes_release(ibufr_out) + call codes_release(ibufr_in) + call codes_close_file(infile) + call codes_close_file(outfile) + deallocate (message) end program copy diff --git a/examples/F90/bufr_expanded.f90 b/examples/F90/bufr_expanded.f90 index 8176b20b4..5bc4c0177 100644 --- a/examples/F90/bufr_expanded.f90 +++ b/examples/F90/bufr_expanded.f90 @@ -13,53 +13,52 @@ ! ! program bufr_expanded -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i -integer :: count=0 -integer(kind=4) :: numberOfValues -real(kind=8), dimension(:), allocatable :: values + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i + integer :: count = 0 + integer(kind=4) :: numberOfValues + real(kind=8), dimension(:), allocatable :: values - call codes_open_file(ifile,'../../data/bufr/syno_1.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_1.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! Get the expanded data values + call codes_get(ibufr, 'numericValues', values) - ! Get the expanded data values - call codes_get(ibufr,'numericValues',values) + numberOfValues = size(values) - numberOfValues=size(values) + do i = 1, numberOfValues + write (*, *) ' ', i, values(i) + end do - do i=1,numberOfValues - write(*,*) ' ',i,values(i) - enddo + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! Free array + deallocate (values) - ! Free array - deallocate(values) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_expanded diff --git a/examples/F90/bufr_get_keys.f90 b/examples/F90/bufr_get_keys.f90 index a391c3fd0..14b5d8406 100644 --- a/examples/F90/bufr_get_keys.f90 +++ b/examples/F90/bufr_get_keys.f90 @@ -13,86 +13,85 @@ ! ! program bufr_get_keys -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i, count=0 -integer(kind=4) :: blockNumber,stationNumber -real(kind=8) :: t2m -integer(kind=4), dimension(:), allocatable :: descriptors -real(kind=8), dimension(:), allocatable :: values -character(len=9) :: typicalDate + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4) :: blockNumber, stationNumber + real(kind=8) :: t2m + integer(kind=4), dimension(:), allocatable :: descriptors + real(kind=8), dimension(:), allocatable :: values + character(len=9) :: typicalDate - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! Get as character + call codes_get(ibufr, 'typicalDate', typicalDate) + write (*, *) ' typicalDate:', typicalDate - ! Get as character - call codes_get(ibufr,'typicalDate',typicalDate) - write(*,*) ' typicalDate:',typicalDate + ! Get as integer + call codes_get(ibufr, 'blockNumber', blockNumber); + write (*, *) ' blockNumber:', blockNumber - ! Get as integer - call codes_get(ibufr,'blockNumber',blockNumber); - write(*,*) ' blockNumber:',blockNumber + ! Get as integer + call codes_get(ibufr, 'stationNumber', stationNumber); + write (*, *) ' stationNumber:', stationNumber - ! Get as integer - call codes_get(ibufr,'stationNumber',stationNumber); - write(*,*) ' stationNumber:',stationNumber + ! get as real + call codes_get(ibufr, 'airTemperatureAt2M', t2m); + write (*, *) ' airTemperatureAt2M:', t2m - ! get as real - call codes_get(ibufr,'airTemperatureAt2M',t2m); - write(*,*) ' airTemperatureAt2M:',t2m + ! ---- array of integer ---------------- - ! ---- array of integer ---------------- + ! get the expanded descriptors + call codes_get(ibufr, 'bufrdcExpandedDescriptors', descriptors) - ! get the expanded descriptors - call codes_get(ibufr,'bufrdcExpandedDescriptors',descriptors) + do i = 1, size(descriptors) + write (*, *) ' ', i, descriptors(i) + end do - do i=1,size(descriptors) - write(*,*) ' ',i,descriptors(i) - enddo + ! ---- array of real ---------------- - ! ---- array of real ---------------- + ! Get the expanded data values + call codes_get(ibufr, 'numericValues', values) - ! Get the expanded data values - call codes_get(ibufr,'numericValues',values) + do i = 1, size(values) + write (*, *) ' ', i, values(i) + end do - do i=1,size(values) - write(*,*) ' ',i,values(i) - enddo + ! Get as character + call codes_get(ibufr, 'typicalDate', typicalDate) + write (*, *) ' typicalDate:', typicalDate - ! Get as character - call codes_get(ibufr,'typicalDate',typicalDate) - write(*,*) ' typicalDate:',typicalDate + ! Free arrays + deallocate (values) + deallocate (descriptors) - ! Free arrays - deallocate(values) - deallocate(descriptors) + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_get_keys diff --git a/examples/F90/bufr_get_string_array.f90 b/examples/F90/bufr_get_string_array.f90 index b5ce5549a..ff5995ade 100644 --- a/examples/F90/bufr_get_string_array.f90 +++ b/examples/F90/bufr_get_string_array.f90 @@ -12,53 +12,53 @@ ! Description: how to get an array of strings from a BUFR message. program bufr_get_string_array - use eccodes - implicit none - integer :: ifile - integer :: iret,i,n - integer :: ibufr - integer :: strsize - integer, parameter :: max_strsize = 20 - character(len=max_strsize) , dimension(:),allocatable :: stationOrSiteName + use eccodes + implicit none + integer :: ifile + integer :: iret, i, n + integer :: ibufr + integer :: strsize + integer, parameter :: max_strsize = 20 + character(len=max_strsize), dimension(:), allocatable :: stationOrSiteName - call codes_open_file(ifile,'../../data/bufr/pgps_110.bufr','r') + call codes_open_file(ifile, '../../data/bufr/pgps_110.bufr', 'r') - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Unpack the data values - call codes_set(ibufr,'unpack',1) + ! Unpack the data values + call codes_set(ibufr, 'unpack', 1) - ! Get the width of the strings which is the same for all of them - call codes_get(ibufr,'stationOrSiteName->width',strsize) + ! Get the width of the strings which is the same for all of them + call codes_get(ibufr, 'stationOrSiteName->width', strsize) - ! The width is given in bits - strsize=strsize/8 + ! The width is given in bits + strsize = strsize/8 - ! max_strsize has to be set to a value >= to the size of the strings that we are getting - ! back from the call to codes_get_string_array - if (strsize > max_strsize) then - print *,'stationOrSiteName array dimension is ',max_strsize,' and should be ',strsize - call exit(1) - end if + ! max_strsize has to be set to a value >= to the size of the strings that we are getting + ! back from the call to codes_get_string_array + if (strsize > max_strsize) then + print *, 'stationOrSiteName array dimension is ', max_strsize, ' and should be ', strsize + call exit(1) + end if - ! Allocating the array of strings to be passed to codes_get_string_array is mandatory - call codes_get_size(ibufr,'stationOrSiteName',n) - allocate(stationOrSiteName(n)) + ! Allocating the array of strings to be passed to codes_get_string_array is mandatory + call codes_get_size(ibufr, 'stationOrSiteName', n) + allocate (stationOrSiteName(n)) - ! Passing an array of strings stationOrSiteName which must be allocated beforehand - call codes_get_string_array(ibufr,'stationOrSiteName',stationOrSiteName) - do i=1,n - write(*,'(A)')trim(stationOrSiteName(i)) - end do + ! Passing an array of strings stationOrSiteName which must be allocated beforehand + call codes_get_string_array(ibufr, 'stationOrSiteName', stationOrSiteName) + do i = 1, n + write (*, '(A)') trim(stationOrSiteName(i)) + end do - ! Remember to deallocate - deallocate(stationOrSiteName) + ! Remember to deallocate + deallocate (stationOrSiteName) - ! Release memory associated with bufr handle - ! ibufr won't be accessible after this - call codes_release(ibufr) + ! Release memory associated with bufr handle + ! ibufr won't be accessible after this + call codes_release(ibufr) - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_get_string_array diff --git a/examples/F90/bufr_keys_iterator.f90 b/examples/F90/bufr_keys_iterator.f90 index 94d98ee3b..888c986fd 100644 --- a/examples/F90/bufr_keys_iterator.f90 +++ b/examples/F90/bufr_keys_iterator.f90 @@ -15,65 +15,64 @@ ! keys in a BUFR message. ! program bufr_keys_iterator -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -character(len=256) :: key -integer :: kiter + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + character(len=256) :: key + integer :: kiter - call codes_open_file(ifile,'../../data/bufr/syno_1.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_1.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret /= CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! Create BUFR keys iterator + call codes_bufr_keys_iterator_new(ibufr, kiter, iret) - ! Create BUFR keys iterator - call codes_bufr_keys_iterator_new(ibufr,kiter,iret) + if (iret .ne. 0) then + write (*, *) 'ERROR: Unable to create BUFR keys iterator' + call exit(1) + end if - if (iret .ne. 0) then - write(*,*) 'ERROR: Unable to create BUFR keys iterator' - call exit(1) - end if + ! Get first key + call codes_bufr_keys_iterator_next(kiter, iret) - ! Get first key - call codes_bufr_keys_iterator_next(kiter, iret) + ! Loop over keys + do while (iret == CODES_SUCCESS) + ! Print key name + call codes_bufr_keys_iterator_get_name(kiter, key) + write (*, *) ' ', trim(key) - ! Loop over keys - do while (iret == CODES_SUCCESS) - ! Print key name - call codes_bufr_keys_iterator_get_name(kiter,key) - write(*,*) ' ',trim(key) + ! Get next key + call codes_bufr_keys_iterator_next(kiter, iret) + end do - ! Get next key - call codes_bufr_keys_iterator_next(kiter, iret) - end do + ! Delete key iterator + call codes_bufr_keys_iterator_delete(kiter) - ! Delete key iterator - call codes_bufr_keys_iterator_delete(kiter) + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_keys_iterator diff --git a/examples/F90/bufr_read_header.f90 b/examples/F90/bufr_read_header.f90 index f9bcbf0b6..de5d7df08 100644 --- a/examples/F90/bufr_read_header.f90 +++ b/examples/F90/bufr_read_header.f90 @@ -13,63 +13,63 @@ ! ! program bufr_read_header -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -integer(kind=4) :: dataCategory,dataSubCategory,typicalDate -integer(kind=4) :: centre,subcentre -integer(kind=4) :: masterversion,localversion -integer(kind=4) :: numberOfSubsets + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: dataCategory, dataSubCategory, typicalDate + integer(kind=4) :: centre, subcentre + integer(kind=4) :: masterversion, localversion + integer(kind=4) :: numberOfSubsets - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - call codes_get(ibufr,'dataCategory',dataCategory); - write(*,*) ' dataCategory:',dataCategory + call codes_get(ibufr, 'dataCategory', dataCategory); + write (*, *) ' dataCategory:', dataCategory - call codes_get(ibufr,'dataSubCategory',dataSubCategory); - write(*,*) ' dataSubCategory:',dataSubCategory + call codes_get(ibufr, 'dataSubCategory', dataSubCategory); + write (*, *) ' dataSubCategory:', dataSubCategory - call codes_get(ibufr,'typicalDate',typicalDate); - write(*,*) ' typicalDate:',typicalDate + call codes_get(ibufr, 'typicalDate', typicalDate); + write (*, *) ' typicalDate:', typicalDate - call codes_get(ibufr,'bufrHeaderCentre',centre); - write(*,*) ' bufrHeaderCentre:',centre + call codes_get(ibufr, 'bufrHeaderCentre', centre); + write (*, *) ' bufrHeaderCentre:', centre - call codes_get(ibufr,'bufrHeaderSubCentre',subcentre) - write(*,*) ' bufrHeaderSubCentre:',subcentre + call codes_get(ibufr, 'bufrHeaderSubCentre', subcentre) + write (*, *) ' bufrHeaderSubCentre:', subcentre - call codes_get(ibufr,'masterTablesVersionNumber',masterversion) - write(*,*) ' masterTablesVersionNumber:',masterversion + call codes_get(ibufr, 'masterTablesVersionNumber', masterversion) + write (*, *) ' masterTablesVersionNumber:', masterversion - call codes_get(ibufr,'localTablesVersionNumber',localversion) - write(*,*) ' localTablesVersionNumber:',localversion + call codes_get(ibufr, 'localTablesVersionNumber', localversion) + write (*, *) ' localTablesVersionNumber:', localversion - call codes_get(ibufr,'numberOfSubsets',numberOfSubsets) - write(*,*) ' numberOfSubsets:',numberOfSubsets + call codes_get(ibufr, 'numberOfSubsets', numberOfSubsets) + write (*, *) ' numberOfSubsets:', numberOfSubsets - ! Release the bufr message - call codes_release(ibufr) + ! Release the bufr message + call codes_release(ibufr) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - count=count+1 + count = count + 1 - end do + end do - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_read_header diff --git a/examples/F90/bufr_read_scatterometer.f90 b/examples/F90/bufr_read_scatterometer.f90 index 7b27b5be2..c3c314658 100644 --- a/examples/F90/bufr_read_scatterometer.f90 +++ b/examples/F90/bufr_read_scatterometer.f90 @@ -15,90 +15,85 @@ ! below might not work directly for other types of messages than the one used in the ! example. It is advised to use bufr_dump first to understand the structure of these messages. - program bufr_read_scatterometer -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i, count=0 -integer(kind=4) :: numObs,ii -real(kind=8), dimension(:), allocatable :: latVal,lonVal,bscatterVal -real(kind=8), dimension(:), allocatable :: year + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4) :: numObs, ii + real(kind=8), dimension(:), allocatable :: latVal, lonVal, bscatterVal + real(kind=8), dimension(:), allocatable :: year - call codes_open_file(ifile,'../../data/bufr/asca_139.bufr','r') + call codes_open_file(ifile, '../../data/bufr/asca_139.bufr', 'r') - ! The first BUFR message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first BUFR message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,'(A,I3)') 'message: ',count + write (*, '(A,I3)') 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! The BUFR file contains a single message with 2016 subsets in a compressed form. + ! It means each subset has exactly the same structure: they store one location with + ! several beams and one backscatter value in each beam. + ! + ! To print the backScatter values for beamIdentifier=2 from all the subsets + ! we will simply access the key by condition (see below). - ! The BUFR file contains a single message with 2016 subsets in a compressed form. - ! It means each subset has exactly the same structure: they store one location with - ! several beams and one backscatter value in each beam. - ! - ! To print the backScatter values for beamIdentifier=2 from all the subsets - ! we will simply access the key by condition (see below). + ! Read the total number of subsets. + call codes_get(ibufr, 'numberOfSubsets', numObs) - ! Read the total number of subsets. - call codes_get(ibufr,'numberOfSubsets',numObs) + write (*, '(A,I5)') "Number of values:", numObs - write(*,'(A,I5)') "Number of values:",numObs + ! Get latitude (for all the subsets) + call codes_get(ibufr, 'latitude', latVal); + ! Get longitude (for all the subsets) + call codes_get(ibufr, 'longitude', lonVal); + allocate (year(numObs)) + call codes_get(ibufr, 'year', year); + do ii = 1, size(year) + write (*, '(A,I4,A,F8.1)') 'year(', ii, ')=', year(ii) + end do - ! Get latitude (for all the subsets) - call codes_get(ibufr,'latitude',latVal); + ! Get backScatter for beam two. We use an access by condition for this key. + ! (for all the subsets) + call codes_get(ibufr, '/beamIdentifier=2/backscatter', bscatterVal); + ! Check that all arrays are same size + if (size(latVal) /= numObs .or. size(lonVal) /= numObs .or. size(bscatterVal) /= numObs) then + print *, 'inconsistent array dimension' + exit + end if - ! Get longitude (for all the subsets) - call codes_get(ibufr,'longitude',lonVal); + ! Print the values + write (*, *) 'pixel lat lon backscatter' + write (*, *) "--------------------------------------" - allocate(year(numObs)) - call codes_get(ibufr,'year',year); - do ii= 1, size(year) - write(*,'(A,I4,A,F8.1)') 'year(',ii,')=',year(ii) - enddo + do i = 1, numObs + write (*, '(I4,3F10.5)') i, latVal(i), lonVal(i), bscatterVal(i) + end do - ! Get backScatter for beam two. We use an access by condition for this key. - ! (for all the subsets) - call codes_get(ibufr,'/beamIdentifier=2/backscatter',bscatterVal); + ! Free arrays + deallocate (latVal) + deallocate (lonVal) + deallocate (bscatterVal) - ! Check that all arrays are same size - if (size(latVal)/= numObs .or. size(lonVal)/= numObs .or. size(bscatterVal)/= numObs) then - print *,'inconsistent array dimension' - exit - endif + ! Release the bufr message + call codes_release(ibufr) - ! Print the values - write(*,*) 'pixel lat lon backscatter' - write(*,*) "--------------------------------------" + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - do i=1,numObs - write(*,'(I4,3F10.5)') i,latVal(i),lonVal(i),bscatterVal(i) - end do + count = count + 1 - ! Free arrays - deallocate(latVal) - deallocate(lonVal) - deallocate(bscatterVal) + end do - ! Release the bufr message - call codes_release(ibufr) - - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) - - count=count+1 - - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_read_scatterometer diff --git a/examples/F90/bufr_read_synop.f90 b/examples/F90/bufr_read_synop.f90 index 5932c7faa..b88a8eabe 100644 --- a/examples/F90/bufr_read_synop.f90 +++ b/examples/F90/bufr_read_synop.f90 @@ -18,102 +18,102 @@ ! ! program bufr_read_synop -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: count=0 -integer(kind=4) :: blockNumber,stationNumber -real(kind=8) :: lat,t2m,td2m,ws,wdir -integer(kind=4) :: cloudAmount,cloudBaseHeight,lowCloud,midCloud,highCloud + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: blockNumber, stationNumber + real(kind=8) :: lat, t2m, td2m, ws, wdir + integer(kind=4) :: cloudAmount, cloudBaseHeight, lowCloud, midCloud, highCloud - call codes_open_file(ifile,'../../data/bufr/syno_multi.bufr','r') + call codes_open_file(ifile, '../../data/bufr/syno_multi.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1) + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1) - !read and print some data values. This example was written - ! for a SYNOP BUFR file! + !read and print some data values. This example was written + ! for a SYNOP BUFR file! - ! wmo block number - call codes_get(ibufr,'blockNumber',blockNumber) - write(*,*) ' blockNumber:',blockNumber + ! wmo block number + call codes_get(ibufr, 'blockNumber', blockNumber) + write (*, *) ' blockNumber:', blockNumber - ! station number - call codes_get(ibufr,'stationNumber',stationNumber) - write(*,*) ' stationNumber:',stationNumber + ! station number + call codes_get(ibufr, 'stationNumber', stationNumber) + write (*, *) ' stationNumber:', stationNumber - ! location - call codes_get(ibufr,'latitude',lat) - write(*,*) ' latitude:',lat + ! location + call codes_get(ibufr, 'latitude', lat) + write (*, *) ' latitude:', lat - call codes_get(ibufr,'longitude',lat) - write(*,*) ' longitude:',lat + call codes_get(ibufr, 'longitude', lat) + write (*, *) ' longitude:', lat - ! 2m temperature - call codes_get(ibufr,'airTemperatureAt2M',t2m); - write(*,*) ' airTemperatureAt2M:',t2m + ! 2m temperature + call codes_get(ibufr, 'airTemperatureAt2M', t2m); + write (*, *) ' airTemperatureAt2M:', t2m - ! 2m dewpoint temperature - call codes_get(ibufr,'dewpointTemperatureAt2M',td2m); - write(*,*) ' dewpointTemperatureAt2M:',td2m + ! 2m dewpoint temperature + call codes_get(ibufr, 'dewpointTemperatureAt2M', td2m); + write (*, *) ' dewpointTemperatureAt2M:', td2m - ! 10m wind - call codes_get(ibufr,'windSpeedAt10M',ws); - write(*,*) ' windSpeedAt10M:',ws + ! 10m wind + call codes_get(ibufr, 'windSpeedAt10M', ws); + write (*, *) ' windSpeedAt10M:', ws - call codes_get(ibufr,'windDirectionAt10M',wdir); - write(*,*) ' windDirectionAt10M:',wdir + call codes_get(ibufr, 'windDirectionAt10M', wdir); + write (*, *) ' windDirectionAt10M:', wdir - ! The cloud information is stored in several blocks in the - ! SYNOP message and the same key means a different thing in different - ! parts of the message. In this example we will read the first - ! cloud block introduced by the key - ! verticalSignificanceSurfaceObservations=1. - ! We know that this is the first occurrence of the keys we want to - ! read so we will use the # (occurrence) operator accordingly. + ! The cloud information is stored in several blocks in the + ! SYNOP message and the same key means a different thing in different + ! parts of the message. In this example we will read the first + ! cloud block introduced by the key + ! verticalSignificanceSurfaceObservations=1. + ! We know that this is the first occurrence of the keys we want to + ! read so we will use the # (occurrence) operator accordingly. - ! Cloud amount (low and middleclouds) - call codes_get(ibufr,'#1#cloudAmount',cloudAmount) - write(*,*) ' cloudAmount (low and middle):',cloudAmount + ! Cloud amount (low and middleclouds) + call codes_get(ibufr, '#1#cloudAmount', cloudAmount) + write (*, *) ' cloudAmount (low and middle):', cloudAmount - ! Height of cloud base - call codes_get(ibufr,'#1#heightOfBaseOfCloud',cloudBaseHeight) - write(*,*) ' heightOfBaseOfCloud:',cloudBaseHeight + ! Height of cloud base + call codes_get(ibufr, '#1#heightOfBaseOfCloud', cloudBaseHeight) + write (*, *) ' heightOfBaseOfCloud:', cloudBaseHeight - ! Cloud type (low clouds) - call codes_get(ibufr,'#1#cloudType',lowCloud) - write(*,*) ' cloudType (low):',lowCloud + ! Cloud type (low clouds) + call codes_get(ibufr, '#1#cloudType', lowCloud) + write (*, *) ' cloudType (low):', lowCloud - ! Cloud type (middle clouds) - call codes_get(ibufr,'#2#cloudType',midCloud) - write(*,*) ' cloudType (middle):',midCloud + ! Cloud type (middle clouds) + call codes_get(ibufr, '#2#cloudType', midCloud) + write (*, *) ' cloudType (middle):', midCloud - ! Cloud type (high clouds) - call codes_get(ibufr,'#3#cloudType',highCloud) - write(*,*) ' cloudType (high):',highCloud + ! Cloud type (high clouds) + call codes_get(ibufr, '#3#cloudType', highCloud) + write (*, *) ' cloudType (high):', highCloud - ! Release the bufr message - call codes_release(ibufr) + ! Release the bufr message + call codes_release(ibufr) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - count=count+1 + count = count + 1 - end do + end do - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_read_synop diff --git a/examples/F90/bufr_read_temp.f90 b/examples/F90/bufr_read_temp.f90 index 1bd142741..cbbb77164 100644 --- a/examples/F90/bufr_read_temp.f90 +++ b/examples/F90/bufr_read_temp.f90 @@ -16,64 +16,64 @@ ! example. It is advised to use bufr_dump first to understand the structure of these messages. ! program bufr_read_temp - use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: ibufr - integer :: i, count=0 - integer(kind=4),dimension(:), allocatable :: timePeriod,extendedVerticalSoundingSignificance - integer(kind=4) :: blockNumber,stationNumber - real(kind=8),dimension(:), allocatable :: pressure,airTemperature,dewpointTemperature - real(kind=8),dimension(:), allocatable :: geopotentialHeight,latitudeDisplacement,longitudeDisplacement - real(kind=8),dimension(:), allocatable :: windDirection,windSpeed + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4), dimension(:), allocatable :: timePeriod, extendedVerticalSoundingSignificance + integer(kind=4) :: blockNumber, stationNumber + real(kind=8), dimension(:), allocatable :: pressure, airTemperature, dewpointTemperature + real(kind=8), dimension(:), allocatable :: geopotentialHeight, latitudeDisplacement, longitudeDisplacement + real(kind=8), dimension(:), allocatable :: windDirection, windSpeed - call codes_open_file(ifile,'../../data/bufr/PraticaTemp.bufr','r') + call codes_open_file(ifile, '../../data/bufr/PraticaTemp.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) - do while (iret/=CODES_END_OF_FILE) - write(*,*) 'message: ',count - call codes_set(ibufr,'unpack',1) - call codes_get(ibufr,'timePeriod',timePeriod) - call codes_get(ibufr,'pressure',pressure) - call codes_get(ibufr,'extendedVerticalSoundingSignificance',extendedVerticalSoundingSignificance) - call codes_get(ibufr,'nonCoordinateGeopotentialHeight',geopotentialHeight) - call codes_get(ibufr,'latitudeDisplacement',latitudeDisplacement) - call codes_get(ibufr,'longitudeDisplacement',longitudeDisplacement) - call codes_get(ibufr,'airTemperature',airTemperature) - call codes_get(ibufr,'dewpointTemperature',dewpointTemperature) - call codes_get(ibufr,'windDirection',windDirection) - call codes_get(ibufr,'windSpeed',windSpeed) - call codes_get(ibufr,'blockNumber',blockNumber) - call codes_get(ibufr,'stationNumber',stationNumber) - print *,'station',blockNumber,stationNumber - print *,'timePeriod pressure geopotentialHeight latitudeDisplacement & - &longitudeDisplacement airTemperature windDirection windSpeed significance' - do i=1,size(windSpeed) - write(*,'(I5,6X,F9.1,2X,F9.2,10X,F8.2,14X,F8.2,16X,F8.2,6X,F8.2,4X,F8.2,4X,I0)') timePeriod(i),pressure(i),& - &geopotentialHeight(i),latitudeDisplacement(i),& - &longitudeDisplacement(i),airTemperature(i),windDirection(i),windSpeed(i),extendedVerticalSoundingSignificance(i) - enddo - ! Free arrays - deallocate(timePeriod) - deallocate(pressure) - deallocate(geopotentialHeight) - deallocate(latitudeDisplacement) - deallocate(longitudeDisplacement) - deallocate(airTemperature) - deallocate(dewpointTemperature) - deallocate(windDirection) - deallocate(windSpeed) - deallocate(extendedVerticalSoundingSignificance) - ! Release the bufr message - call codes_release(ibufr) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) - count=count+1 - end do - ! Close file - call codes_close_file(ifile) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) + do while (iret /= CODES_END_OF_FILE) + write (*, *) 'message: ', count + call codes_set(ibufr, 'unpack', 1) + call codes_get(ibufr, 'timePeriod', timePeriod) + call codes_get(ibufr, 'pressure', pressure) + call codes_get(ibufr, 'extendedVerticalSoundingSignificance', extendedVerticalSoundingSignificance) + call codes_get(ibufr, 'nonCoordinateGeopotentialHeight', geopotentialHeight) + call codes_get(ibufr, 'latitudeDisplacement', latitudeDisplacement) + call codes_get(ibufr, 'longitudeDisplacement', longitudeDisplacement) + call codes_get(ibufr, 'airTemperature', airTemperature) + call codes_get(ibufr, 'dewpointTemperature', dewpointTemperature) + call codes_get(ibufr, 'windDirection', windDirection) + call codes_get(ibufr, 'windSpeed', windSpeed) + call codes_get(ibufr, 'blockNumber', blockNumber) + call codes_get(ibufr, 'stationNumber', stationNumber) + print *, 'station', blockNumber, stationNumber + print *, 'timePeriod pressure geopotentialHeight latitudeDisplacement & + &longitudeDisplacement airTemperature windDirection windSpeed significance' + do i = 1, size(windSpeed) + write (*, '(I5,6X,F9.1,2X,F9.2,10X,F8.2,14X,F8.2,16X,F8.2,6X,F8.2,4X,F8.2,4X,I0)') timePeriod(i), pressure(i),& + &geopotentialHeight(i), latitudeDisplacement(i),& + &longitudeDisplacement(i), airTemperature(i), windDirection(i), windSpeed(i), extendedVerticalSoundingSignificance(i) + end do + ! Free arrays + deallocate (timePeriod) + deallocate (pressure) + deallocate (geopotentialHeight) + deallocate (latitudeDisplacement) + deallocate (longitudeDisplacement) + deallocate (airTemperature) + deallocate (dewpointTemperature) + deallocate (windDirection) + deallocate (windSpeed) + deallocate (extendedVerticalSoundingSignificance) + ! Release the bufr message + call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) + count = count + 1 + end do + ! Close file + call codes_close_file(ifile) end program bufr_read_temp diff --git a/examples/F90/bufr_read_tempf.f90 b/examples/F90/bufr_read_tempf.f90 index 8e464e768..5214cf7c2 100644 --- a/examples/F90/bufr_read_tempf.f90 +++ b/examples/F90/bufr_read_tempf.f90 @@ -18,161 +18,160 @@ ! example. It is advised to use bufr_dump first to understand the structure of these messages. ! program bufr_read_temp - use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: ibufr - integer :: i, count=0 - integer :: iflag - integer :: status_id, status_ht, status_time=0, status_p - integer :: status_rsno, status_rssoft, statid_missing - integer(kind=4) :: sizews - integer(kind=4) :: blockNumber,stationNumber - integer(kind=4) :: ymd,hms - logical :: llstdonly = .True. ! Set True to list standard levels only - logical :: llskip - real(kind=8) :: year,month,day,hour,minute,second - real(kind=8) :: htg,htp,htec=0,sondeType - real(kind=8), dimension(:), allocatable :: lat,lon - real(kind=8), dimension(:), allocatable :: timeVal,dlatVal,dlonVal,vssVal - real(kind=8), dimension(:), allocatable :: presVal,zVal,tVal,tdVal,wdirVal,wspVal - character(len=128) :: statid - character(len=16) :: rsnumber - character(len=16) :: rssoftware - character(len=8) :: Note + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer :: iflag + integer :: status_id, status_ht, status_time = 0, status_p + integer :: status_rsno, status_rssoft, statid_missing + integer(kind=4) :: sizews + integer(kind=4) :: blockNumber, stationNumber + integer(kind=4) :: ymd, hms + logical :: llstdonly = .True. ! Set True to list standard levels only + logical :: llskip + real(kind=8) :: year, month, day, hour, minute, second + real(kind=8) :: htg, htp, htec = 0, sondeType + real(kind=8), dimension(:), allocatable :: lat, lon + real(kind=8), dimension(:), allocatable :: timeVal, dlatVal, dlonVal, vssVal + real(kind=8), dimension(:), allocatable :: presVal, zVal, tVal, tdVal, wdirVal, wspVal + character(len=128) :: statid + character(len=16) :: rsnumber + character(len=16) :: rssoftware + character(len=8) :: Note - call codes_open_file(ifile,'../../data/bufr/PraticaTemp.bufr','r') + call codes_open_file(ifile, '../../data/bufr/PraticaTemp.bufr', 'r') - ! the first bufr message is loaded from file - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! the first bufr message is loaded from file + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! do while (iret/=CODES_END_OF_FILE) - do while (iret/=CODES_END_OF_FILE .AND. status_time==CODES_SUCCESS) + ! do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE .AND. status_time == CODES_SUCCESS) - ! we need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,"unpack",1); + ! we need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, "unpack", 1); + ! In our BUFR message verticalSoundingSignificance is always followed by + ! geopotential, airTemperature, dewpointTemperature, + ! windDirection, windSpeed and pressure. + ! - ! In our BUFR message verticalSoundingSignificance is always followed by - ! geopotential, airTemperature, dewpointTemperature, - ! windDirection, windSpeed and pressure. - ! + count = count + 1 + llskip = .False. - count=count+1 - llskip=.False. + ! Metadata: + call codes_get(ibufr, 'shipOrMobileLandStationIdentifier', statid, status_id) + IF (status_id /= CODES_SUCCESS) statid = "UNKNOWN" + call codes_is_missing(ibufr, 'shipOrMobileLandStationIdentifier', statid_missing) + IF (statid_missing == 1) statid = "MISSING" + call codes_get(ibufr, 'blockNumber', blockNumber) + call codes_get(ibufr, 'stationNumber', stationNumber) + call codes_get(ibufr, 'year', year) + call codes_get(ibufr, 'month', month) + call codes_get(ibufr, 'day', day) + call codes_get(ibufr, 'hour', hour) + call codes_get(ibufr, 'minute', minute) + call codes_get(ibufr, 'second', second, status_time) + IF (status_time /= CODES_SUCCESS) second = 0.0 + call codes_get(ibufr, 'latitude', lat) + call codes_get(ibufr, 'longitude', lon) + call codes_get(ibufr, 'heightOfStationGroundAboveMeanSeaLevel', htg, status_ht) + IF (status_ht /= CODES_SUCCESS) htg = -999.0 + call codes_get(ibufr, 'heightOfBarometerAboveMeanSeaLevel', htp, status_ht) + IF (status_ht /= CODES_SUCCESS) htp = -999.0 + call codes_get(ibufr, 'radiosondeType', sondeType) + call codes_get(ibufr, 'heightOfStation', htec, status_ht) ! Height from WMO list (BUFR) + IF (status_ht == CODES_SUCCESS .AND. htg == -999.0) htg = htec + ymd = INT(year)*10000 + INT(month)*100 + INT(day) + hms = INT(hour)*10000 + INT(minute)*100 + INT(second) + call codes_get(ibufr, 'radiosondeSerialNumber', rsnumber, status_rsno) + call codes_get(ibufr, 'softwareVersionNumber', rssoftware, status_rssoft) - ! Metadata: - call codes_get(ibufr,'shipOrMobileLandStationIdentifier',statid,status_id) - IF (status_id /= CODES_SUCCESS) statid = "UNKNOWN" - call codes_is_missing(ibufr,'shipOrMobileLandStationIdentifier',statid_missing) - IF (statid_missing == 1) statid = "MISSING" - call codes_get(ibufr,'blockNumber',blockNumber) - call codes_get(ibufr,'stationNumber',stationNumber) - call codes_get(ibufr,'year',year) - call codes_get(ibufr,'month',month) - call codes_get(ibufr,'day',day) - call codes_get(ibufr,'hour',hour) - call codes_get(ibufr,'minute',minute) - call codes_get(ibufr,'second',second,status_time) - IF (status_time /= CODES_SUCCESS) second = 0.0 - call codes_get(ibufr,'latitude',lat) - call codes_get(ibufr,'longitude',lon) - call codes_get(ibufr,'heightOfStationGroundAboveMeanSeaLevel',htg,status_ht) - IF (status_ht /= CODES_SUCCESS) htg = -999.0 - call codes_get(ibufr,'heightOfBarometerAboveMeanSeaLevel',htp,status_ht) - IF (status_ht /= CODES_SUCCESS) htp = -999.0 - call codes_get(ibufr,'radiosondeType',sondeType) - call codes_get(ibufr,'heightOfStation',htec,status_ht) ! Height from WMO list (BUFR) - IF (status_ht == CODES_SUCCESS .AND. htg == -999.0) htg = htec - ymd = INT(year)*10000+INT(month)*100+INT(day) - hms = INT(hour)*10000+INT(minute)*100+INT(second) - call codes_get(ibufr,'radiosondeSerialNumber',rsnumber,status_rsno) - call codes_get(ibufr,'softwareVersionNumber',rssoftware,status_rssoft) + ! Ascent (skip incomplete reports for now) + call codes_get(ibufr, 'timePeriod', timeVal, status_time) + IF (status_time /= CODES_SUCCESS) THEN + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType) + write (*, '(A)') 'Missing times - skip' + llskip = .True. + END IF + call codes_get(ibufr, 'pressure', presVal, status_p) + IF (status_p /= CODES_SUCCESS) THEN + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType) + write (*, '(A)') 'Missing pressures - skip' + llskip = .True. + END IF + call codes_get(ibufr, 'nonCoordinateGeopotentialHeight', zVal, status_ht) + IF (status_ht /= CODES_SUCCESS) THEN + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType) + write (*, '(A)') 'Missing heights - skip' + llskip = .True. + END IF + ! IF (blockNumber /= 17 .OR. stationNumber /= 196) llskip=.True. ! FIX + ! IF (blockNumber /= 17.0) llskip=.True. ! FIX - ! Ascent (skip incomplete reports for now) - call codes_get(ibufr,'timePeriod',timeVal,status_time) - IF (status_time /= CODES_SUCCESS) THEN - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType) - write(*,'(A)') 'Missing times - skip' - llskip=.True. - ENDIF - call codes_get(ibufr,'pressure',presVal,status_p) - IF (status_p /= CODES_SUCCESS) THEN - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType) - write(*,'(A)') 'Missing pressures - skip' - llskip=.True. - ENDIF - call codes_get(ibufr,'nonCoordinateGeopotentialHeight',zVal,status_ht) - IF (status_ht /= CODES_SUCCESS) THEN - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType) - write(*,'(A)') 'Missing heights - skip' - llskip=.True. - ENDIF - ! IF (blockNumber /= 17 .OR. stationNumber /= 196) llskip=.True. ! FIX - ! IF (blockNumber /= 17.0) llskip=.True. ! FIX + IF (.NOT. llskip) THEN + call codes_get(ibufr, 'latitudeDisplacement', dlatVal) + call codes_get(ibufr, 'longitudeDisplacement', dlonVal) + call codes_get(ibufr, 'extendedVerticalSoundingSignificance', vssVal) + !call codes_get(ibufr,'geopotentialHeight',zVal) + call codes_get(ibufr, 'airTemperature', tVal) + call codes_get(ibufr, 'dewpointTemperature', tdVal) + call codes_get(ibufr, 'windDirection', wdirVal) + call codes_get(ibufr, 'windSpeed', wspVal) - IF (.NOT.llskip) THEN - call codes_get(ibufr,'latitudeDisplacement',dlatVal) - call codes_get(ibufr,'longitudeDisplacement',dlonVal) - call codes_get(ibufr,'extendedVerticalSoundingSignificance',vssVal) - !call codes_get(ibufr,'geopotentialHeight',zVal) - call codes_get(ibufr,'airTemperature',tVal) - call codes_get(ibufr,'dewpointTemperature',tdVal) - call codes_get(ibufr,'windDirection',wdirVal) - call codes_get(ibufr,'windSpeed',wspVal) + ! ---- Array sizes (pressure size can be larger - wind shear levels) + sizews = size(wspVal) - ! ---- Array sizes (pressure size can be larger - wind shear levels) - sizews = size(wspVal) + ! ---- Print the values -------------------------------- + write (*, '(A,A72)') 'Statid: ', statid + write (*, '(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4,I5)') 'Ob: ', count, & + ' ', blockNumber, ' ', stationNumber, ymd, hms, lat(1), lon(1), htg, htp, INT(sondeType), sizews + IF (status_ht == CODES_SUCCESS) write (*, '(A,F9.3,F10.3,F7.1)') & + 'WMO list lat, lon, ht: ', lat(1), lon(1), htec + IF (status_rsno == CODES_SUCCESS) write (*, '(A,A,A)') & + 'Radiosonde number/software: ', rsnumber, rssoftware + write (*, '(A)') 'level dtime dlat dlon pressure geopotH airTemp dewPtT windDir windSp signif' + do i = 1, sizews + Note = ' ' + iflag = vssVal(i) + IF (i > 1) THEN + IF (presVal(i) > presVal(i - 1) .OR. zVal(i) < zVal(i - 1) & + .OR. timeVal(i) < timeVal(i - 1)) Note = ' OOO ' + IF ((timeVal(i) - timeVal(i - 1)) > 120) Note = ' tjump ' + IF (ABS(dlatVal(i) - dlatVal(i - 1)) > 0.1 .OR. & + ABS(dlonVal(i) - dlonVal(i - 1)) > 0.1) THEN + Note = ' pjump ' + IF (dlatVal(i) == CODES_MISSING_DOUBLE .OR. & + dlatVal(i - 1) == CODES_MISSING_DOUBLE) Note = ' pmiss ' + END IF + END IF + IF (.NOT. llstdonly .OR. BTEST(iflag, 16)) & + write (*, '(I5,F7.1,2F7.3,F9.1,F8.1,4F8.2,I8,A)') i, timeVal(i), & + dlatVal(i), dlonVal(i), presVal(i), zVal(i), tVal(i), tVal(i) - tdVal(i), & + wdirVal(i), wspVal(i), INT(vssVal(i)), Note + end do - ! ---- Print the values -------------------------------- - write(*,'(A,A72)') 'Statid: ',statid - write(*,'(A,I7,A,I2.2,A,I3.3,I9,I7.6,F9.3,F10.3,2F7.1,I4,I5)') 'Ob: ',count, & - ' ',blockNumber,' ',stationNumber,ymd,hms,lat(1),lon(1),htg,htp,INT(sondeType),sizews - IF (status_ht == CODES_SUCCESS) write(*,'(A,F9.3,F10.3,F7.1)') & - 'WMO list lat, lon, ht: ', lat(1),lon(1),htec - IF (status_rsno == CODES_SUCCESS) write(*,'(A,A,A)') & - 'Radiosonde number/software: ', rsnumber, rssoftware - write(*,'(A)') 'level dtime dlat dlon pressure geopotH airTemp dewPtT windDir windSp signif' - do i=1,sizews - Note = ' ' - iflag = vssVal(i) - IF (i > 1) THEN - IF (presVal(i) > presVal(i-1) .OR. zVal(i) < zVal(i-1) & - .OR. timeVal(i) < timeVal(i-1)) Note=' OOO ' - IF ((timeVal(i)-timeVal(i-1))>120) Note=' tjump ' - IF (ABS(dlatVal(i)-dlatVal(i-1))>0.1 .OR. & - ABS(dlonVal(i)-dlonVal(i-1))>0.1) THEN - Note=' pjump ' - IF (dlatVal(i) == CODES_MISSING_DOUBLE .OR. & - dlatVal(i-1) == CODES_MISSING_DOUBLE) Note=' pmiss ' - ENDIF - ENDIF - IF (.NOT.llstdonly .OR. BTEST(iflag,16)) & - write(*,'(I5,F7.1,2F7.3,F9.1,F8.1,4F8.2,I8,A)') i,timeVal(i), & - dlatVal(i),dlonVal(i),presVal(i),zVal(i),tVal(i),tVal(i)-tdVal(i), & - wdirVal(i),wspVal(i),INT(vssVal(i)), Note - end do + ! free arrays + deallocate (dlatVal, dlonVal, vssVal) + deallocate (presVal, zVal, tVal, tdVal, wdirVal, wspVal) + END IF + IF (ALLOCATED(timeVal)) deallocate (timeVal) - ! free arrays - deallocate(dlatVal,dlonVal,vssVal) - deallocate(presVal,zVal,tVal,tdVal,wdirVal,wspVal) - END IF - IF (ALLOCATED(timeVal)) deallocate(timeVal) + ! release the bufr message + call codes_release(ibufr) - ! release the bufr message - call codes_release(ibufr) + ! load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + end do - end do - - ! close file - call codes_close_file(ifile) + ! close file + call codes_close_file(ifile) end program bufr_read_temp diff --git a/examples/F90/bufr_read_tropical_cyclone.f90 b/examples/F90/bufr_read_tropical_cyclone.f90 index b2b1ee512..19e75bb0a 100644 --- a/examples/F90/bufr_read_tropical_cyclone.f90 +++ b/examples/F90/bufr_read_tropical_cyclone.f90 @@ -21,254 +21,254 @@ program bufr_read_tropical_cyclone implicit none integer :: ifile integer :: iret - integer :: ibufr,skipMember + integer :: ibufr, skipMember integer :: significance - integer :: year,month,day,hour,minute - integer :: i,j,k,ierr,count=1 - integer :: rankPosition,rankSignificance,rankPressure,rankWind - integer :: rankPeriod,numberOfPeriods + integer :: year, month, day, hour, minute + integer :: i, j, k, ierr, count = 1 + integer :: rankPosition, rankSignificance, rankPressure, rankWind + integer :: rankPeriod, numberOfPeriods - real(kind=8) :: latitudeCentre,longitudeCentre - real(kind=8), dimension(:), allocatable :: latitudeMaxWind0,longitudeMaxWind0,windMaxWind0 - real(kind=8), dimension(:), allocatable :: latitudeAnalysis,longitudeAnalysis,pressureAnalysis - real(kind=8), dimension(:,:), allocatable :: latitude,longitude,pressure - real(kind=8), dimension(:,:), allocatable :: latitudeWind,longitudeWind,wind - integer(kind=4), dimension(:), allocatable :: memberNumber,period + real(kind=8) :: latitudeCentre, longitudeCentre + real(kind=8), dimension(:), allocatable :: latitudeMaxWind0, longitudeMaxWind0, windMaxWind0 + real(kind=8), dimension(:), allocatable :: latitudeAnalysis, longitudeAnalysis, pressureAnalysis + real(kind=8), dimension(:, :), allocatable :: latitude, longitude, pressure + real(kind=8), dimension(:, :), allocatable :: latitudeWind, longitudeWind, wind + integer(kind=4), dimension(:), allocatable :: memberNumber, period real(kind=8), dimension(:), allocatable :: values integer(kind=4), dimension(:), allocatable :: ivalues - character(len=8) :: rankSignificanceStr,rankPositionStr,rankPressureStr,rankWindStr - character(len=8) :: stormIdentifier,rankPeriodStr + character(len=8) :: rankSignificanceStr, rankPositionStr, rankPressureStr, rankWindStr + character(len=8) :: stormIdentifier, rankPeriodStr - call codes_open_file(ifile,'../../data/bufr/tropical_cyclone.bufr','r') + call codes_open_file(ifile, '../../data/bufr/tropical_cyclone.bufr', 'r') ! The first BUFR message is loaded from file. ! ibufr is the BUFR id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,'(A,I3,A)') '**************** MESSAGE: ',count,' *****************' + write (*, '(A,I3,A)') '**************** MESSAGE: ', count, ' *****************' ! We need to instruct ecCodes to unpack the data values - call codes_set(ibufr,"unpack",1); + call codes_set(ibufr, "unpack", 1); + call codes_get(ibufr, 'year', year); + call codes_get(ibufr, 'month', month); + call codes_get(ibufr, 'day', day); + call codes_get(ibufr, 'hour', hour); + call codes_get(ibufr, 'minute', minute); + write (*, '(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)') 'Date and time: ', day, '.', month, '.', year, ' ', hour, ':', minute - call codes_get(ibufr,'year',year); - call codes_get(ibufr,'month',month); - call codes_get(ibufr,'day',day); - call codes_get(ibufr,'hour',hour); - call codes_get(ibufr,'minute',minute); - write(*,'(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)')'Date and time: ',day,'.',month,'.',year,' ',hour,':',minute - - call codes_get(ibufr,'stormIdentifier',stormIdentifier) - write(*,'(A,A)')'Storm identifier: ',stormIdentifier + call codes_get(ibufr, 'stormIdentifier', stormIdentifier) + write (*, '(A,A)') 'Storm identifier: ', stormIdentifier ! How many different timePeriod in the data structure? - rankPeriod=0 - ierr=0 - do while(ierr==0) - rankPeriod=rankPeriod+1 - write (rankPeriodStr,'(I0)')rankPeriod - call codes_get(ibufr,'#'//trim(rankPeriodStr)//'#timePeriod',period,ierr) - if(allocated(period)) deallocate(period) - enddo + rankPeriod = 0 + ierr = 0 + do while (ierr == 0) + rankPeriod = rankPeriod + 1 + write (rankPeriodStr, '(I0)') rankPeriod + call codes_get(ibufr, '#'//trim(rankPeriodStr)//'#timePeriod', period, ierr) + if (allocated(period)) deallocate (period) + end do ! The numberOfPeriods includes the analysis (period=0) - numberOfPeriods=rankPeriod + numberOfPeriods = rankPeriod - call codes_get(ibufr,'ensembleMemberNumber',memberNumber) + call codes_get(ibufr, 'ensembleMemberNumber', memberNumber) - allocate(latitude(size(memberNumber),numberOfPeriods)) - allocate(longitude(size(memberNumber),numberOfPeriods)) - allocate(pressure(size(memberNumber),numberOfPeriods)) - allocate(latitudeWind(size(memberNumber),numberOfPeriods)) - allocate(longitudeWind(size(memberNumber),numberOfPeriods)) - allocate(wind(size(memberNumber),numberOfPeriods)) - allocate(values(size(memberNumber))) - allocate(period(numberOfPeriods)) - period(1)=0 + allocate (latitude(size(memberNumber), numberOfPeriods)) + allocate (longitude(size(memberNumber), numberOfPeriods)) + allocate (pressure(size(memberNumber), numberOfPeriods)) + allocate (latitudeWind(size(memberNumber), numberOfPeriods)) + allocate (longitudeWind(size(memberNumber), numberOfPeriods)) + allocate (wind(size(memberNumber), numberOfPeriods)) + allocate (values(size(memberNumber))) + allocate (period(numberOfPeriods)) + period(1) = 0 ! Observed Storm Centre - call codes_get(ibufr,'#1#meteorologicalAttributeSignificance',significance); - call codes_get(ibufr,'#1#latitude',latitudeCentre); - call codes_get(ibufr,'#1#longitude',longitudeCentre); - if (significance/=1) then - print *,'ERROR: unexpected #1#meteorologicalAttributeSignificance' + call codes_get(ibufr, '#1#meteorologicalAttributeSignificance', significance); + call codes_get(ibufr, '#1#latitude', latitudeCentre); + call codes_get(ibufr, '#1#longitude', longitudeCentre); + if (significance /= 1) then + print *, 'ERROR: unexpected #1#meteorologicalAttributeSignificance' stop 1 - endif - if (latitudeCentre==CODES_MISSING_DOUBLE .and. longitudeCentre==CODES_MISSING_DOUBLE) then - write(*,'(a)')'Observed storm centre position missing' + end if + if (latitudeCentre == CODES_MISSING_DOUBLE .and. longitudeCentre == CODES_MISSING_DOUBLE) then + write (*, '(a)') 'Observed storm centre position missing' else - write(*,'(A,F8.2,A,F8.2)')'Observed storm centre: latitude=',latitudeCentre,' longitude=',longitudeCentre - endif + write (*, '(A,F8.2,A,F8.2)') 'Observed storm centre: latitude=', latitudeCentre, ' longitude=', longitudeCentre + end if ! Location of storm in perturbed analysis - call codes_get(ibufr,'#2#meteorologicalAttributeSignificance',significance); - call codes_get(ibufr,'#2#latitude',latitudeAnalysis); - call codes_get(ibufr,'#2#longitude',longitudeAnalysis); - call codes_get(ibufr,'#1#pressureReducedToMeanSeaLevel',pressureAnalysis); - if (significance/=4) then - print *,'ERROR: unexpected #2#meteorologicalAttributeSignificance' + call codes_get(ibufr, '#2#meteorologicalAttributeSignificance', significance); + call codes_get(ibufr, '#2#latitude', latitudeAnalysis); + call codes_get(ibufr, '#2#longitude', longitudeAnalysis); + call codes_get(ibufr, '#1#pressureReducedToMeanSeaLevel', pressureAnalysis); + if (significance /= 4) then + print *, 'ERROR: unexpected #2#meteorologicalAttributeSignificance' stop 1 - endif - if (size(latitudeAnalysis)==size(memberNumber)) then - latitude(:,1)=latitudeAnalysis - longitude(:,1)=longitudeAnalysis - pressure(:,1)=pressureAnalysis + end if + if (size(latitudeAnalysis) == size(memberNumber)) then + latitude(:, 1) = latitudeAnalysis + longitude(:, 1) = longitudeAnalysis + pressure(:, 1) = pressureAnalysis else - latitude(:,1)=latitudeAnalysis(1) - longitude(:,1)=longitudeAnalysis(1) - pressure(:,1)=pressureAnalysis(1) - endif + latitude(:, 1) = latitudeAnalysis(1) + longitude(:, 1) = longitudeAnalysis(1) + pressure(:, 1) = pressureAnalysis(1) + end if ! Location of Maximum Wind - call codes_get(ibufr,'#3#meteorologicalAttributeSignificance',significance); - call codes_get(ibufr,'#3#latitude',latitudeMaxWind0); - call codes_get(ibufr,'#3#longitude',longitudeMaxWind0); - if (significance/=3) then - print *,'ERROR: unexpected #3#meteorologicalAttributeSignificance=',significance + call codes_get(ibufr, '#3#meteorologicalAttributeSignificance', significance); + call codes_get(ibufr, '#3#latitude', latitudeMaxWind0); + call codes_get(ibufr, '#3#longitude', longitudeMaxWind0); + if (significance /= 3) then + print *, 'ERROR: unexpected #3#meteorologicalAttributeSignificance=', significance stop 1 - endif - call codes_get(ibufr,'#1#windSpeedAt10M',windMaxWind0); - if (size(latitudeMaxWind0)==size(memberNumber)) then - latitudeWind(:,1)=latitudeMaxWind0 - longitudeWind(:,1)=longitudeMaxWind0 - wind(:,1)=windMaxWind0 + end if + call codes_get(ibufr, '#1#windSpeedAt10M', windMaxWind0); + if (size(latitudeMaxWind0) == size(memberNumber)) then + latitudeWind(:, 1) = latitudeMaxWind0 + longitudeWind(:, 1) = longitudeMaxWind0 + wind(:, 1) = windMaxWind0 else - latitudeWind(:,1)=latitudeMaxWind0(1) - longitudeWind(:,1)=longitudeMaxWind0(1) - wind(:,1)=windMaxWind0(1) - endif + latitudeWind(:, 1) = latitudeMaxWind0(1) + longitudeWind(:, 1) = longitudeMaxWind0(1) + wind(:, 1) = windMaxWind0(1) + end if - rankSignificance=3 - rankPosition=3 - rankPressure=1 - rankWind=1 - rankPeriod=0 + rankSignificance = 3 + rankPosition = 3 + rankPressure = 1 + rankWind = 1 + rankPeriod = 0 ! Loop on all periods excluding analysis period(1)=0 - do i=2,numberOfPeriods + do i = 2, numberOfPeriods - rankPeriod=rankPeriod+1 - write (rankPeriodStr,'(I0)')rankPeriod - call codes_get(ibufr,'#'//trim(rankPeriodStr)//'#timePeriod',ivalues); - do k=1,size(ivalues) - if (ivalues(k)/=CODES_MISSING_LONG) then - period(i)=ivalues(k) + rankPeriod = rankPeriod + 1 + write (rankPeriodStr, '(I0)') rankPeriod + call codes_get(ibufr, '#'//trim(rankPeriodStr)//'#timePeriod', ivalues); + do k = 1, size(ivalues) + if (ivalues(k) /= CODES_MISSING_LONG) then + period(i) = ivalues(k) exit - endif - enddo - deallocate(ivalues) + end if + end do + deallocate (ivalues) ! Location of the storm - rankSignificance=rankSignificance+1 - write (rankSignificanceStr,'(I0)')rankSignificance - call codes_get(ibufr,'#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance',ivalues); - do k=1,size(ivalues) - if (ivalues(k)/=CODES_MISSING_LONG) then - significance=ivalues(k) + rankSignificance = rankSignificance + 1 + write (rankSignificanceStr, '(I0)') rankSignificance + call codes_get(ibufr, '#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance', ivalues); + do k = 1, size(ivalues) + if (ivalues(k) /= CODES_MISSING_LONG) then + significance = ivalues(k) exit - endif - enddo - deallocate(ivalues) + end if + end do + deallocate (ivalues) - rankPosition=rankPosition+1 - write (rankPositionStr,'(I0)')rankPosition - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#latitude',values); - latitude(:,i)=values - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#longitude',values); - longitude(:,i)=values + rankPosition = rankPosition + 1 + write (rankPositionStr, '(I0)') rankPosition + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#latitude', values); + latitude(:, i) = values + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#longitude', values); + longitude(:, i) = values - if (significance==1) then - rankPressure=rankPressure+1 - write (rankPressureStr,'(I0)')rankPressure - call codes_get(ibufr,'#'//trim(rankPressureStr)//'#pressureReducedToMeanSeaLevel',values); - pressure(:,i)=values + if (significance == 1) then + rankPressure = rankPressure + 1 + write (rankPressureStr, '(I0)') rankPressure + call codes_get(ibufr, '#'//trim(rankPressureStr)//'#pressureReducedToMeanSeaLevel', values); + pressure(:, i) = values else - print *,'ERROR: unexpected meteorologicalAttributeSignificance=',significance + print *, 'ERROR: unexpected meteorologicalAttributeSignificance=', significance stop 1 - endif + end if ! Location of maximum wind - rankSignificance=rankSignificance+1 - write (rankSignificanceStr,'(I0)')rankSignificance - call codes_get(ibufr,'#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance',ivalues); - do k=1,size(ivalues) - if (ivalues(k)/=CODES_MISSING_LONG) then - significance=ivalues(k) + rankSignificance = rankSignificance + 1 + write (rankSignificanceStr, '(I0)') rankSignificance + call codes_get(ibufr, '#'//trim(rankSignificanceStr)//'#meteorologicalAttributeSignificance', ivalues); + do k = 1, size(ivalues) + if (ivalues(k) /= CODES_MISSING_LONG) then + significance = ivalues(k) exit - endif - enddo - deallocate(ivalues) + end if + end do + deallocate (ivalues) - rankPosition=rankPosition+1 - write (rankPositionStr,'(I0)')rankPosition - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#latitude',values); - latitudeWind(:,i)=values - call codes_get(ibufr,'#'//trim(rankPositionStr)//'#longitude',values); - longitudeWind(:,i)=values + rankPosition = rankPosition + 1 + write (rankPositionStr, '(I0)') rankPosition + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#latitude', values); + latitudeWind(:, i) = values + call codes_get(ibufr, '#'//trim(rankPositionStr)//'#longitude', values); + longitudeWind(:, i) = values - if (significance==3) then - rankWind=rankWind+1 - write (rankWindStr,'(I0)')rankWind - call codes_get(ibufr,'#'//trim(rankWindStr)//'#windSpeedAt10M',values); - wind(:,i)=values + if (significance == 3) then + rankWind = rankWind + 1 + write (rankWindStr, '(I0)') rankWind + call codes_get(ibufr, '#'//trim(rankWindStr)//'#windSpeedAt10M', values); + wind(:, i) = values else - print *,'ERROR: unexpected meteorologicalAttributeSignificance=,',significance + print *, 'ERROR: unexpected meteorologicalAttributeSignificance=,', significance stop 1 - endif + end if - enddo + end do ! Print the values - do i=1,size(memberNumber) - skipMember=1 - do j=1,size(period) - if (latitude(i,j)/=CODES_MISSING_DOUBLE .OR. latitudeWind(i,j)/=CODES_MISSING_DOUBLE) then - skipMember=0 + do i = 1, size(memberNumber) + skipMember = 1 + do j = 1, size(period) + if (latitude(i, j) /= CODES_MISSING_DOUBLE .OR. latitudeWind(i, j) /= CODES_MISSING_DOUBLE) then + skipMember = 0 exit - endif - enddo - if (skipMember/=1) then + end if + end do + if (skipMember /= 1) then - write(*,'(A,I3)') '== Member ',memberNumber(i) - write(*,*) 'step latitude longitude pressure latitude longitude wind' - do j=1,size(period) - if (latitude(i,j)/=CODES_MISSING_DOUBLE .OR. latitudeWind(i,j)/=CODES_MISSING_DOUBLE) then - write(*,'( I4,2X,F8.2,4X,F8.2,3X,F9.1,2X,F8.2,4X,F8.2,2X,F8.2)') period(j),latitude(i,j),longitude(i,j),pressure(i,j),& - &latitudeWind(i,j),longitudeWind(i,j),wind(i,j) - endif - enddo + write (*, '(A,I3)') '== Member ', memberNumber(i) + write (*, *) 'step latitude longitude pressure latitude longitude wind' + do j = 1, size(period) + if (latitude(i, j) /= CODES_MISSING_DOUBLE .OR. latitudeWind(i, j) /= CODES_MISSING_DOUBLE) then + write (*, '( I4,2X,F8.2,4X,F8.2,3X,F9.1,2X,F8.2,4X,F8.2,2X,F8.2)') & + period(j), latitude(i, j), longitude(i, j), pressure(i, j), & + latitudeWind(i, j), longitudeWind(i, j), wind(i, j) + end if + end do - endif - enddo + end if + end do ! deallocating the arrays is very important ! because the behaviour of the codes_get functions is as follows: ! if the array is not allocated then allocate ! if the array is already allocated only copy the values - deallocate(values) - deallocate(latitude) - deallocate(longitude) - deallocate(pressure) - deallocate(latitudeWind) - deallocate(longitudeWind) - deallocate(wind) - deallocate(period) - deallocate(latitudeAnalysis) - deallocate(longitudeAnalysis) - deallocate(pressureAnalysis) - deallocate(memberNumber) - deallocate(latitudeMaxWind0) - deallocate(longitudeMaxWind0) - deallocate(windMaxWind0) + deallocate (values) + deallocate (latitude) + deallocate (longitude) + deallocate (pressure) + deallocate (latitudeWind) + deallocate (longitudeWind) + deallocate (wind) + deallocate (period) + deallocate (latitudeAnalysis) + deallocate (longitudeAnalysis) + deallocate (pressureAnalysis) + deallocate (memberNumber) + deallocate (latitudeMaxWind0) + deallocate (longitudeMaxWind0) + deallocate (windMaxWind0) ! Release the BUFR message call codes_release(ibufr) ! Load the next BUFR message - call codes_bufr_new_from_file(ifile,ibufr,iret) + call codes_bufr_new_from_file(ifile, ibufr, iret) - count=count+1 + count = count + 1 end do diff --git a/examples/F90/bufr_set_keys.f90 b/examples/F90/bufr_set_keys.f90 index a3cc6ac2d..a51e76734 100644 --- a/examples/F90/bufr_set_keys.f90 +++ b/examples/F90/bufr_set_keys.f90 @@ -12,55 +12,55 @@ ! ! program bufr_set_keys - use eccodes - implicit none - integer :: iret - integer :: infile,outfile - integer :: ibufr - integer :: count=0 - integer(kind=4) :: centre, centreNew + use eccodes + implicit none + integer :: iret + integer :: infile, outfile + integer :: ibufr + integer :: count = 0 + integer(kind=4) :: centre, centreNew - ! Open input file - call codes_open_file(infile,'../../data/bufr/syno_multi.bufr','r') + ! Open input file + call codes_open_file(infile, '../../data/bufr/syno_multi.bufr', 'r') - ! Open output file - call codes_open_file(outfile,'bufr_set_keys_test_f.tmp.bufr','w') + ! Open output file + call codes_open_file(outfile, 'bufr_set_keys_test_f.tmp.bufr', 'w') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(infile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(infile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! This is the place where you may wish to modify the message - ! E.g. we change the centre + ! This is the place where you may wish to modify the message + ! E.g. we change the centre - ! Set centre - centre=222 - call codes_set(ibufr,'bufrHeaderCentre',222) - write(*,*) ' set bufrHeaderCentre to:',centre + ! Set centre + centre = 222 + call codes_set(ibufr, 'bufrHeaderCentre', 222) + write (*, *) ' set bufrHeaderCentre to:', centre - ! Check centre's new value - centreNew=0 - call codes_get(ibufr,'bufrHeaderCentre',centreNew) - write(*,*) ' bufrHeaderCentre''s new value:',centreNew + ! Check centre's new value + centreNew = 0 + call codes_get(ibufr, 'bufrHeaderCentre', centreNew) + write (*, *) ' bufrHeaderCentre''s new value:', centreNew - ! Write modified message to a file - call codes_write(ibufr,outfile) + ! Write modified message to a file + call codes_write(ibufr, outfile) - ! Release the handle - call codes_release(ibufr) + ! Release the handle + call codes_release(ibufr) - ! Next message from source - call codes_bufr_new_from_file(infile,ibufr,iret) + ! Next message from source + call codes_bufr_new_from_file(infile, ibufr, iret) - count=count+1 + count = count + 1 - end do + end do - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) end program bufr_set_keys diff --git a/examples/F90/bufr_subset.f90 b/examples/F90/bufr_subset.f90 index d23008fc7..591ffb493 100644 --- a/examples/F90/bufr_subset.f90 +++ b/examples/F90/bufr_subset.f90 @@ -13,66 +13,65 @@ ! ! program bufr_subset -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: ibufr -integer :: i, count=0 -integer(kind=4) :: numberOfSubsets -integer(kind=4) :: blockNumber,stationNumber -character(100) :: key + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ibufr + integer :: i, count = 0 + integer(kind=4) :: numberOfSubsets + integer(kind=4) :: blockNumber, stationNumber + character(100) :: key !real(kind=8) :: t2m - call codes_open_file(ifile,'../../data/bufr/synop_multi_subset.bufr','r') + call codes_open_file(ifile, '../../data/bufr/synop_multi_subset.bufr', 'r') - ! The first bufr message is loaded from file, - ! ibufr is the bufr id to be used in subsequent calls - call codes_bufr_new_from_file(ifile,ibufr,iret) + ! The first bufr message is loaded from file, + ! ibufr is the bufr id to be used in subsequent calls + call codes_bufr_new_from_file(ifile, ibufr, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - ! Get and print some keys form the BUFR header - write(*,*) 'message: ',count + ! Get and print some keys form the BUFR header + write (*, *) 'message: ', count - ! We need to instruct ecCodes to expand all the descriptors - ! i.e. unpack the data values - call codes_set(ibufr,'unpack',1); + ! We need to instruct ecCodes to expand all the descriptors + ! i.e. unpack the data values + call codes_set(ibufr, 'unpack', 1); + ! Find out the number of subsets + call codes_get(ibufr, 'numberOfSubsets', numberOfSubsets) + write (*, *) ' numberOfSubsets:', numberOfSubsets - ! Find out the number of subsets - call codes_get(ibufr,'numberOfSubsets',numberOfSubsets) - write(*,*) ' numberOfSubsets:',numberOfSubsets + ! Loop over the subsets + do i = 1, numberOfSubsets - ! Loop over the subsets - do i=1,numberOfSubsets +100 format('/subsetNumber=', I5.5, '/blockNumber') + write (key, 100) I + write (*, *) key - 100 format('/subsetNumber=',I5.5,'/blockNumber') - write(key,100) I - write(*,*) key + write (*, *) ' subsetNumber:', i + ! read and print some data values - write(*,*) ' subsetNumber:',i - ! read and print some data values + call codes_get(ibufr, key, blockNumber); + write (*, *) ' blockNumber:', blockNumber - call codes_get(ibufr,key,blockNumber); - write(*,*) ' blockNumber:',blockNumber + write (key, *) '/subsetNumber=', I, '/stationNumber' + call codes_get(ibufr, 'stationNumber', stationNumber); + write (*, *) ' stationNumber:', stationNumber - write(key,*) '/subsetNumber=',I,'/stationNumber' - call codes_get(ibufr,'stationNumber',stationNumber); - write(*,*) ' stationNumber:',stationNumber + end do - end do + ! Release the bufr message + call codes_release(ibufr) - ! Release the bufr message - call codes_release(ibufr) + ! Load the next bufr message + call codes_bufr_new_from_file(ifile, ibufr, iret) - ! Load the next bufr message - call codes_bufr_new_from_file(ifile,ibufr,iret) + count = count + 1 - count=count+1 + end do - end do - - ! Close file - call codes_close_file(ifile) + ! Close file + call codes_close_file(ifile) end program bufr_subset diff --git a/examples/F90/get_fortran.f90 b/examples/F90/get_fortran.f90 index 6a9e53a51..4a1dd27e2 100644 --- a/examples/F90/get_fortran.f90 +++ b/examples/F90/get_fortran.f90 @@ -10,108 +10,108 @@ ! ! program get -use eccodes -implicit none + use eccodes + implicit none - integer :: ifile - integer :: iret - integer :: igrib - integer :: i - real(kind=8) :: latitudeOfFirstPointInDegrees - real(kind=8) :: longitudeOfFirstPointInDegrees - real(kind=8) :: latitudeOfLastPointInDegrees - real(kind=8) :: longitudeOfLastPointInDegrees - real(kind=8) :: jDirectionIncrementInDegrees - real(kind=8) :: iDirectionIncrementInDegrees - integer(kind = 4) :: numberOfPointsAlongAParallel - integer(kind = 4) :: numberOfPointsAlongAMeridian - real(kind=8), dimension(:), allocatable :: values - integer(kind = 4) :: numberOfValues - real(kind=8) :: average + integer :: ifile + integer :: iret + integer :: igrib + integer :: i + real(kind=8) :: latitudeOfFirstPointInDegrees + real(kind=8) :: longitudeOfFirstPointInDegrees + real(kind=8) :: latitudeOfLastPointInDegrees + real(kind=8) :: longitudeOfLastPointInDegrees + real(kind=8) :: jDirectionIncrementInDegrees + real(kind=8) :: iDirectionIncrementInDegrees + integer(kind=4) :: numberOfPointsAlongAParallel + integer(kind=4) :: numberOfPointsAlongAMeridian + real(kind=8), dimension(:), allocatable :: values + integer(kind=4) :: numberOfValues + real(kind=8) :: average - call codes_open_file(ifile, & - '../../data/reduced_latlon_surface.grib1','r') + call codes_open_file(ifile, & + '../../data/reduced_latlon_surface.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib) - ! get as a integer - call codes_get(igrib,'numberOfPointsAlongAParallel', & - numberOfPointsAlongAParallel) - write(*,*) 'numberOfPointsAlongAParallel=', & - numberOfPointsAlongAParallel + ! get as a integer + call codes_get(igrib, 'numberOfPointsAlongAParallel', & + numberOfPointsAlongAParallel) + write (*, *) 'numberOfPointsAlongAParallel=', & + numberOfPointsAlongAParallel - ! get as a integer - call codes_get(igrib,'numberOfPointsAlongAMeridian', & - numberOfPointsAlongAMeridian) - write(*,*) 'numberOfPointsAlongAMeridian=', & - numberOfPointsAlongAMeridian + ! get as a integer + call codes_get(igrib, 'numberOfPointsAlongAMeridian', & + numberOfPointsAlongAMeridian) + write (*, *) 'numberOfPointsAlongAMeridian=', & + numberOfPointsAlongAMeridian - ! get as a real8 - call codes_get(igrib, & - 'latitudeOfFirstGridPointInDegrees', & - latitudeOfFirstPointInDegrees) - write(*,*) 'latitudeOfFirstGridPointInDegrees=', & - latitudeOfFirstPointInDegrees + ! get as a real8 + call codes_get(igrib, & + 'latitudeOfFirstGridPointInDegrees', & + latitudeOfFirstPointInDegrees) + write (*, *) 'latitudeOfFirstGridPointInDegrees=', & + latitudeOfFirstPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'longitudeOfFirstGridPointInDegrees', & - longitudeOfFirstPointInDegrees) - write(*,*) 'longitudeOfFirstGridPointInDegrees=', & + ! get as a real8 + call codes_get(igrib, & + 'longitudeOfFirstGridPointInDegrees', & + longitudeOfFirstPointInDegrees) + write (*, *) 'longitudeOfFirstGridPointInDegrees=', & longitudeOfFirstPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'latitudeOfLastGridPointInDegrees', & - latitudeOfLastPointInDegrees) - write(*,*) 'latitudeOfLastGridPointInDegrees=', & + ! get as a real8 + call codes_get(igrib, & + 'latitudeOfLastGridPointInDegrees', & + latitudeOfLastPointInDegrees) + write (*, *) 'latitudeOfLastGridPointInDegrees=', & latitudeOfLastPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'longitudeOfLastGridPointInDegrees', & - longitudeOfLastPointInDegrees) - write(*,*) 'longitudeOfLastGridPointInDegrees=', & - longitudeOfLastPointInDegrees + ! get as a real8 + call codes_get(igrib, & + 'longitudeOfLastGridPointInDegrees', & + longitudeOfLastPointInDegrees) + write (*, *) 'longitudeOfLastGridPointInDegrees=', & + longitudeOfLastPointInDegrees - ! get as a real8 - call codes_get(igrib, & - 'jDirectionIncrementInDegrees', & - jDirectionIncrementInDegrees) - write(*,*) 'jDirectionIncrementInDegrees=', & - jDirectionIncrementInDegrees + ! get as a real8 + call codes_get(igrib, & + 'jDirectionIncrementInDegrees', & + jDirectionIncrementInDegrees) + write (*, *) 'jDirectionIncrementInDegrees=', & + jDirectionIncrementInDegrees - ! get as a real8 - call codes_get(igrib, & - 'iDirectionIncrementInDegrees', & - iDirectionIncrementInDegrees) - write(*,*) 'iDirectionIncrementInDegrees=', & - iDirectionIncrementInDegrees + ! get as a real8 + call codes_get(igrib, & + 'iDirectionIncrementInDegrees', & + iDirectionIncrementInDegrees) + write (*, *) 'iDirectionIncrementInDegrees=', & + iDirectionIncrementInDegrees - ! get the size of the values array - call codes_get_size(igrib,'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + ! get the size of the values array + call codes_get_size(igrib, 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - allocate(values(2*numberOfValues), stat=iret) - ! get data values - print*, size(values) - call codes_get(igrib,'values',values) + allocate (values(2*numberOfValues), stat=iret) + ! get data values + print *, size(values) + call codes_get(igrib, 'values', values) - average = 0 - do i=1,numberOfValues - average = average + values(i); - enddo + average = 0 + do i = 1, numberOfValues + average = average + values(i); + end do - average =average / numberOfValues + average = average/numberOfValues - write(*,*)'There are ',numberOfValues, & - ' average is ',average + write (*, *) 'There are ', numberOfValues, & + ' average is ', average - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(ifile) + call codes_close_file(ifile) - deallocate(values) + deallocate (values) end program get diff --git a/examples/F90/get_product_kind.f90 b/examples/F90/get_product_kind.f90 index f04dd0edb..7907b8a6b 100644 --- a/examples/F90/get_product_kind.f90 +++ b/examples/F90/get_product_kind.f90 @@ -13,54 +13,54 @@ ! and print the kind of product (e.g. GRIB, BUFR etc) ! program get_product_kind - use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: ihandle - integer :: count=0 - integer :: version=0 - character(len=32) :: product_kind - character(len=120) :: infile_name + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: ihandle + integer :: count = 0 + integer :: version = 0 + character(len=32) :: product_kind + character(len=120) :: infile_name - call getarg(1, infile_name) - write(*,*) 'infile_name|',infile_name,'|' - call codes_open_file(ifile,infile_name,'r') + call getarg(1, infile_name) + write (*, *) 'infile_name|', infile_name, '|' + call codes_open_file(ifile, infile_name, 'r') - call codes_get_api_version(version) - write(*,*) 'API version: ',version + call codes_get_api_version(version) + write (*, *) 'API version: ', version - write(*,*) 'ecCodes settings: ' - write(*,*) ' ECCODES_POSIX_THREADS: ',ECCODES_SETTINGS_POSIX_THREADS - write(*,*) ' ECCODES_OMP_THREADS: ',ECCODES_SETTINGS_OMP_THREADS - write(*,*) ' ECCODES_SETTINGS_MEMFS: ',ECCODES_SETTINGS_MEMFS - write(*,*) ' ECCODES_SETTINGS_JPEG: ',ECCODES_SETTINGS_JPEG - write(*,*) ' ECCODES_SETTINGS_PNG: ',ECCODES_SETTINGS_PNG - write(*,*) ' ECCODES_SETTINGS_AEC: ',ECCODES_SETTINGS_AEC + write (*, *) 'ecCodes settings: ' + write (*, *) ' ECCODES_POSIX_THREADS: ', ECCODES_SETTINGS_POSIX_THREADS + write (*, *) ' ECCODES_OMP_THREADS: ', ECCODES_SETTINGS_OMP_THREADS + write (*, *) ' ECCODES_SETTINGS_MEMFS: ', ECCODES_SETTINGS_MEMFS + write (*, *) ' ECCODES_SETTINGS_JPEG: ', ECCODES_SETTINGS_JPEG + write (*, *) ' ECCODES_SETTINGS_PNG: ', ECCODES_SETTINGS_PNG + write (*, *) ' ECCODES_SETTINGS_AEC: ', ECCODES_SETTINGS_AEC ! the first message is loaded from file ! ihandle is the message id to be used in subsequent calls - call codes_new_from_file(ifile,ihandle,CODES_PRODUCT_ANY,iret) + call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) - write(*,*) 'message: ',count + write (*, *) 'message: ', count - ! get the product kind - call codes_get(ihandle,'kindOfProduct',product_kind) - write(*,*) ' product: ',product_kind + ! get the product kind + call codes_get(ihandle, 'kindOfProduct', product_kind) + write (*, *) ' product: ', product_kind - ! release the message - call codes_release(ihandle) + ! release the message + call codes_release(ihandle) - ! load the next message - call codes_new_from_file(ifile,ihandle,CODES_PRODUCT_ANY,iret) + ! load the next message + call codes_new_from_file(ifile, ihandle, CODES_PRODUCT_ANY, iret) - count=count+1 + count = count + 1 - end do + end do - ! close file - call codes_close_file(ifile) + ! close file + call codes_close_file(ifile) end program get_product_kind diff --git a/examples/F90/grib_clone.f90 b/examples/F90/grib_clone.f90 index cb69e5935..7019a5156 100644 --- a/examples/F90/grib_clone.f90 +++ b/examples/F90/grib_clone.f90 @@ -14,62 +14,62 @@ ! ! program clone - use eccodes - implicit none - integer :: err,i - integer :: nx, ny - integer :: infile,outfile - integer :: igrib_in - integer :: igrib_out - character(len=2) :: step - real(kind=8), dimension(:,:), allocatable :: field2D + use eccodes + implicit none + integer :: err, i + integer :: nx, ny + integer :: infile, outfile + integer :: igrib_in + integer :: igrib_out + character(len=2) :: step + real(kind=8), dimension(:, :), allocatable :: field2D - call codes_open_file(infile,'../../data/constant_field.grib1','r') - call codes_open_file(outfile,'out.clone.grib1','w') + call codes_open_file(infile, '../../data/constant_field.grib1', 'r') + call codes_open_file(outfile, 'out.clone.grib1', 'w') - ! A new GRIB message is loaded from file. - ! igrib is the GRIB id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib_in) + ! A new GRIB message is loaded from file. + ! igrib is the GRIB id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib_in) - call codes_get(igrib_in,'Ni', nx) - call codes_get(igrib_in,'Nj', ny) + call codes_get(igrib_in, 'Ni', nx) + call codes_get(igrib_in, 'Nj', ny) - allocate(field2D(nx,ny),stat=err) + allocate (field2D(nx, ny), stat=err) - if (err .ne. 0) then - print*, 'Failed to allocate ', nx*ny, ' values' - STOP - end if - ! clone the constant field to create 4 new GRIB messages - do i=0,18,6 - call codes_clone(igrib_in, igrib_out) - write(step,'(i2)') i - ! Careful: stepRange is a string (could be 0-6, 12-24, etc.) - ! use adjustl to remove blank from the left. - call codes_set(igrib_out,'stepRange',adjustl(step)) + if (err .ne. 0) then + print *, 'Failed to allocate ', nx*ny, ' values' + STOP + end if + ! clone the constant field to create 4 new GRIB messages + do i = 0, 18, 6 + call codes_clone(igrib_in, igrib_out) + write (step, '(i2)') i + ! Careful: stepRange is a string (could be 0-6, 12-24, etc.) + ! use adjustl to remove blank from the left. + call codes_set(igrib_out, 'stepRange', adjustl(step)) - call generate_field(field2D) + call generate_field(field2D) - ! use pack to create 1D values - call codes_set(igrib_out,'values',pack(field2D, mask=.true.)) + ! use pack to create 1D values + call codes_set(igrib_out, 'values', pack(field2D, mask=.true.)) - ! write cloned messages to a file - call codes_write(igrib_out,outfile) - call codes_release(igrib_out) - end do + ! write cloned messages to a file + call codes_write(igrib_out, outfile) + call codes_release(igrib_out) + end do - call codes_release(igrib_in) - call codes_close_file(infile) - call codes_close_file(outfile) - deallocate(field2D) + call codes_release(igrib_in) + call codes_close_file(infile) + call codes_close_file(outfile) + deallocate (field2D) contains !====================================== -subroutine generate_field(gfield2D) - real(kind=8), dimension(:,:) :: gfield2D + subroutine generate_field(gfield2D) + real(kind=8), dimension(:, :) :: gfield2D - call random_number(gfield2D) -end subroutine generate_field + call random_number(gfield2D) + end subroutine generate_field !====================================== end program clone diff --git a/examples/F90/grib_copy_message.f90 b/examples/F90/grib_copy_message.f90 index 2b7d23035..2abd4a470 100644 --- a/examples/F90/grib_copy_message.f90 +++ b/examples/F90/grib_copy_message.f90 @@ -13,44 +13,43 @@ ! ! program copy - use eccodes - implicit none - integer :: err, centre - integer(kind=kindOfSize) :: byte_size - integer :: infile,outfile - integer :: igrib_in - integer :: igrib_out - character(len=1), dimension(:), allocatable :: message - character(len=32) :: product_kind + use eccodes + implicit none + integer :: err, centre + integer(kind=kindOfSize) :: byte_size + integer :: infile, outfile + integer :: igrib_in + integer :: igrib_out + character(len=1), dimension(:), allocatable :: message + character(len=32) :: product_kind + call codes_open_file(infile, '../../data/constant_field.grib1', 'r') + call codes_open_file(outfile, 'out.copy.grib1', 'w') - call codes_open_file(infile,'../../data/constant_field.grib1','r') - call codes_open_file(outfile,'out.copy.grib1','w') + ! A new GRIB message is loaded from file + ! igrib_in is the GRIB id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib_in) - ! A new GRIB message is loaded from file - ! igrib_in is the GRIB id to be used in subsequent calls - call codes_grib_new_from_file(infile, igrib_in) + call codes_get_message_size(igrib_in, byte_size) + allocate (message(byte_size), stat=err) - call codes_get_message_size(igrib_in, byte_size) - allocate(message(byte_size), stat=err) + call codes_copy_message(igrib_in, message) - call codes_copy_message(igrib_in, message) + call codes_new_from_message(igrib_out, message) - call codes_new_from_message(igrib_out, message) + call codes_get(igrib_out, 'kindOfProduct', product_kind) + write (*, *) 'kindOfProduct=', product_kind - call codes_get(igrib_out, 'kindOfProduct', product_kind) - write(*,*) 'kindOfProduct=',product_kind + centre = 80 + call codes_set(igrib_out, 'centre', centre) - centre=80 - call codes_set(igrib_out, 'centre', centre) + ! Write message to a file + call codes_write(igrib_out, outfile) - ! Write message to a file - call codes_write(igrib_out, outfile) - - call codes_release(igrib_out) - call codes_release(igrib_in) - call codes_close_file(infile) - call codes_close_file(outfile) - deallocate(message) + call codes_release(igrib_out) + call codes_release(igrib_in) + call codes_close_file(infile) + call codes_close_file(outfile) + deallocate (message) end program copy diff --git a/examples/F90/grib_copy_namespace.f90 b/examples/F90/grib_copy_namespace.f90 index 440f22dcd..854281f8a 100644 --- a/examples/F90/grib_copy_namespace.f90 +++ b/examples/F90/grib_copy_namespace.f90 @@ -11,26 +11,26 @@ ! ! program copy_namespace - use eccodes - implicit none - integer :: file1, file2, file3 - integer :: igrib1,igrib2,igrib3 + use eccodes + implicit none + integer :: file1, file2, file3 + integer :: igrib1, igrib2, igrib3 - call codes_open_file(file1, '../../data/reduced_latlon_surface.grib2', 'r') - call codes_open_file(file2, '../../data/regular_latlon_surface.grib1', 'r') - call codes_open_file(file3, 'out.grib_copy_namespace.grib','w') + call codes_open_file(file1, '../../data/reduced_latlon_surface.grib2', 'r') + call codes_open_file(file2, '../../data/regular_latlon_surface.grib1', 'r') + call codes_open_file(file3, 'out.grib_copy_namespace.grib', 'w') - call codes_grib_new_from_file(file1, igrib1) - call codes_grib_new_from_file(file2, igrib2) + call codes_grib_new_from_file(file1, igrib1) + call codes_grib_new_from_file(file2, igrib2) - call codes_clone(igrib2, igrib3) + call codes_clone(igrib2, igrib3) - call codes_copy_namespace(igrib1, 'geography', igrib3) + call codes_copy_namespace(igrib1, 'geography', igrib3) call codes_write(igrib3, file3) - call codes_close_file(file1) - call codes_close_file(file2) - call codes_close_file(file3) + call codes_close_file(file1) + call codes_close_file(file2) + call codes_close_file(file3) end program copy_namespace diff --git a/examples/F90/grib_count_messages.f90 b/examples/F90/grib_count_messages.f90 index de63eba57..fddaac45a 100644 --- a/examples/F90/grib_count_messages.f90 +++ b/examples/F90/grib_count_messages.f90 @@ -10,101 +10,100 @@ ! ! program get - use eccodes - implicit none + use eccodes + implicit none - integer :: ifile - integer :: iret - integer :: n - integer :: i - integer,dimension(:),allocatable :: igrib - real :: latitudeOfFirstPointInDegrees - real :: longitudeOfFirstPointInDegrees - real :: latitudeOfLastPointInDegrees - real :: longitudeOfLastPointInDegrees - integer :: numberOfPointsAlongAParallel - integer :: numberOfPointsAlongAMeridian - real, dimension(:), allocatable :: values - integer :: numberOfValues - real :: average,min_val, max_val + integer :: ifile + integer :: iret + integer :: n + integer :: i + integer, dimension(:), allocatable :: igrib + real :: latitudeOfFirstPointInDegrees + real :: longitudeOfFirstPointInDegrees + real :: latitudeOfLastPointInDegrees + real :: longitudeOfLastPointInDegrees + integer :: numberOfPointsAlongAParallel + integer :: numberOfPointsAlongAMeridian + real, dimension(:), allocatable :: values + integer :: numberOfValues + real :: average, min_val, max_val - call codes_open_file(ifile, & - '../../data/tigge_pf_ecmwf.grib2','r') + call codes_open_file(ifile, & + '../../data/tigge_pf_ecmwf.grib2', 'r') - ! count the messages in the file - call codes_count_in_file(ifile,n) - allocate(igrib(n)) - igrib=-1 + ! count the messages in the file + call codes_count_in_file(ifile, n) + allocate (igrib(n)) + igrib = -1 - ! Load the messages from the file. - DO i=1,n - call codes_grib_new_from_file(ifile,igrib(i), iret) - END DO + ! Load the messages from the file. + DO i = 1, n + call codes_grib_new_from_file(ifile, igrib(i), iret) + END DO - ! we can close the file - call codes_close_file(ifile) + ! we can close the file + call codes_close_file(ifile) - ! Loop on all the messages in memory - DO i=1,n - write(*,*) 'processing message number ',i - ! get as a integer - call codes_get(igrib(i),'Ni',numberOfPointsAlongAParallel) - write(*,*) 'numberOfPointsAlongAParallel=', & - numberOfPointsAlongAParallel + ! Loop on all the messages in memory + DO i = 1, n + write (*, *) 'processing message number ', i + ! get as a integer + call codes_get(igrib(i), 'Ni', numberOfPointsAlongAParallel) + write (*, *) 'numberOfPointsAlongAParallel=', & + numberOfPointsAlongAParallel - ! get as a integer - call codes_get(igrib(i),'Nj',numberOfPointsAlongAMeridian) - write(*,*) 'numberOfPointsAlongAMeridian=', & - numberOfPointsAlongAMeridian + ! get as a integer + call codes_get(igrib(i), 'Nj', numberOfPointsAlongAMeridian) + write (*, *) 'numberOfPointsAlongAMeridian=', & + numberOfPointsAlongAMeridian - ! get as a real - call codes_get(igrib(i), 'latitudeOfFirstGridPointInDegrees', & - latitudeOfFirstPointInDegrees) - write(*,*) 'latitudeOfFirstGridPointInDegrees=', & - latitudeOfFirstPointInDegrees + ! get as a real + call codes_get(igrib(i), 'latitudeOfFirstGridPointInDegrees', & + latitudeOfFirstPointInDegrees) + write (*, *) 'latitudeOfFirstGridPointInDegrees=', & + latitudeOfFirstPointInDegrees - ! get as a real - call codes_get(igrib(i), 'longitudeOfFirstGridPointInDegrees', & - longitudeOfFirstPointInDegrees) - write(*,*) 'longitudeOfFirstGridPointInDegrees=', & + ! get as a real + call codes_get(igrib(i), 'longitudeOfFirstGridPointInDegrees', & + longitudeOfFirstPointInDegrees) + write (*, *) 'longitudeOfFirstGridPointInDegrees=', & longitudeOfFirstPointInDegrees - ! get as a real - call codes_get(igrib(i), 'latitudeOfLastGridPointInDegrees', & - latitudeOfLastPointInDegrees) - write(*,*) 'latitudeOfLastGridPointInDegrees=', & + ! get as a real + call codes_get(igrib(i), 'latitudeOfLastGridPointInDegrees', & + latitudeOfLastPointInDegrees) + write (*, *) 'latitudeOfLastGridPointInDegrees=', & latitudeOfLastPointInDegrees - ! get as a real - call codes_get(igrib(i), 'longitudeOfLastGridPointInDegrees', & - longitudeOfLastPointInDegrees) - write(*,*) 'longitudeOfLastGridPointInDegrees=', & + ! get as a real + call codes_get(igrib(i), 'longitudeOfLastGridPointInDegrees', & + longitudeOfLastPointInDegrees) + write (*, *) 'longitudeOfLastGridPointInDegrees=', & longitudeOfLastPointInDegrees + ! get the size of the values array + call codes_get_size(igrib(i), 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - ! get the size of the values array - call codes_get_size(igrib(i),'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + allocate (values(numberOfValues), stat=iret) + ! get data values + call codes_get(igrib(i), 'values', values) + call codes_get(igrib(i), 'min', min_val) ! can also be obtained through minval(values) + call codes_get(igrib(i), 'max', max_val) ! can also be obtained through maxval(values) + call codes_get(igrib(i), 'average', average) ! can also be obtained through maxval(values) - allocate(values(numberOfValues), stat=iret) - ! get data values - call codes_get(igrib(i),'values',values) - call codes_get(igrib(i),'min',min_val) ! can also be obtained through minval(values) - call codes_get(igrib(i),'max',max_val) ! can also be obtained through maxval(values) - call codes_get(igrib(i),'average',average) ! can also be obtained through maxval(values) + write (*, *) 'There are ', numberOfValues, & + ' average is ', average, & + ' min is ', min_val, & + ' max is ', max_val + write (*, *) '---------------------' + deallocate (values) + END DO - write(*,*)'There are ',numberOfValues, & - ' average is ',average, & - ' min is ', min_val, & - ' max is ', max_val - write(*,*) '---------------------' - deallocate(values) - END DO + DO i = 1, n + call codes_release(igrib(i)) + END DO - DO i=1,n - call codes_release(igrib(i)) - END DO - - deallocate(igrib) + deallocate (igrib) end program get diff --git a/examples/F90/grib_count_messages_multi.f90 b/examples/F90/grib_count_messages_multi.f90 index 75b6668fb..7f1244780 100644 --- a/examples/F90/grib_count_messages_multi.f90 +++ b/examples/F90/grib_count_messages_multi.f90 @@ -10,25 +10,25 @@ ! ! program grib_count_messages_multi - use eccodes - implicit none + use eccodes + implicit none - integer :: ifile - character(len=100) :: grib_file - integer :: n,stat - character(len=1) :: multi_flag + integer :: ifile + character(len=100) :: grib_file + integer :: n, stat + character(len=1) :: multi_flag - call getarg(1,multi_flag) - call getarg(2,grib_file) + call getarg(1, multi_flag) + call getarg(2, grib_file) - if (multi_flag/="0") call codes_grib_multi_support_on() + if (multi_flag /= "0") call codes_grib_multi_support_on() - call codes_open_file(ifile,grib_file,'r') + call codes_open_file(ifile, grib_file, 'r') - ! count the messages in the file - call codes_count_in_file(ifile,n,stat) + ! count the messages in the file + call codes_count_in_file(ifile, n, stat) - print *,n + print *, n - call codes_close_file(ifile) + call codes_close_file(ifile) end program grib_count_messages_multi diff --git a/examples/F90/grib_ecc-671.f90 b/examples/F90/grib_ecc-671.f90 index 31d5aad80..4dc714a27 100644 --- a/examples/F90/grib_ecc-671.f90 +++ b/examples/F90/grib_ecc-671.f90 @@ -11,23 +11,23 @@ ! USE eccodes - INTEGER :: IGRIBH - CHARACTER (LEN=17) :: CLNOMA1, CLNOMA2 +INTEGER :: IGRIBH +CHARACTER(LEN=17) :: CLNOMA1, CLNOMA2 - CALL codes_grib_new_from_samples(IGRIBH, "regular_ll_sfc_grib2") +CALL codes_grib_new_from_samples(IGRIBH, "regular_ll_sfc_grib2") - ! set centre to MeteoFrance and use their local definition - CALL codes_set (IGRIBH, 'centre', 85) - CALL codes_set (IGRIBH, 'grib2LocalSectionPresent', 1) - CALL codes_set (IGRIBH, 'grib2LocalSectionNumber', 1) +! set centre to MeteoFrance and use their local definition +CALL codes_set(IGRIBH, 'centre', 85) +CALL codes_set(IGRIBH, 'grib2LocalSectionPresent', 1) +CALL codes_set(IGRIBH, 'grib2LocalSectionNumber', 1) - CLNOMA1 = 'SUNSHI. DURATION' - CALL codes_set_string(IGRIBH, 'CLNOMA', CLNOMA1) - CALL codes_get_string(IGRIBH, 'CLNOMA', CLNOMA2) +CLNOMA1 = 'SUNSHI. DURATION' +CALL codes_set_string(IGRIBH, 'CLNOMA', CLNOMA1) +CALL codes_get_string(IGRIBH, 'CLNOMA', CLNOMA2) - PRINT *, " CLNOMA1 = ", CLNOMA1 - PRINT *, " CLNOMA2 = ", CLNOMA2 +PRINT *, " CLNOMA1 = ", CLNOMA1 +PRINT *, " CLNOMA2 = ", CLNOMA2 - IF (CLNOMA1 /= CLNOMA2) STOP 1 +IF (CLNOMA1 /= CLNOMA2) STOP 1 END diff --git a/examples/F90/grib_get_data.f90 b/examples/F90/grib_get_data.f90 index 315c0fd05..44047bd67 100644 --- a/examples/F90/grib_get_data.f90 +++ b/examples/F90/grib_get_data.f90 @@ -11,71 +11,71 @@ ! ! program get_data -use eccodes -implicit none - integer :: ifile - integer :: iret,i - real(kind=8),dimension(:),allocatable :: lats,lons,values - integer,dimension(:),allocatable :: bitmap - integer(4) :: numberOfPoints - logical :: is_missing_value - integer :: count1=0, count2=0, bitmapPresent=0, bmp_len=0 + use eccodes + implicit none + integer :: ifile + integer :: iret, i + real(kind=8), dimension(:), allocatable :: lats, lons, values + integer, dimension(:), allocatable :: bitmap + integer(4) :: numberOfPoints + logical :: is_missing_value + integer :: count1 = 0, count2 = 0, bitmapPresent = 0, bmp_len = 0 - ! Message identifier. - integer :: igrib + ! Message identifier. + integer :: igrib - ifile=5 + ifile = 5 - call codes_open_file(ifile, & - '../../data/reduced_latlon_surface.grib1','R') + call codes_open_file(ifile, & + '../../data/reduced_latlon_surface.grib1', 'R') - ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib,iret) + ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) - do while (iret/=CODES_END_OF_FILE) - count1=count1+1 - print *, "===== Message #",count1 - call codes_get(igrib,'numberOfPoints',numberOfPoints) - call codes_get(igrib,'bitmapPresent',bitmapPresent) + do while (iret /= CODES_END_OF_FILE) + count1 = count1 + 1 + print *, "===== Message #", count1 + call codes_get(igrib, 'numberOfPoints', numberOfPoints) + call codes_get(igrib, 'bitmapPresent', bitmapPresent) - allocate(lats(numberOfPoints)) - allocate(lons(numberOfPoints)) - allocate(values(numberOfPoints)) - if (bitmapPresent == 1) then - ! get the bitmap - call codes_get_size(igrib, 'bitmap', bmp_len) - allocate(bitmap(bmp_len)) - call codes_get(igrib,'bitmap', bitmap) - end if - - call codes_grib_get_data(igrib,lats,lons,values) - - do i=1,numberOfPoints - ! Consult bitmap to see if the i'th value is missing - is_missing_value=.false. - if (bitmapPresent == 1 .and. bitmap(i) == 0) then - is_missing_value=.true. + allocate (lats(numberOfPoints)) + allocate (lons(numberOfPoints)) + allocate (values(numberOfPoints)) + if (bitmapPresent == 1) then + ! get the bitmap + call codes_get_size(igrib, 'bitmap', bmp_len) + allocate (bitmap(bmp_len)) + call codes_get(igrib, 'bitmap', bitmap) end if - ! Only print non-missing values - if (.not. is_missing_value) then - print *, lats(i),lons(i),values(i) - count2=count2+1 + + call codes_grib_get_data(igrib, lats, lons, values) + + do i = 1, numberOfPoints + ! Consult bitmap to see if the i'th value is missing + is_missing_value = .false. + if (bitmapPresent == 1 .and. bitmap(i) == 0) then + is_missing_value = .true. + end if + ! Only print non-missing values + if (.not. is_missing_value) then + print *, lats(i), lons(i), values(i) + count2 = count2 + 1 + end if + end do + print *, 'count of non-missing values=', count2 + if (count2 /= 214661) then + call codes_check(-2, 'incorrect number of missing', '') end if - enddo - print *, 'count of non-missing values=',count2 - if (count2 /= 214661) then - call codes_check(-2, 'incorrect number of missing', '') - end if - deallocate(lats) - deallocate(lons) - deallocate(values) + deallocate (lats) + deallocate (lons) + deallocate (values) - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) - end do + end do - call codes_close_file(ifile) + call codes_close_file(ifile) end program diff --git a/examples/F90/grib_get_keys.f90 b/examples/F90/grib_get_keys.f90 index ca1bdb53f..36f87c6af 100644 --- a/examples/F90/grib_get_keys.f90 +++ b/examples/F90/grib_get_keys.f90 @@ -11,100 +11,100 @@ ! ! program grib_get_keys - use eccodes - implicit none + use eccodes + implicit none - integer :: ifile - integer :: iret - integer :: igrib - real :: latitudeOfFirstPointInDegrees - real :: longitudeOfFirstPointInDegrees - real :: latitudeOfLastPointInDegrees - real :: longitudeOfLastPointInDegrees - integer :: numberOfPointsAlongAParallel - integer :: numberOfPointsAlongAMeridian - real, dimension(:), allocatable :: values - integer :: numberOfValues - real :: average,min_val, max_val - integer :: is_missing - character(len=10) :: open_mode='r' + integer :: ifile + integer :: iret + integer :: igrib + real :: latitudeOfFirstPointInDegrees + real :: longitudeOfFirstPointInDegrees + real :: latitudeOfLastPointInDegrees + real :: longitudeOfLastPointInDegrees + integer :: numberOfPointsAlongAParallel + integer :: numberOfPointsAlongAMeridian + real, dimension(:), allocatable :: values + integer :: numberOfValues + real :: average, min_val, max_val + integer :: is_missing + character(len=10) :: open_mode = 'r' - call codes_open_file(ifile, & - '../../data/reduced_latlon_surface.grib1', open_mode) + call codes_open_file(ifile, & + '../../data/reduced_latlon_surface.grib1', open_mode) - ! Loop on all the messages in a file. + ! Loop on all the messages in a file. - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib, iret) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib, iret) - LOOP: DO WHILE (iret /= CODES_END_OF_FILE) + LOOP: DO WHILE (iret /= CODES_END_OF_FILE) - ! Check if the value of the key is MISSING - is_missing=0; - call codes_is_missing(igrib,'Ni',is_missing); - if ( is_missing /= 1 ) then - ! Key value is not missing so get as an integer - call codes_get(igrib,'Ni',numberOfPointsAlongAParallel) - write(*,*) 'numberOfPointsAlongAParallel=', & - numberOfPointsAlongAParallel - else - write(*,*) 'numberOfPointsAlongAParallel is missing' - endif + ! Check if the value of the key is MISSING + is_missing = 0; + call codes_is_missing(igrib, 'Ni', is_missing); + if (is_missing /= 1) then + ! Key value is not missing so get as an integer + call codes_get(igrib, 'Ni', numberOfPointsAlongAParallel) + write (*, *) 'numberOfPointsAlongAParallel=', & + numberOfPointsAlongAParallel + else + write (*, *) 'numberOfPointsAlongAParallel is missing' + end if - ! Get as an integer - call codes_get(igrib,'Nj',numberOfPointsAlongAMeridian) - write(*,*) 'numberOfPointsAlongAMeridian=', & + ! Get as an integer + call codes_get(igrib, 'Nj', numberOfPointsAlongAMeridian) + write (*, *) 'numberOfPointsAlongAMeridian=', & numberOfPointsAlongAMeridian - ! Get as a real - call codes_get(igrib, 'latitudeOfFirstGridPointInDegrees', & - latitudeOfFirstPointInDegrees) - write(*,*) 'latitudeOfFirstGridPointInDegrees=', & - latitudeOfFirstPointInDegrees + ! Get as a real + call codes_get(igrib, 'latitudeOfFirstGridPointInDegrees', & + latitudeOfFirstPointInDegrees) + write (*, *) 'latitudeOfFirstGridPointInDegrees=', & + latitudeOfFirstPointInDegrees - ! Get as a real - call codes_get(igrib, 'longitudeOfFirstGridPointInDegrees', & - longitudeOfFirstPointInDegrees) - write(*,*) 'longitudeOfFirstGridPointInDegrees=', & - longitudeOfFirstPointInDegrees + ! Get as a real + call codes_get(igrib, 'longitudeOfFirstGridPointInDegrees', & + longitudeOfFirstPointInDegrees) + write (*, *) 'longitudeOfFirstGridPointInDegrees=', & + longitudeOfFirstPointInDegrees - ! Get as a real - call codes_get(igrib, 'latitudeOfLastGridPointInDegrees', & - latitudeOfLastPointInDegrees) - write(*,*) 'latitudeOfLastGridPointInDegrees=', & - latitudeOfLastPointInDegrees + ! Get as a real + call codes_get(igrib, 'latitudeOfLastGridPointInDegrees', & + latitudeOfLastPointInDegrees) + write (*, *) 'latitudeOfLastGridPointInDegrees=', & + latitudeOfLastPointInDegrees - ! Get as a real - call codes_get(igrib, 'longitudeOfLastGridPointInDegrees', & - longitudeOfLastPointInDegrees) - write(*,*) 'longitudeOfLastGridPointInDegrees=', & - longitudeOfLastPointInDegrees + ! Get as a real + call codes_get(igrib, 'longitudeOfLastGridPointInDegrees', & + longitudeOfLastPointInDegrees) + write (*, *) 'longitudeOfLastGridPointInDegrees=', & + longitudeOfLastPointInDegrees - ! Get the size of the values array - call codes_get_size(igrib,'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + ! Get the size of the values array + call codes_get_size(igrib, 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - allocate(values(numberOfValues), stat=iret) - ! Get data values - call codes_get(igrib,'values',values) - call codes_get(igrib,'min',min_val) ! can also be obtained through minval(values) - call codes_get(igrib,'max',max_val) ! can also be obtained through maxval(values) - call codes_get(igrib,'average',average) ! can also be obtained through maxval(values) + allocate (values(numberOfValues), stat=iret) + ! Get data values + call codes_get(igrib, 'values', values) + call codes_get(igrib, 'min', min_val) ! can also be obtained through minval(values) + call codes_get(igrib, 'max', max_val) ! can also be obtained through maxval(values) + call codes_get(igrib, 'average', average) ! can also be obtained through maxval(values) - deallocate(values) + deallocate (values) - write(*,*)'There are ',numberOfValues, & - ' average is ',average, & - ' min is ', min_val, & - ' max is ', max_val + write (*, *) 'There are ', numberOfValues, & + ' average is ', average, & + ' min is ', min_val, & + ' max is ', max_val - call codes_release(igrib) + call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_grib_new_from_file(ifile, igrib, iret) - end do LOOP + end do LOOP - call codes_close_file(ifile) + call codes_close_file(ifile) end program grib_get_keys diff --git a/examples/F90/grib_get_pl.f90 b/examples/F90/grib_get_pl.f90 index a13e1752a..f52c2ea9d 100644 --- a/examples/F90/grib_get_pl.f90 +++ b/examples/F90/grib_get_pl.f90 @@ -11,35 +11,35 @@ ! ! program grib_get_pl - use eccodes - implicit none - integer :: infile - integer :: igrib - integer :: PLPresent, nb_pl - real, dimension(:), allocatable :: pl + use eccodes + implicit none + integer :: infile + integer :: igrib + integer :: PLPresent, nb_pl + real, dimension(:), allocatable :: pl - call codes_open_file(infile, & - '../../data/reduced_gaussian_surface.grib1','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_surface.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! get PLPresent to see if the 'pl' array is there - call codes_get(igrib,'PLPresent',PLPresent) - print*, "PLPresent= ", PLPresent - if (PLPresent == 1) then - call codes_get_size(igrib,'pl',nb_pl) - print*, "there are ", nb_pl, " PL values" - allocate(pl(nb_pl)) - call codes_get(igrib,'pl',pl) - print*, "pl = ", pl - deallocate(pl) - else - print*, "There is no PL values in your GRIB message!" - end if - call codes_release(igrib) + ! get PLPresent to see if the 'pl' array is there + call codes_get(igrib, 'PLPresent', PLPresent) + print *, "PLPresent= ", PLPresent + if (PLPresent == 1) then + call codes_get_size(igrib, 'pl', nb_pl) + print *, "there are ", nb_pl, " PL values" + allocate (pl(nb_pl)) + call codes_get(igrib, 'pl', pl) + print *, "pl = ", pl + deallocate (pl) + else + print *, "There is no PL values in your GRIB message!" + end if + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) end program grib_get_pl diff --git a/examples/F90/grib_get_pv.f90 b/examples/F90/grib_get_pv.f90 index 2fcf8a26e..49e5aaa06 100644 --- a/examples/F90/grib_get_pv.f90 +++ b/examples/F90/grib_get_pv.f90 @@ -11,35 +11,35 @@ ! ! program grib_get_pv - use eccodes - implicit none - integer :: infile - integer :: igrib - integer :: PVPresent, nb_pv - real, dimension(:), allocatable :: pv + use eccodes + implicit none + integer :: infile + integer :: igrib + integer :: PVPresent, nb_pv + real, dimension(:), allocatable :: pv - call codes_open_file(infile, & - '../../data/reduced_gaussian_model_level.grib1','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_model_level.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! Get PVPresent to see if the 'pv' array is there - call codes_get(igrib,'PVPresent',PVPresent) - print*, "PVPresent = ", PVPresent - if (PVPresent == 1) then - call codes_get_size(igrib,'pv',nb_pv) - print*, "There are ", nb_pv, " PV values" - allocate(pv(nb_pv)) - call codes_get(igrib,'pv',pv) - print*, "pv = ", pv - deallocate(pv) - else - print*, "There is no PV values in your GRIB message!" - end if - call codes_release(igrib) + ! Get PVPresent to see if the 'pv' array is there + call codes_get(igrib, 'PVPresent', PVPresent) + print *, "PVPresent = ", PVPresent + if (PVPresent == 1) then + call codes_get_size(igrib, 'pv', nb_pv) + print *, "There are ", nb_pv, " PV values" + allocate (pv(nb_pv)) + call codes_get(igrib, 'pv', pv) + print *, "pv = ", pv + deallocate (pv) + else + print *, "There is no PV values in your GRIB message!" + end if + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) end program grib_get_pv diff --git a/examples/F90/grib_get_set_uuid.f90 b/examples/F90/grib_get_set_uuid.f90 index 17a812a3b..d51bcd9cd 100644 --- a/examples/F90/grib_get_set_uuid.f90 +++ b/examples/F90/grib_get_set_uuid.f90 @@ -12,89 +12,89 @@ ! Original authors: Harald Anlauf, Doerte Liermann (DWD), Luis Kornblueh (MPIfM). ! program grib_get_set_uuid - use eccodes - implicit none - integer :: infile, outfile - integer :: igrib, ogrib - integer :: count1, i, iret, nvg, ffs, length - character(len=1) :: uuid_in (16) ! Array of 16 bytes for uuid on input. - character(len=1) :: uuid_out(16) ! Array of 16 bytes for uuid on output. - character(len=32) :: uuid_string ! Human-readable uuid. - character(len=32) :: uuid_string_expected ! Expected UUID of input + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib, ogrib + integer :: count1, i, iret, nvg, ffs, length + character(len=1) :: uuid_in(16) ! Array of 16 bytes for uuid on input. + character(len=1) :: uuid_out(16) ! Array of 16 bytes for uuid on output. + character(len=32) :: uuid_string ! Human-readable uuid. + character(len=32) :: uuid_string_expected ! Expected UUID of input - call codes_open_file (infile, '../../data/test_uuid.grib2','r') + call codes_open_file(infile, '../../data/test_uuid.grib2', 'r') - call codes_open_file (outfile, 'out_uuid.grib2','w') + call codes_open_file(outfile, 'out_uuid.grib2', 'w') - ! Load first grib message from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file (infile, igrib, iret) + ! Load first grib message from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib, iret) - uuid_string_expected = '08b1e836bc6911e1951fb51b5624ad8d' - count1 = 0 - do while (iret/=CODES_END_OF_FILE) - count1 = count1 + 1 - print *, "### Record:", count1 - call codes_get(igrib,'typeOfFirstFixedSurface',ffs) - print *, 'typeOfFirstFixedSurface =', ffs - if (ffs /= 150) then - print *, "Unexpected typeOfFirstFixedSurface (must be 150)." - stop - end if + uuid_string_expected = '08b1e836bc6911e1951fb51b5624ad8d' + count1 = 0 + do while (iret /= CODES_END_OF_FILE) + count1 = count1 + 1 + print *, "### Record:", count1 + call codes_get(igrib, 'typeOfFirstFixedSurface', ffs) + print *, 'typeOfFirstFixedSurface =', ffs + if (ffs /= 150) then + print *, "Unexpected typeOfFirstFixedSurface (must be 150)." + stop + end if - call codes_get (igrib,'numberOfVGridUsed',nvg) - print *, 'numberOfVGridUsed =',nvg + call codes_get(igrib, 'numberOfVGridUsed', nvg) + print *, 'numberOfVGridUsed =', nvg - ! call codes_get (igrib,'uuidOfVGrid',uuid_in) ! Assuming length is ok. - call codes_get (igrib,'uuidOfVGrid',uuid_in,length=length) - if (length /= 16) then - print *, "Sorry, bad length of byte_array:", length, ". Expected: 16" - stop - end if + ! call codes_get (igrib,'uuidOfVGrid',uuid_in) ! Assuming length is ok. + call codes_get(igrib, 'uuidOfVGrid', uuid_in, length=length) + if (length /= 16) then + print *, "Sorry, bad length of byte_array:", length, ". Expected: 16" + stop + end if - ! Convert byte array to hexadecimal string for printing - do i = 1, size (uuid_in) - uuid_string(2*i-1:2*i) = byte2hex(uuid_in(i)) - end do - print *, "uuidOfVGrid (on input) = ", uuid_string - if (uuid_string .ne. uuid_string_expected) then - print *, "Sorry, bad value of byte_array. Expected: ", uuid_string_expected - stop - end if + ! Convert byte array to hexadecimal string for printing + do i = 1, size(uuid_in) + uuid_string(2*i - 1:2*i) = byte2hex(uuid_in(i)) + end do + print *, "uuidOfVGrid (on input) = ", uuid_string + if (uuid_string .ne. uuid_string_expected) then + print *, "Sorry, bad value of byte_array. Expected: ", uuid_string_expected + stop + end if - call codes_clone (igrib,ogrib) - ! On output we write a modified uuid (here the input is simply reversed) - uuid_out(1:16) = uuid_in(16:1:-1) - call codes_set (ogrib,'uuidOfVGrid',uuid_out) - call codes_write (ogrib,outfile) + call codes_clone(igrib, ogrib) + ! On output we write a modified uuid (here the input is simply reversed) + uuid_out(1:16) = uuid_in(16:1:-1) + call codes_set(ogrib, 'uuidOfVGrid', uuid_out) + call codes_write(ogrib, outfile) - call codes_release (igrib) - call codes_release (ogrib) - call codes_grib_new_from_file (infile, igrib, iret) - end do + call codes_release(igrib) + call codes_release(ogrib) + call codes_grib_new_from_file(infile, igrib, iret) + end do - call codes_close_file (infile) - call codes_close_file (outfile) + call codes_close_file(infile) + call codes_close_file(outfile) contains - ! Convert single byte to 'hexadecimal' string - pure function byte2hex (c) result (hex) - character(len=1), intent(in) :: c - character(len=2) :: hex - integer :: x - x = iachar (c) - hex(1:1) = nibble ( x / 16) - hex(2:2) = nibble (iand (x, 15)) - end function byte2hex - ! Convert 'nibble' to 'hexadecimal' - pure function nibble (x) - integer, intent(in) :: x - character :: nibble - select case (x) - case (0:9) - nibble = achar (iachar ('0') + x) - case default - nibble = achar (iachar ('a') - 10 + x) - end select - end function nibble + ! Convert single byte to 'hexadecimal' string + pure function byte2hex(c) result(hex) + character(len=1), intent(in) :: c + character(len=2) :: hex + integer :: x + x = iachar(c) + hex(1:1) = nibble(x/16) + hex(2:2) = nibble(iand(x, 15)) + end function byte2hex + ! Convert 'nibble' to 'hexadecimal' + pure function nibble(x) + integer, intent(in) :: x + character :: nibble + select case (x) + case (0:9) + nibble = achar(iachar('0') + x) + case default + nibble = achar(iachar('a') - 10 + x) + end select + end function nibble end program grib_get_set_uuid diff --git a/examples/F90/grib_index.f90 b/examples/F90/grib_index.f90 index 6195e2c05..d0d248978 100644 --- a/examples/F90/grib_index.f90 +++ b/examples/F90/grib_index.f90 @@ -13,105 +13,105 @@ ! ! program index - use eccodes - implicit none + use eccodes + implicit none - integer :: iret - integer,dimension(:),allocatable :: step,level,number - character(len=20),dimension(:),allocatable :: shortName - integer :: ostep,olevel,onumber - character(len=20) :: oshortName - integer :: shortNameSize,numberSize,levelSize,stepSize - integer :: i,j,k,l - integer :: idx,igrib,count1 - character(len=10) :: index_file='index.idx' + integer :: iret + integer, dimension(:), allocatable :: step, level, number + character(len=20), dimension(:), allocatable :: shortName + integer :: ostep, olevel, onumber + character(len=20) :: oshortName + integer :: shortNameSize, numberSize, levelSize, stepSize + integer :: i, j, k, l + integer :: idx, igrib, count1 + character(len=10) :: index_file = 'index.idx' - ! uncomment following line to load index from file - !call codes_index_read(idx,index_file) + ! uncomment following line to load index from file + !call codes_index_read(idx,index_file) - ! create an index from a grib file using some keys - call codes_index_create(idx,'../../data/index.grib','shortName,number,level,step') + ! create an index from a grib file using some keys + call codes_index_create(idx, '../../data/index.grib', 'shortName,number,level,step') - ! get the number of distinct values of shortName in the index - call codes_index_get_size(idx,'shortName',shortNameSize) - ! allocate the array to contain the list of distinct shortName - allocate(shortName(shortNameSize)) - ! get the list of distinct shortName from the index - call codes_index_get(idx,'shortName',shortName) - write(*,'(a,i3)') 'shortNameSize=',shortNameSize + ! get the number of distinct values of shortName in the index + call codes_index_get_size(idx, 'shortName', shortNameSize) + ! allocate the array to contain the list of distinct shortName + allocate (shortName(shortNameSize)) + ! get the list of distinct shortName from the index + call codes_index_get(idx, 'shortName', shortName) + write (*, '(a,i3)') 'shortNameSize=', shortNameSize - ! get the number of distinct values of number in the index - call codes_index_get_size(idx,'number',numberSize) - ! allocate the array to contain the list of distinct numbers - allocate(number(numberSize)) - ! get the list of distinct numbers from the index - call codes_index_get(idx,'number',number) - write(*,'(a,i3)') 'numberSize=',numberSize + ! get the number of distinct values of number in the index + call codes_index_get_size(idx, 'number', numberSize) + ! allocate the array to contain the list of distinct numbers + allocate (number(numberSize)) + ! get the list of distinct numbers from the index + call codes_index_get(idx, 'number', number) + write (*, '(a,i3)') 'numberSize=', numberSize - ! get the number of distinct values of level in the index - call codes_index_get_size(idx,'level',levelSize) - ! allocate the array to contain the list of distinct levels - allocate(level(levelSize)) - ! get the list of distinct levels from the index - call codes_index_get(idx,'level',level) - write(*,'(a,i3)') 'levelSize=',levelSize + ! get the number of distinct values of level in the index + call codes_index_get_size(idx, 'level', levelSize) + ! allocate the array to contain the list of distinct levels + allocate (level(levelSize)) + ! get the list of distinct levels from the index + call codes_index_get(idx, 'level', level) + write (*, '(a,i3)') 'levelSize=', levelSize - ! get the number of distinct values of step in the index - call codes_index_get_size(idx,'step',stepSize) - ! allocate the array to contain the list of distinct steps - allocate(step(stepSize)) - ! get the list of distinct steps from the index - call codes_index_get(idx,'step',step) - write(*,'(a,i3)') 'stepSize=',stepSize + ! get the number of distinct values of step in the index + call codes_index_get_size(idx, 'step', stepSize) + ! allocate the array to contain the list of distinct steps + allocate (step(stepSize)) + ! get the list of distinct steps from the index + call codes_index_get(idx, 'step', step) + write (*, '(a,i3)') 'stepSize=', stepSize - count1=0 - do l=1,stepSize ! loop on step - ! select step=step(l) - call codes_index_select(idx,'step',step(l)) + count1 = 0 + do l = 1, stepSize ! loop on step + ! select step=step(l) + call codes_index_select(idx, 'step', step(l)) - do j=1,numberSize ! loop on number - ! select number=number(j) - call codes_index_select(idx,'number',number(j)) + do j = 1, numberSize ! loop on number + ! select number=number(j) + call codes_index_select(idx, 'number', number(j)) - do k=1,levelSize ! loop on level - ! select level=level(k) - call codes_index_select(idx,'level',level(k)) + do k = 1, levelSize ! loop on level + ! select level=level(k) + call codes_index_select(idx, 'level', level(k)) - do i=1,shortNameSize ! loop on shortName - ! select shortName=shortName(i) - call codes_index_select(idx,'shortName',shortName(i)) + do i = 1, shortNameSize ! loop on shortName + ! select shortName=shortName(i) + call codes_index_select(idx, 'shortName', shortName(i)) - call codes_new_from_index(idx,igrib, iret) - do while (iret /= CODES_END_OF_INDEX) - count1=count1+1 - call codes_get(igrib,'shortName',oshortName) - call codes_get(igrib,'number',onumber) - call codes_get(igrib,'level',olevel) - call codes_get(igrib,'step',ostep) - write(*,'(A,A,A,i3,A,i4,A,i3)') 'shortName=',trim(oshortName),& - ' number=',onumber,& - ' level=' ,olevel, & - ' step=' ,ostep + call codes_new_from_index(idx, igrib, iret) + do while (iret /= CODES_END_OF_INDEX) + count1 = count1 + 1 + call codes_get(igrib, 'shortName', oshortName) + call codes_get(igrib, 'number', onumber) + call codes_get(igrib, 'level', olevel) + call codes_get(igrib, 'step', ostep) + write (*, '(A,A,A,i3,A,i4,A,i3)') 'shortName=', trim(oshortName), & + ' number=', onumber, & + ' level=', olevel, & + ' step=', ostep - call codes_release(igrib) - call codes_new_from_index(idx,igrib, iret) - end do - call codes_release(igrib) + call codes_release(igrib) + call codes_new_from_index(idx, igrib, iret) + end do + call codes_release(igrib) - end do ! loop on step - end do ! loop on level - end do ! loop on number - end do ! loop on shortName - write(*,'(i4,a)') count1,' messages selected' + end do ! loop on step + end do ! loop on level + end do ! loop on number + end do ! loop on shortName + write (*, '(i4,a)') count1, ' messages selected' - ! save the index to a file for later reuse - call codes_index_write(idx,index_file) + ! save the index to a file for later reuse + call codes_index_write(idx, index_file) - call codes_index_release(idx) - - deallocate(level) - deallocate(shortName) - deallocate(step) - deallocate(number) + call codes_index_release(idx) + + deallocate (level) + deallocate (shortName) + deallocate (step) + deallocate (number) end program index diff --git a/examples/F90/grib_keys_iterator.f90 b/examples/F90/grib_keys_iterator.f90 index 93b0d9d6f..ca00157b4 100644 --- a/examples/F90/grib_keys_iterator.f90 +++ b/examples/F90/grib_keys_iterator.f90 @@ -14,50 +14,49 @@ ! ! program keys_iterator - use eccodes - implicit none - character(len=20) :: name_space - integer :: kiter,ifile,igrib,iret - character(len=256) :: key - character(len=256) :: value - character(len=512) :: all1 - integer :: grib_count + use eccodes + implicit none + character(len=20) :: name_space + integer :: kiter, ifile, igrib, iret + character(len=256) :: key + character(len=256) :: value + character(len=512) :: all1 + integer :: grib_count - call codes_open_file(ifile, & - '../../data/regular_latlon_surface.grib1','r') + call codes_open_file(ifile, & + '../../data/regular_latlon_surface.grib1', 'r') - ! Loop on all the messages in a file. + ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib, iret) - grib_count=0 - do while (iret /= CODES_END_OF_FILE) + call codes_grib_new_from_file(ifile, igrib, iret) + grib_count = 0 + do while (iret /= CODES_END_OF_FILE) - grib_count=grib_count+1 - write(*,*) '-- GRIB N. ',grib_count,' --' + grib_count = grib_count + 1 + write (*, *) '-- GRIB N. ', grib_count, ' --' - ! valid name_spaces are ls and mars - name_space='ls' + ! valid name_spaces are ls and mars + name_space = 'ls' - call codes_keys_iterator_new(igrib,kiter,name_space) + call codes_keys_iterator_new(igrib, kiter, name_space) - do - call codes_keys_iterator_next(kiter, iret) + do + call codes_keys_iterator_next(kiter, iret) - if (iret .ne. CODES_SUCCESS) exit !terminate the loop + if (iret .ne. CODES_SUCCESS) exit !terminate the loop - call codes_keys_iterator_get_name(kiter,key) - call codes_get(igrib,trim(key),value) - all1=trim(key)// ' = ' // trim(value) - write(*,*) trim(all1) + call codes_keys_iterator_get_name(kiter, key) + call codes_get(igrib, trim(key), value) + all1 = trim(key)//' = '//trim(value) + write (*, *) trim(all1) - end do + end do - call codes_keys_iterator_delete(kiter) - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) - end do + call codes_keys_iterator_delete(kiter) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) + end do - - call codes_close_file(ifile) + call codes_close_file(ifile) end program keys_iterator diff --git a/examples/F90/grib_multi.f90 b/examples/F90/grib_multi.f90 index 69afa90bd..d486a8eb7 100644 --- a/examples/F90/grib_multi.f90 +++ b/examples/F90/grib_multi.f90 @@ -13,33 +13,33 @@ ! For all the tools default is multi support ON. ! program multi - use eccodes - implicit none + use eccodes + implicit none - integer :: iret - integer(kind = 4) :: step - integer :: ifile,igrib + integer :: iret + integer(kind=4) :: step + integer :: ifile, igrib - call codes_open_file(ifile, '../../data/multi_created.grib2','r') + call codes_open_file(ifile, '../../data/multi_created.grib2', 'r') - ! turn on support for multi-field messages */ - call codes_grib_multi_support_on() + ! turn on support for multi-field messages */ + call codes_grib_multi_support_on() - ! turn off support for multi-field messages */ - !call codes_grib_multi_support_off() + ! turn off support for multi-field messages */ + !call codes_grib_multi_support_off() - call codes_grib_new_from_file(ifile,igrib, iret) - ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) + ! Loop on all the messages in a file. - write(*,*) 'step' - do while (iret /= CODES_END_OF_FILE) + write (*, *) 'step' + do while (iret /= CODES_END_OF_FILE) - call codes_get(igrib,'step', step) - write(*,'(i3)') step + call codes_get(igrib, 'step', step) + write (*, '(i3)') step - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_grib_new_from_file(ifile, igrib, iret) - end do - call codes_close_file(ifile) + end do + call codes_close_file(ifile) end program multi diff --git a/examples/F90/grib_multi_write.f90 b/examples/F90/grib_multi_write.f90 index 652971b94..7bec67a3e 100644 --- a/examples/F90/grib_multi_write.f90 +++ b/examples/F90/grib_multi_write.f90 @@ -15,37 +15,37 @@ ! ! program grib2_multi_write - use eccodes - implicit none - integer :: infile,outfile - integer :: in_gribid - integer :: multi_gribid - integer :: step,startsection + use eccodes + implicit none + integer :: infile, outfile + integer :: in_gribid + integer :: multi_gribid + integer :: step, startsection - ! multi field messages can be created only in edition 2 - call codes_open_file(infile,'../../data/sample.grib2','r') + ! multi field messages can be created only in edition 2 + call codes_open_file(infile, '../../data/sample.grib2', 'r') - call codes_open_file(outfile,'multi_created.grib2','w') + call codes_open_file(outfile, 'multi_created.grib2', 'w') - ! a grib message is loaded from file - ! in_gribid is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,in_gribid) + ! a grib message is loaded from file + ! in_gribid is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, in_gribid) - startsection=4 - do step=0,240,12 + startsection = 4 + do step = 0, 240, 12 - call codes_set(in_gribid,"step",step) - call codes_grib_multi_append(in_gribid,startsection,multi_gribid) + call codes_set(in_gribid, "step", step) + call codes_grib_multi_append(in_gribid, startsection, multi_gribid) - enddo + end do ! write messages to a file - call codes_grib_multi_write(multi_gribid,outfile) + call codes_grib_multi_write(multi_gribid, outfile) - call codes_release(in_gribid) - call codes_release(multi_gribid) + call codes_release(in_gribid) + call codes_release(multi_gribid) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) end program grib2_multi_write diff --git a/examples/F90/grib_nearest.f90 b/examples/F90/grib_nearest.f90 index 29735ebe8..2e2d5e1a3 100644 --- a/examples/F90/grib_nearest.f90 +++ b/examples/F90/grib_nearest.f90 @@ -12,67 +12,67 @@ ! ! program find - use eccodes - implicit none - integer :: npoints - integer :: infile - integer :: igrib, ios, i - real(8), dimension(:), allocatable :: lats, lons - real(8), dimension(:), allocatable :: nearest_lats, nearest_lons - real(8), dimension(:), allocatable :: distances, values, lsm_values - integer(kind=kindOfInt), dimension(:), allocatable :: indexes + use eccodes + implicit none + integer :: npoints + integer :: infile + integer :: igrib, ios, i + real(8), dimension(:), allocatable :: lats, lons + real(8), dimension(:), allocatable :: nearest_lats, nearest_lons + real(8), dimension(:), allocatable :: distances, values, lsm_values + integer(kind=kindOfInt), dimension(:), allocatable :: indexes - ! initialization - open( unit=1, file="../../data/list_points",form="formatted",action="read") - read(unit=1,fmt=*) npoints - allocate(lats(npoints)) - allocate(lons(npoints)) - allocate(nearest_lats(npoints)) - allocate(nearest_lons(npoints)) - allocate(distances(npoints)) - allocate(lsm_values(npoints)) - allocate(values(npoints)) - allocate(indexes(npoints)) - do i=1,npoints - read(unit=1,fmt=*, iostat=ios) lats(i), lons(i) - if (ios /= 0) then - npoints = i - 1 - exit - end if - end do - close(unit=1) - call codes_open_file(infile, & - '../../data/reduced_gaussian_lsm.grib1','r') + ! initialization + open (unit=1, file="../../data/list_points", form="formatted", action="read") + read (unit=1, fmt=*) npoints + allocate (lats(npoints)) + allocate (lons(npoints)) + allocate (nearest_lats(npoints)) + allocate (nearest_lons(npoints)) + allocate (distances(npoints)) + allocate (lsm_values(npoints)) + allocate (values(npoints)) + allocate (indexes(npoints)) + do i = 1, npoints + read (unit=1, fmt=*, iostat=ios) lats(i), lons(i) + if (ios /= 0) then + npoints = i - 1 + exit + end if + end do + close (unit=1) + call codes_open_file(infile, & + '../../data/reduced_gaussian_lsm.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_grib_find_nearest(igrib, .true., lats, lons, nearest_lats, nearest_lons,lsm_values, distances, indexes) - call codes_release(igrib) + call codes_grib_find_nearest(igrib, .true., lats, lons, nearest_lats, nearest_lons, lsm_values, distances, indexes) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - ! will apply it to another GRIB - call codes_open_file(infile, & - '../../data/reduced_gaussian_pressure_level.grib1','r') - call codes_grib_new_from_file(infile,igrib) + ! will apply it to another GRIB + call codes_open_file(infile, & + '../../data/reduced_gaussian_pressure_level.grib1', 'r') + call codes_grib_new_from_file(infile, igrib) - call codes_get_element(igrib,"values", indexes, values) - call codes_release(igrib) - call codes_close_file(infile) + call codes_get_element(igrib, "values", indexes, values) + call codes_release(igrib) + call codes_close_file(infile) - do i=1, npoints - print*,lats(i), lons(i), nearest_lats(i), nearest_lons(i), distances(i), lsm_values(i), values(i) - end do + do i = 1, npoints + print *, lats(i), lons(i), nearest_lats(i), nearest_lons(i), distances(i), lsm_values(i), values(i) + end do - deallocate(lats) - deallocate(lons) - deallocate(nearest_lats) - deallocate(nearest_lons) - deallocate(distances) - deallocate(lsm_values) - deallocate(values) - deallocate(indexes) + deallocate (lats) + deallocate (lons) + deallocate (nearest_lats) + deallocate (nearest_lons) + deallocate (distances) + deallocate (lsm_values) + deallocate (values) + deallocate (indexes) end program find diff --git a/examples/F90/grib_precision.f90 b/examples/F90/grib_precision.f90 index f4dcc5918..9a444580c 100644 --- a/examples/F90/grib_precision.f90 +++ b/examples/F90/grib_precision.f90 @@ -13,83 +13,83 @@ ! ! program precision - use eccodes - implicit none - integer(kind = 4) :: size1 - integer :: infile,outfile - integer :: igrib - real(kind = 8), dimension(:), allocatable :: values1 - real(kind = 8), dimension(:), allocatable :: values2 - real(kind = 8) :: maxa,a,maxv,minv,maxr,r - integer( kind = 4) :: decimalPrecision,bitsPerValue1,bitsPerValue2 - integer :: i, iret + use eccodes + implicit none + integer(kind=4) :: size1 + integer :: infile, outfile + integer :: igrib + real(kind=8), dimension(:), allocatable :: values1 + real(kind=8), dimension(:), allocatable :: values2 + real(kind=8) :: maxa, a, maxv, minv, maxr, r + integer(kind=4) :: decimalPrecision, bitsPerValue1, bitsPerValue2 + integer :: i, iret - call codes_open_file(infile, & - '../../data/regular_latlon_surface_constant.grib1','r') + call codes_open_file(infile, & + '../../data/regular_latlon_surface_constant.grib1', 'r') - call codes_open_file(outfile, & - '../../data/regular_latlon_surface_prec.grib1','w') + call codes_open_file(outfile, & + '../../data/regular_latlon_surface_prec.grib1', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! bitsPerValue before changing the packing parameters - call codes_get(igrib,'bitsPerValue',bitsPerValue1) + ! bitsPerValue before changing the packing parameters + call codes_get(igrib, 'bitsPerValue', bitsPerValue1) - ! get the size of the values array - call codes_get_size(igrib,"values",size1) + ! get the size of the values array + call codes_get_size(igrib, "values", size1) - allocate(values1(size1), stat=iret) - allocate(values2(size1), stat=iret) - ! get data values before changing the packing parameters*/ - call codes_get(igrib,"values",values1) + allocate (values1(size1), stat=iret) + allocate (values2(size1), stat=iret) + ! get data values before changing the packing parameters*/ + call codes_get(igrib, "values", values1) - ! setting decimal precision=2 means that 2 decimal digits - ! are preserved when packing. - decimalPrecision=2 - call codes_set(igrib,"changeDecimalPrecision", & - decimalPrecision) + ! setting decimal precision=2 means that 2 decimal digits + ! are preserved when packing. + decimalPrecision = 2 + call codes_set(igrib, "changeDecimalPrecision", & + decimalPrecision) - ! bitsPerValue after changing the packing parameters - call codes_get(igrib,"bitsPerValue",bitsPerValue2) + ! bitsPerValue after changing the packing parameters + call codes_get(igrib, "bitsPerValue", bitsPerValue2) - ! get data values after changing the packing parameters - call codes_get(igrib,"values",values2) + ! get data values after changing the packing parameters + call codes_get(igrib, "values", values2) - ! computing error - maxa=0 - maxr=0 - maxv=values2(1) - minv=maxv - do i=1,size1 - a=abs(values2(i)-values1(i)) - if ( values2(i) .gt. maxv ) maxv=values2(i) - if ( values2(i) .lt. maxv ) minv=values2(i) - if ( values2(i) .ne. 0 ) then - r=abs((values2(i)-values1(i))/values2(i)) - endif - if ( a .gt. maxa ) maxa=a - if ( r .gt. maxr ) maxr=r - enddo - write(*,*) "max absolute error = ",maxa - write(*,*) "max relative error = ",maxr - write(*,*) "min value = ",minv - write(*,*) "max value = ",maxv + ! computing error + maxa = 0 + maxr = 0 + maxv = values2(1) + minv = maxv + do i = 1, size1 + a = abs(values2(i) - values1(i)) + if (values2(i) .gt. maxv) maxv = values2(i) + if (values2(i) .lt. maxv) minv = values2(i) + if (values2(i) .ne. 0) then + r = abs((values2(i) - values1(i))/values2(i)) + end if + if (a .gt. maxa) maxa = a + if (r .gt. maxr) maxr = r + end do + write (*, *) "max absolute error = ", maxa + write (*, *) "max relative error = ", maxr + write (*, *) "min value = ", minv + write (*, *) "max value = ", maxv - write(*,*) "old number of bits per value=",bitsPerValue1 - write(*,*) "new number of bits per value=",bitsPerValue2 + write (*, *) "old number of bits per value=", bitsPerValue1 + write (*, *) "new number of bits per value=", bitsPerValue2 - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) - deallocate(values1) - deallocate(values2) + deallocate (values1) + deallocate (values2) end program precision diff --git a/examples/F90/grib_print_data.f90 b/examples/F90/grib_print_data.f90 index 9225908eb..a2aa3757b 100644 --- a/examples/F90/grib_print_data.f90 +++ b/examples/F90/grib_print_data.f90 @@ -12,49 +12,49 @@ ! ! program print_data -use eccodes -implicit none -integer :: ifile -integer :: iret -integer :: igrib -integer :: i -real(kind=8), dimension(:), allocatable :: values -integer(kind=4) :: numPoints -real(kind=8) :: average -real(kind=8) :: the_max -real(kind=8) :: the_min + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: igrib + integer :: i + real(kind=8), dimension(:), allocatable :: values + integer(kind=4) :: numPoints + real(kind=8) :: average + real(kind=8) :: the_max + real(kind=8) :: the_min - call codes_open_file(ifile, & - '../../data/constant_field.grib1','r') + call codes_open_file(ifile, & + '../../data/constant_field.grib1', 'r') - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib) - ! Get the size of the values array - call codes_get_size(igrib,'values',numPoints) + ! Get the size of the values array + call codes_get_size(igrib, 'values', numPoints) - ! Get data values - print*, 'number of points ', numPoints - allocate(values(numPoints), stat=iret) + ! Get data values + print *, 'number of points ', numPoints + allocate (values(numPoints), stat=iret) - call codes_get(igrib,'values',values) + call codes_get(igrib, 'values', values) - do i=1,numPoints - write(*,*)' ',i,values(i) - enddo + do i = 1, numPoints + write (*, *) ' ', i, values(i) + end do - write(*,*)numPoints,' values found ' + write (*, *) numPoints, ' values found ' - call codes_get(igrib,'max',the_max) - write(*,*) 'max=',the_max - call codes_get(igrib,'min',the_min) - write(*,*) 'min=',the_min - call codes_get(igrib,'average',average) - write(*,*) 'average=',average + call codes_get(igrib, 'max', the_max) + write (*, *) 'max=', the_max + call codes_get(igrib, 'min', the_min) + write (*, *) 'min=', the_min + call codes_get(igrib, 'average', average) + write (*, *) 'average=', average - call codes_release(igrib) - call codes_close_file(ifile) - deallocate(values) + call codes_release(igrib) + call codes_close_file(ifile) + deallocate (values) end program print_data diff --git a/examples/F90/grib_print_data_static.f90 b/examples/F90/grib_print_data_static.f90 index 28a64fff7..e83af8f48 100644 --- a/examples/F90/grib_print_data_static.f90 +++ b/examples/F90/grib_print_data_static.f90 @@ -13,46 +13,46 @@ ! ! program print_data -use grib_api -implicit none -integer :: ifile -integer :: igrib -integer :: i -real(kind=8), dimension(99200) :: values_static -integer(kind=4) :: numPoints -real(kind=8) :: average -real(kind=8) :: the_max -real(kind=8) :: the_min + use grib_api + implicit none + integer :: ifile + integer :: igrib + integer :: i + real(kind=8), dimension(99200) :: values_static + integer(kind=4) :: numPoints + real(kind=8) :: average + real(kind=8) :: the_max + real(kind=8) :: the_min - call grib_open_file(ifile, & - '../../data/constant_field.grib1','r') + call grib_open_file(ifile, & + '../../data/constant_field.grib1', 'r') - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call grib_new_from_file(ifile,igrib) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call grib_new_from_file(ifile, igrib) - ! Get the size of the values array - call grib_get_size(igrib,'values',numPoints) + ! Get the size of the values array + call grib_get_size(igrib, 'values', numPoints) - ! Get data values - print*, 'number of points ', numPoints + ! Get data values + print *, 'number of points ', numPoints - call grib_get(igrib,'values',values_static) + call grib_get(igrib, 'values', values_static) - do i=1,numPoints - write(*,*)' ',i,values_static(i) - enddo + do i = 1, numPoints + write (*, *) ' ', i, values_static(i) + end do - write(*,*)numPoints,' values found ' + write (*, *) numPoints, ' values found ' - call grib_get(igrib,'max',the_max) - write(*,*) 'max=',the_max - call grib_get(igrib,'min',the_min) - write(*,*) 'min=',the_min - call grib_get(igrib,'average',average) - write(*,*) 'average=',average + call grib_get(igrib, 'max', the_max) + write (*, *) 'max=', the_max + call grib_get(igrib, 'min', the_min) + write (*, *) 'min=', the_min + call grib_get(igrib, 'average', average) + write (*, *) 'average=', average - call grib_release(igrib) - call grib_close_file(ifile) + call grib_release(igrib) + call grib_close_file(ifile) end program print_data diff --git a/examples/F90/grib_read_message.f90 b/examples/F90/grib_read_message.f90 index ac0f80ff2..42c557df3 100644 --- a/examples/F90/grib_read_message.f90 +++ b/examples/F90/grib_read_message.f90 @@ -9,45 +9,45 @@ ! Description: how to get values using keys. ! program grib_read_message -use eccodes -implicit none - integer :: ifile,ofile - integer :: iret,igrib - integer , dimension(50000) :: buffer - integer(kind=kindOfSize_t) :: len1 - integer :: step,level + use eccodes + implicit none + integer :: ifile, ofile + integer :: iret, igrib + integer, dimension(50000) :: buffer + integer(kind=kindOfSize_t) :: len1 + integer :: step, level - call codes_open_file(ifile,'../../data/index.grib','r') - call codes_open_file(ofile,'out.readmsg.grib','w') + call codes_open_file(ifile, '../../data/index.grib', 'r') + call codes_open_file(ofile, 'out.readmsg.grib', 'w') ! a grib message is read from file into buffer - len1=size(buffer)*4 - call codes_read_from_file(ifile,buffer,len1,iret) + len1 = size(buffer)*4 + call codes_read_from_file(ifile, buffer, len1, iret) - do while (iret/=CODES_END_OF_FILE) + do while (iret /= CODES_END_OF_FILE) ! a new grib message is created from buffer - call codes_new_from_message(igrib,buffer) + call codes_new_from_message(igrib, buffer) ! get as a integer - call codes_get(igrib,'step', step) - write(*,*) 'step=',step + call codes_get(igrib, 'step', step) + write (*, *) 'step=', step - call codes_get(igrib,'level',level) - write(*,*) 'level=',level + call codes_get(igrib, 'level', level) + write (*, *) 'level=', level - call codes_release(igrib) + call codes_release(igrib) - call codes_write_bytes(ofile,buffer,len1) + call codes_write_bytes(ofile, buffer, len1) ! a grib message is read from file into buffer - len1=size(buffer)*4 - call codes_read_from_file(ifile,buffer,len1,iret) + len1 = size(buffer)*4 + call codes_read_from_file(ifile, buffer, len1, iret) - enddo + end do - call codes_close_file(ifile) - call codes_close_file(ofile) + call codes_close_file(ifile) + call codes_close_file(ofile) end program grib_read_message diff --git a/examples/F90/grib_samples.f90 b/examples/F90/grib_samples.f90 index cd64b6a4b..4c0edf606 100644 --- a/examples/F90/grib_samples.f90 +++ b/examples/F90/grib_samples.f90 @@ -11,86 +11,86 @@ ! ! program sample - use eccodes - implicit none - integer :: err - integer :: outfile, datafile - integer :: igribsample,igribclone,igribdata, size1 - integer :: date1, startStep, endStep, table2Version, indicatorOfParameter - integer :: decimalPrecision - character(len=10) stepType - real(kind=8), dimension(:), allocatable :: v1,v2,v + use eccodes + implicit none + integer :: err + integer :: outfile, datafile + integer :: igribsample, igribclone, igribdata, size1 + integer :: date1, startStep, endStep, table2Version, indicatorOfParameter + integer :: decimalPrecision + character(len=10) stepType + real(kind=8), dimension(:), allocatable :: v1, v2, v - date1 = 20080104 - startStep = 0 - endStep = 12 - stepType = 'accum' - table2Version = 2 - indicatorOfParameter = 61 - decimalPrecision = 2 + date1 = 20080104 + startStep = 0 + endStep = 12 + stepType = 'accum' + table2Version = 2 + indicatorOfParameter = 61 + decimalPrecision = 2 - ! A new grib message is loaded from an existing sample. - ! Samples are searched in a default sample path (use codes_info - ! to see where that is). The default sample path can be changed by - ! setting the environment variable ECCODES_SAMPLES_PATH - call codes_grib_new_from_samples(igribsample, "regular_latlon_surface.grib1") + ! A new grib message is loaded from an existing sample. + ! Samples are searched in a default sample path (use codes_info + ! to see where that is). The default sample path can be changed by + ! setting the environment variable ECCODES_SAMPLES_PATH + call codes_grib_new_from_samples(igribsample, "regular_latlon_surface.grib1") - call codes_open_file(outfile, 'f_out.samples.grib1','w') - call codes_open_file(datafile,'../../data/tp_ecmwf.grib','r') + call codes_open_file(outfile, 'f_out.samples.grib1', 'w') + call codes_open_file(datafile, '../../data/tp_ecmwf.grib', 'r') - call codes_grib_new_from_file(datafile,igribdata,err) + call codes_grib_new_from_file(datafile, igribdata, err) - call codes_get_size(igribdata,'values',size1) - allocate(v(size1)) - allocate(v1(size1)) - allocate(v2(size1)) + call codes_get_size(igribdata, 'values', size1) + allocate (v(size1)) + allocate (v1(size1)) + allocate (v2(size1)) - call codes_get(igribdata,'values',v) + call codes_get(igribdata, 'values', v) - v=v*1000.0 ! different units for the output grib - v1=v + v = v*1000.0 ! different units for the output grib + v1 = v - do while (err/=CODES_END_OF_FILE) + do while (err /= CODES_END_OF_FILE) - call codes_clone(igribsample,igribclone) ! clone sample before modifying it + call codes_clone(igribsample, igribclone) ! clone sample before modifying it - call codes_set(igribclone,'dataDate',date1) - call codes_set(igribclone,'table2Version',table2Version) - call codes_set(igribclone,'indicatorOfParameter',indicatorOfParameter) + call codes_set(igribclone, 'dataDate', date1) + call codes_set(igribclone, 'table2Version', table2Version) + call codes_set(igribclone, 'indicatorOfParameter', indicatorOfParameter) - call codes_set(igribclone,'stepType',stepType) - call codes_set(igribclone,'startStep',startStep) - call codes_set(igribclone,'endStep',endStep) + call codes_set(igribclone, 'stepType', stepType) + call codes_set(igribclone, 'startStep', startStep) + call codes_set(igribclone, 'endStep', endStep) - call codes_set(igribclone,'decimalPrecision',decimalPrecision) + call codes_set(igribclone, 'decimalPrecision', decimalPrecision) - call codes_set(igribclone,'values',v) + call codes_set(igribclone, 'values', v) - call codes_write(igribclone,outfile) + call codes_write(igribclone, outfile) - call codes_grib_new_from_file(datafile,igribdata,err) + call codes_grib_new_from_file(datafile, igribdata, err) - if (err==0) then - call codes_get(igribdata,'values',v2) + if (err == 0) then + call codes_get(igribdata, 'values', v2) - v2=v2*1000.0 ! different units for the output grib + v2 = v2*1000.0 ! different units for the output grib - v=v2-v1 ! accumulation from startStep to endStep + v = v2 - v1 ! accumulation from startStep to endStep - v1=v2 ! save previous step field + v1 = v2 ! save previous step field - startStep=startStep+12 - endStep=endStep+12 + startStep = startStep + 12 + endStep = endStep + 12 - endif + end if - enddo + end do - call codes_release(igribsample) - deallocate(v) - deallocate(v1) - deallocate(v2) + call codes_release(igribsample) + deallocate (v) + deallocate (v1) + deallocate (v2) - call codes_close_file(outfile) + call codes_close_file(outfile) end program sample diff --git a/examples/F90/grib_set_bitmap.f90 b/examples/F90/grib_set_bitmap.f90 index e9b4c064c..e2c2d6de4 100644 --- a/examples/F90/grib_set_bitmap.f90 +++ b/examples/F90/grib_set_bitmap.f90 @@ -13,67 +13,67 @@ ! ! program set_bitmap - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib, iret - integer :: numberOfValues - real, dimension(:), allocatable :: values - real :: missingValue - logical :: grib1Example + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib, iret + integer :: numberOfValues + real, dimension(:), allocatable :: values + real :: missingValue + logical :: grib1Example - grib1Example=.true. + grib1Example = .true. - if (grib1Example) then - ! GRIB 1 example - call codes_open_file(infile,'../../data/regular_latlon_surface.grib1','r') - else - ! GRIB 2 example - call codes_open_file(infile,'../../data/regular_latlon_surface.grib2','r') - end if + if (grib1Example) then + ! GRIB 1 example + call codes_open_file(infile, '../../data/regular_latlon_surface.grib1', 'r') + else + ! GRIB 2 example + call codes_open_file(infile, '../../data/regular_latlon_surface.grib2', 'r') + end if - call codes_open_file(outfile,'out.set_bitmap_f.grib','w') + call codes_open_file(outfile, 'out.set_bitmap_f.grib', 'w') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! The missingValue is not coded in the message. - ! It is a value we define as a placeholder for a missing value - ! at a point in the grid. - ! It should be chosen so that it cannot be confused - ! with a valid field value - missingValue=9999 - call codes_set(igrib, 'missingValue',missingValue) - write(*,*) 'missingValue=',missingValue + ! The missingValue is not coded in the message. + ! It is a value we define as a placeholder for a missing value + ! at a point in the grid. + ! It should be chosen so that it cannot be confused + ! with a valid field value + missingValue = 9999 + call codes_set(igrib, 'missingValue', missingValue) + write (*, *) 'missingValue=', missingValue - ! get the size of the values array - call codes_get_size(igrib,'values',numberOfValues) - write(*,*) 'numberOfValues=',numberOfValues + ! get the size of the values array + call codes_get_size(igrib, 'values', numberOfValues) + write (*, *) 'numberOfValues=', numberOfValues - allocate(values(numberOfValues), stat=iret) + allocate (values(numberOfValues), stat=iret) - ! get data values - call codes_get(igrib,'values',values) + ! get data values + call codes_get(igrib, 'values', values) - ! enable bitmap - call codes_set(igrib, 'bitmapPresent', 1) + ! enable bitmap + call codes_set(igrib, 'bitmapPresent', 1) - ! set some values to be missing - values(1:10) = missingValue + ! set some values to be missing + values(1:10) = missingValue - ! set the values (the bitmap will be automatically built) - call codes_set(igrib,'values', values) + ! set the values (the bitmap will be automatically built) + call codes_set(igrib, 'values', values) - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - ! free memory - call codes_release(igrib) + ! free memory + call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) - deallocate(values) + deallocate (values) end program set_bitmap diff --git a/examples/F90/grib_set_data.f90 b/examples/F90/grib_set_data.f90 index fcaa2711b..3ceec5535 100644 --- a/examples/F90/grib_set_data.f90 +++ b/examples/F90/grib_set_data.f90 @@ -13,51 +13,51 @@ ! If there are missing values, refer to: grib_set_bitmap ! program set_data - use eccodes - implicit none - integer :: outfile - integer :: i, igrib, iret, numberOfValues, cnt - real :: d, e - real, dimension(:), allocatable :: values - integer, parameter :: max_strsize = 200 - character(len=max_strsize) :: outfile_name + use eccodes + implicit none + integer :: outfile + integer :: i, igrib, iret, numberOfValues, cnt + real :: d, e + real, dimension(:), allocatable :: values + integer, parameter :: max_strsize = 200 + character(len=max_strsize) :: outfile_name - call getarg(1, outfile_name) - call codes_open_file(outfile,outfile_name,'w') + call getarg(1, outfile_name) + call codes_open_file(outfile, outfile_name, 'w') - ! Note: the full name of the sample file is "regular_ll_pl_grib1.tmpl" - ! Sample files are stored in the samples directory (use codes_info to - ! see where that is). The default sample path can be changed by - ! setting the environment variable ECCODES_SAMPLES_PATH - call codes_grib_new_from_samples(igrib, 'regular_ll_pl_grib1') + ! Note: the full name of the sample file is "regular_ll_pl_grib1.tmpl" + ! Sample files are stored in the samples directory (use codes_info to + ! see where that is). The default sample path can be changed by + ! setting the environment variable ECCODES_SAMPLES_PATH + call codes_grib_new_from_samples(igrib, 'regular_ll_pl_grib1') - ! Here we're changing the data values only, so the number of values - ! will be the same as the sample GRIB. - ! But if your data array has a different size, then specify the grid geometry - ! (e.g. keys Ni, Nj etc) and set the correct number of data values - call codes_get_size(igrib,'values',numberOfValues) + ! Here we're changing the data values only, so the number of values + ! will be the same as the sample GRIB. + ! But if your data array has a different size, then specify the grid geometry + ! (e.g. keys Ni, Nj etc) and set the correct number of data values + call codes_get_size(igrib, 'values', numberOfValues) - allocate(values(numberOfValues), stat=iret) - d = 10e-8 - e = d - cnt = 1 - do i=1,numberOfValues - if (cnt>100) then - e = e*10 - cnt=1 - endif - values(i) = d - !print *, values(i) - d = d + e - cnt = cnt + 1 - end do + allocate (values(numberOfValues), stat=iret) + d = 10e-8 + e = d + cnt = 1 + do i = 1, numberOfValues + if (cnt > 100) then + e = e*10 + cnt = 1 + end if + values(i) = d + !print *, values(i) + d = d + e + cnt = cnt + 1 + end do - call codes_set(igrib, 'bitsPerValue', 16) + call codes_set(igrib, 'bitsPerValue', 16) - ! set data values - call codes_set(igrib,'values', values) - call codes_write(igrib,outfile) - call codes_release(igrib) - deallocate(values) + ! set data values + call codes_set(igrib, 'values', values) + call codes_write(igrib, outfile) + call codes_release(igrib) + deallocate (values) end program set_data diff --git a/examples/F90/grib_set_gvc.f90 b/examples/F90/grib_set_gvc.f90 index 994ead1e5..763c44a53 100644 --- a/examples/F90/grib_set_gvc.f90 +++ b/examples/F90/grib_set_gvc.f90 @@ -13,55 +13,55 @@ ! ! program set - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib - call codes_open_file(infile, '../../data/sample.grib2','r') + call codes_open_file(infile, '../../data/sample.grib2', 'r') - call codes_open_file(outfile, 'out_gvc.grib2','w') + call codes_open_file(outfile, 'out_gvc.grib2', 'w') - call codes_grib_new_from_file(infile,igrib) + call codes_grib_new_from_file(infile, igrib) - ! Individual ensemble forecast - call codes_set(igrib,'productDefinitionTemplateNumber', 11) + ! Individual ensemble forecast + call codes_set(igrib, 'productDefinitionTemplateNumber', 11) - ! Select level type as Generalized Vertical Height Coordinate - call codes_set(igrib,'typeOfLevel', 'generalVertical') + ! Select level type as Generalized Vertical Height Coordinate + call codes_set(igrib, 'typeOfLevel', 'generalVertical') - ! Now set keys specific to this level type - call codes_set(igrib,'nlev', 12.21) - call codes_set(igrib,'numberOfVGridUsed', 13.55) + ! Now set keys specific to this level type + call codes_set(igrib, 'nlev', 12.21) + call codes_set(igrib, 'numberOfVGridUsed', 13.55) - ! check integrity of GRIB message - call check_settings(igrib) + ! check integrity of GRIB message + call check_settings(igrib) - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_release(igrib) + call codes_close_file(infile) + call codes_close_file(outfile) contains !====================================== -subroutine check_settings(gribid) - implicit none - integer, intent(in) :: gribid + subroutine check_settings(gribid) + implicit none + integer, intent(in) :: gribid - integer(kind = 4) :: NV,typeOfFirstFixedSurface + integer(kind=4) :: NV, typeOfFirstFixedSurface - call codes_get(gribid,'NV', NV) - if (NV /= 6) then - call codes_check(-2, 'NV_should_be_6', '') - end if + call codes_get(gribid, 'NV', NV) + if (NV /= 6) then + call codes_check(-2, 'NV_should_be_6', '') + end if - call codes_get(gribid,'typeOfFirstFixedSurface', typeOfFirstFixedSurface) - if (typeOfFirstFixedSurface /= 150) then - call codes_check(-2, 'typeOfFirstFixedSurface_should_be_150', '') - end if + call codes_get(gribid, 'typeOfFirstFixedSurface', typeOfFirstFixedSurface) + if (typeOfFirstFixedSurface /= 150) then + call codes_check(-2, 'typeOfFirstFixedSurface_should_be_150', '') + end if -end subroutine check_settings + end subroutine check_settings end program set diff --git a/examples/F90/grib_set_keys.f90 b/examples/F90/grib_set_keys.f90 index 60e76e6f0..dfbb7b9b5 100644 --- a/examples/F90/grib_set_keys.f90 +++ b/examples/F90/grib_set_keys.f90 @@ -11,69 +11,69 @@ ! ! program set - use eccodes - implicit none - integer(kind = 4) :: centre, date1 - integer :: infile,outfile - integer :: igrib - character(len=12) :: marsType = 'ses' + use eccodes + implicit none + integer(kind=4) :: centre, date1 + integer :: infile, outfile + integer :: igrib + character(len=12) :: marsType = 'ses' - centre = 80 - call current_date(date1) - call codes_open_file(infile, '../../data/regular_latlon_surface_constant.grib1','r') - call codes_open_file(outfile, 'out.set.grib1','w') + centre = 80 + call current_date(date1) + call codes_open_file(infile, '../../data/regular_latlon_surface_constant.grib1', 'r') + call codes_open_file(outfile, 'out.set.grib1', 'w') - ! A new GRIB message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new GRIB message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_set(igrib,'dataDate',date1) - call codes_set(igrib,'type', marsType) + call codes_set(igrib, 'dataDate', date1) + call codes_set(igrib, 'type', marsType) - ! set centre as a integer */ - call codes_set(igrib,'centre',centre) + ! set centre as a integer */ + call codes_set(igrib, 'centre', centre) - ! Check if it is correct in the actual GRIB message - call check_settings(igrib) + ! Check if it is correct in the actual GRIB message + call check_settings(igrib) - ! Write modified message to a file - call codes_write(igrib,outfile) + ! Write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(infile) + call codes_close_file(outfile) contains !====================================== -subroutine current_date(date1) -integer, intent(out) :: date1 + subroutine current_date(date1) + integer, intent(out) :: date1 -integer :: val_date(8) -call date_and_time ( values = val_date) + integer :: val_date(8) + call date_and_time(values=val_date) -date1 = val_date(1)* 10000 + val_date(2)*100 + val_date(3) -end subroutine current_date + date1 = val_date(1)*10000 + val_date(2)*100 + val_date(3) + end subroutine current_date !====================================== -subroutine check_settings(gribid) - implicit none - integer, intent(in) :: gribid + subroutine check_settings(gribid) + implicit none + integer, intent(in) :: gribid - integer(kind = 4) :: int_value - character(len = 10) :: string_value + integer(kind=4) :: int_value + character(len=10) :: string_value - ! get centre as a integer - call codes_get(gribid,'centre',int_value) - write(*,*) "get centre as a integer - centre = ",int_value + ! get centre as a integer + call codes_get(gribid, 'centre', int_value) + write (*, *) "get centre as a integer - centre = ", int_value - ! get centre as a string - call codes_get(gribid,'centre',string_value) - write(*,*) "get centre as a string - centre = ",string_value + ! get centre as a string + call codes_get(gribid, 'centre', string_value) + write (*, *) "get centre as a string - centre = ", string_value - ! get date as a string - call codes_get(gribid,'dataDate',string_value) - write(*,*) "get date as a string - date = ",string_value + ! get date as a string + call codes_get(gribid, 'dataDate', string_value) + write (*, *) "get date as a string - date = ", string_value -end subroutine check_settings + end subroutine check_settings end program set diff --git a/examples/F90/grib_set_missing.f90 b/examples/F90/grib_set_missing.f90 index e225b43eb..3f502268a 100644 --- a/examples/F90/grib_set_missing.f90 +++ b/examples/F90/grib_set_missing.f90 @@ -13,40 +13,40 @@ ! ! program set - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib, Ni, is_missing + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib, Ni, is_missing - infile=5 - outfile=6 + infile = 5 + outfile = 6 - call codes_open_file(infile, & - '../../data/reduced_gaussian_pressure_level.grib2','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_pressure_level.grib2', 'r') - call codes_open_file(outfile, & - 'f_out_surface_level.grib2','w') + call codes_open_file(outfile, & + 'f_out_surface_level.grib2', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_set(igrib,'typeOfFirstFixedSurface','sfc') - call codes_set_missing(igrib,'scaleFactorOfFirstFixedSurface') - call codes_set_missing(igrib,'scaledValueOfFirstFixedSurface') + call codes_set(igrib, 'typeOfFirstFixedSurface', 'sfc') + call codes_set_missing(igrib, 'scaleFactorOfFirstFixedSurface') + call codes_set_missing(igrib, 'scaledValueOfFirstFixedSurface') - ! See GRIB-490 - call codes_get(igrib, 'Ni', Ni) - call codes_is_missing(igrib,'Ni',is_missing) - if ( is_missing == 0 ) then - ! Ni should be missing in gribs with Reduced Gaussian grids - call codes_check(-2, 'Ni_should_be_missing', '') - endif - call codes_set(igrib, 'Ni', Ni) + ! See GRIB-490 + call codes_get(igrib, 'Ni', Ni) + call codes_is_missing(igrib, 'Ni', is_missing) + if (is_missing == 0) then + ! Ni should be missing in gribs with Reduced Gaussian grids + call codes_check(-2, 'Ni_should_be_missing', '') + end if + call codes_set(igrib, 'Ni', Ni) - call codes_write(igrib,outfile) - call codes_release(igrib) - call codes_close_file(infile) - call codes_close_file(outfile) + call codes_write(igrib, outfile) + call codes_release(igrib) + call codes_close_file(infile) + call codes_close_file(outfile) end program set diff --git a/examples/F90/grib_set_packing.f90 b/examples/F90/grib_set_packing.f90 index be2babada..eb03bc3c9 100644 --- a/examples/F90/grib_set_packing.f90 +++ b/examples/F90/grib_set_packing.f90 @@ -10,45 +10,45 @@ ! e.g. Simple packing, CCSDS ! program set_packing - use eccodes - implicit none - integer :: outfile - integer :: i, igrib, iret, numberOfValues, cnt - real :: d, e - real, dimension(:), allocatable :: values - integer, parameter :: max_strsize = 200 - character(len=max_strsize) :: outfile_name, packing_type + use eccodes + implicit none + integer :: outfile + integer :: i, igrib, iret, numberOfValues, cnt + real :: d, e + real, dimension(:), allocatable :: values + integer, parameter :: max_strsize = 200 + character(len=max_strsize) :: outfile_name, packing_type - call getarg(1, packing_type) - call getarg(2, outfile_name) + call getarg(1, packing_type) + call getarg(2, outfile_name) - call codes_open_file(outfile,outfile_name,'w') + call codes_open_file(outfile, outfile_name, 'w') - call codes_grib_new_from_samples(igrib, 'gg_sfc_grib2') + call codes_grib_new_from_samples(igrib, 'gg_sfc_grib2') - call codes_get_size(igrib,'values', numberOfValues) - allocate(values(numberOfValues), stat=iret) - d = 10e-6 - e = d - cnt = 1 - do i=1,numberOfValues - if (cnt>100) then - e = e*1.01 - cnt=1 - endif - values(i) = d - d = d + e - cnt = cnt + 1 - end do + call codes_get_size(igrib, 'values', numberOfValues) + allocate (values(numberOfValues), stat=iret) + d = 10e-6 + e = d + cnt = 1 + do i = 1, numberOfValues + if (cnt > 100) then + e = e*1.01 + cnt = 1 + end if + values(i) = d + d = d + e + cnt = cnt + 1 + end do - call codes_set(igrib, 'numberOfBitsContainingEachPackedValue', 16) - call codes_set(igrib, 'packingType', packing_type) + call codes_set(igrib, 'numberOfBitsContainingEachPackedValue', 16) + call codes_set(igrib, 'packingType', packing_type) - ! set data values - call codes_set(igrib, 'values', values) + ! set data values + call codes_set(igrib, 'values', values) - call codes_write(igrib, outfile) - call codes_release(igrib) - deallocate(values) + call codes_write(igrib, outfile) + call codes_release(igrib) + deallocate (values) end program set_packing diff --git a/examples/F90/grib_set_pv.f90 b/examples/F90/grib_set_pv.f90 index 9b35fbd7f..212697339 100644 --- a/examples/F90/grib_set_pv.f90 +++ b/examples/F90/grib_set_pv.f90 @@ -12,62 +12,62 @@ ! ! program grib_set_pv - use eccodes - implicit none - integer :: numberOfLevels - integer :: numberOfCoefficients - integer :: outfile, igrib - integer :: i, ios - real, dimension(:),allocatable :: pv + use eccodes + implicit none + integer :: numberOfLevels + integer :: numberOfCoefficients + integer :: outfile, igrib + integer :: i, ios + real, dimension(:), allocatable :: pv - numberOfLevels=60 - numberOfCoefficients=2*(numberOfLevels+1) + numberOfLevels = 60 + numberOfCoefficients = 2*(numberOfLevels + 1) - allocate(pv(numberOfCoefficients)) + allocate (pv(numberOfCoefficients)) - ! read the model level coefficients from file - open( unit=1, file="../../data/60_model_levels", & - form="formatted",action="read") + ! read the model level coefficients from file + open (unit=1, file="../../data/60_model_levels", & + form="formatted", action="read") - do i=1,numberOfCoefficients,2 - read(unit=1,fmt=*, iostat=ios) pv(i), pv(i+1) - if (ios /= 0) then - print *, "I/O error: ",ios - exit - end if - end do + do i = 1, numberOfCoefficients, 2 + read (unit=1, fmt=*, iostat=ios) pv(i), pv(i + 1) + if (ios /= 0) then + print *, "I/O error: ", ios + exit + end if + end do - ! print coefficients - !do i=1,numberOfCoefficients,2 - ! print *," a=",pv(i)," b=",pv(i+1) - !end do + ! print coefficients + !do i=1,numberOfCoefficients,2 + ! print *," a=",pv(i)," b=",pv(i+1) + !end do - close(unit=1) + close (unit=1) - call codes_open_file(outfile, 'out.pv.grib1','w') + call codes_open_file(outfile, 'out.pv.grib1', 'w') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_samples(igrib, "reduced_gg_sfc_grib1") + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_samples(igrib, "reduced_gg_sfc_grib1") - ! set levtype to ml (model level) - call codes_set(igrib,'typeOfLevel','hybrid') + ! set levtype to ml (model level) + call codes_set(igrib, 'typeOfLevel', 'hybrid') - ! set level - call codes_set(igrib,'level',2) + ! set level + call codes_set(igrib, 'level', 2) - ! set PVPresent as an integer - call codes_set(igrib,'PVPresent',1) + ! set PVPresent as an integer + call codes_set(igrib, 'PVPresent', 1) - call codes_set(igrib,'pv',pv) + call codes_set(igrib, 'pv', pv) - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - ! Free memory - call codes_release(igrib) - deallocate(pv) + ! Free memory + call codes_release(igrib) + deallocate (pv) - call codes_close_file(outfile) + call codes_close_file(outfile) end program grib_set_pv diff --git a/examples/F90/iterator_fortran.f90 b/examples/F90/iterator_fortran.f90 index 73761833e..10aafaba6 100644 --- a/examples/F90/iterator_fortran.f90 +++ b/examples/F90/iterator_fortran.f90 @@ -11,60 +11,60 @@ ! ! program iterator -use eccodes -implicit none - integer :: ifile - integer :: iret,iter - real(kind=8) :: lat,lon,value,missingValue - integer :: n,flags + use eccodes + implicit none + integer :: ifile + integer :: iret, iter + real(kind=8) :: lat, lon, value, missingValue + integer :: n, flags - ! Message identifier. - integer :: igrib + ! Message identifier. + integer :: igrib - ifile=5 + ifile = 5 - call codes_open_file(ifile, & - '../../data/regular_latlon_surface_constant.grib1','R') + call codes_open_file(ifile, & + '../../data/regular_latlon_surface_constant.grib1', 'R') - ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib,iret) + ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) - LOOP: DO WHILE (iret/=CODES_END_OF_FILE) + LOOP: DO WHILE (iret /= CODES_END_OF_FILE) ! get as a real8 call codes_get(igrib, & - 'missingValue',missingValue) - write(*,*) 'missingValue=',missingValue + 'missingValue', missingValue) + write (*, *) 'missingValue=', missingValue ! A new iterator on lat/lon/values is created from the message igrib flags = 0 - call grib_iterator_new(igrib,iter,flags) + call grib_iterator_new(igrib, iter, flags) n = 0 ! Loop on all the lat/lon/values. - call grib_iterator_next(iter,lat,lon,value, iret) + call grib_iterator_next(iter, lat, lon, value, iret) do while (iret .ne. 0) ! You can now print lat and lon, - if ( value .eq. missingValue ) then - ! decide what to print if a missing value is found. - write(*,*) "- ",n," - lat=",lat," lon=",lon," value=missing" + if (value .eq. missingValue) then + ! decide what to print if a missing value is found. + write (*, *) "- ", n, " - lat=", lat, " lon=", lon, " value=missing" else - ! or print the value if is not missing. - write(*,*) " ",n," lat=",lat," lon=",lon," value=",value - endif + ! or print the value if is not missing. + write (*, *) " ", n, " lat=", lat, " lon=", lon, " value=", value + end if - n=n+1 + n = n + 1 - call grib_iterator_next(iter,lat,lon,value, iret) + call grib_iterator_next(iter, lat, lon, value, iret) end do - ! At the end the iterator is deleted to free memory. - call grib_iterator_delete(iter) - call codes_release(igrib) + ! At the end the iterator is deleted to free memory. + call grib_iterator_delete(iter) + call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_grib_new_from_file(ifile, igrib, iret) - end do LOOP + end do LOOP - call codes_close_file(ifile) + call codes_close_file(ifile) - end program iterator +end program iterator diff --git a/examples/F90/keys_iterator_fortran.f90 b/examples/F90/keys_iterator_fortran.f90 index 6181948ea..4f4addff5 100644 --- a/examples/F90/keys_iterator_fortran.f90 +++ b/examples/F90/keys_iterator_fortran.f90 @@ -14,55 +14,55 @@ ! ! program keys_iterator - use eccodes - implicit none - integer :: kiter,ifile,igrib,iret - character(len=256) :: key - character(len=256) :: value - character(len=2048) :: all - integer :: len - integer :: grib_count - len=256 + use eccodes + implicit none + integer :: kiter, ifile, igrib, iret + character(len=256) :: key + character(len=256) :: value + character(len=2048) :: all + integer :: len + integer :: grib_count + len = 256 - ifile=5 + ifile = 5 - call codes_open_file(ifile, & - '../../data/regular_latlon_surface.grib1','r') + call codes_open_file(ifile, & + '../../data/regular_latlon_surface.grib1', 'r') - grib_count=0 - ! Loop on all the messages in a file. + grib_count = 0 + ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib) + call codes_grib_new_from_file(ifile, igrib) - do while (igrib .ne. -1) + do while (igrib .ne. -1) - grib_count=grib_count+1 - write(*,'("-- GRIB N.",I4," --")') grib_count + grib_count = grib_count + 1 + write (*, '("-- GRIB N.",I4," --")') grib_count - ! valid name_spaces are ls and mars - call codes_keys_iterator_new(igrib,kiter,'ls') + ! valid name_spaces are ls and mars + call codes_keys_iterator_new(igrib, kiter, 'ls') - if (kiter .eq. -1) then - print *, 'invalid key iterator' - endif + if (kiter .eq. -1) then + print *, 'invalid key iterator' + end if - do - call codes_keys_iterator_next(kiter, iret) + do + call codes_keys_iterator_next(kiter, iret) - if (iret .ne. CODES_SUCCESS) exit + if (iret .ne. CODES_SUCCESS) exit - call codes_keys_iterator_get_name(kiter,key) + call codes_keys_iterator_get_name(kiter, key) - call codes_get(igrib,key,value) - all='|'//trim(key)//'|'//' = '//'|'//trim(value)//'|' - write(*,*) trim(all) + call codes_get(igrib, key, value) + all = '|'//trim(key)//'|'//' = '//'|'//trim(value)//'|' + write (*, *) trim(all) + end do + + call codes_keys_iterator_delete(kiter) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) end do - call codes_keys_iterator_delete(kiter) - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) - end do - - call codes_close_file(ifile) + call codes_close_file(ifile) end program keys_iterator diff --git a/examples/F90/multi_fortran.f90 b/examples/F90/multi_fortran.f90 index f8ecd3f40..b51fc14e2 100644 --- a/examples/F90/multi_fortran.f90 +++ b/examples/F90/multi_fortran.f90 @@ -14,53 +14,53 @@ ! ! program multi - use eccodes - implicit none + use eccodes + implicit none - integer :: iret - integer(kind = 4) :: parameterCategory,parameterNumber,discipline - integer :: ifile,igrib + integer :: iret + integer(kind=4) :: parameterCategory, parameterNumber, discipline + integer :: ifile, igrib - call codes_open_file(ifile, '../../data/multi.grib2','r') + call codes_open_file(ifile, '../../data/multi.grib2', 'r') - ! turn on support for multi fields messages */ - call codes_grib_multi_support_on() + ! turn on support for multi fields messages */ + call codes_grib_multi_support_on() - ! turn off support for multi fields messages */ - !call codes_grib_multi_support_off() + ! turn off support for multi fields messages */ + !call codes_grib_multi_support_off() - call codes_grib_new_from_file(ifile,igrib) - ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib) + ! Loop on all the messages in a file. - do while (igrib .ne. -1) + do while (igrib .ne. -1) - ! get as a integer*4 - call codes_get(igrib,'discipline',discipline) - write(*,*) 'discipline=',discipline + ! get as a integer*4 + call codes_get(igrib, 'discipline', discipline) + write (*, *) 'discipline=', discipline - ! get as a integer*4 - call codes_get(igrib,'parameterCategory', & - parameterCategory) - write(*,*) 'parameterCategory=',parameterCategory + ! get as a integer*4 + call codes_get(igrib, 'parameterCategory', & + parameterCategory) + write (*, *) 'parameterCategory=', parameterCategory - ! get as a integer*4 - call codes_get(igrib,'parameterNumber', & - parameterNumber) - write(*,*) 'parameterNumber=',parameterNumber + ! get as a integer*4 + call codes_get(igrib, 'parameterNumber', & + parameterNumber) + write (*, *) 'parameterNumber=', parameterNumber - if ( discipline .eq. 0 .and. parameterCategory .eq. 2) then - if (parameterNumber .eq. 2) then - write(*,*) "-------- u -------" - endif - if (parameterNumber .eq. 3) then - write(*,*) "-------- v -------" - endif - endif + if (discipline .eq. 0 .and. parameterCategory .eq. 2) then + if (parameterNumber .eq. 2) then + write (*, *) "-------- u -------" + end if + if (parameterNumber .eq. 3) then + write (*, *) "-------- v -------" + end if + end if - call codes_release(igrib) - call codes_grib_new_from_file(ifile,igrib, iret) + call codes_release(igrib) + call codes_grib_new_from_file(ifile, igrib, iret) - end do - call codes_close_file(ifile) + end do + call codes_close_file(ifile) end program multi diff --git a/examples/F90/new_from_file.f90 b/examples/F90/new_from_file.f90 index a80010f4b..d1eecf272 100644 --- a/examples/F90/new_from_file.f90 +++ b/examples/F90/new_from_file.f90 @@ -9,33 +9,32 @@ ! ! program new_from_file -use eccodes - implicit none - integer :: ifile - integer :: iret - integer :: count1=0 + use eccodes + implicit none + integer :: ifile + integer :: iret + integer :: count1 = 0 - ! Message identifier. - integer :: igrib + ! Message identifier. + integer :: igrib - ifile=5 + ifile = 5 - call codes_open_file(ifile,'../../data/collection.grib1','r') + call codes_open_file(ifile, '../../data/collection.grib1', 'r') - ! Loop on all the messages in a file. - call codes_grib_new_from_file(ifile,igrib, iret) + ! Loop on all the messages in a file. + call codes_grib_new_from_file(ifile, igrib, iret) - do while (iret==CODES_SUCCESS) - count1=count1+1 - print *, "===== Message #",count1 - call codes_grib_new_from_file(ifile,igrib, iret) + do while (iret == CODES_SUCCESS) + count1 = count1 + 1 + print *, "===== Message #", count1 + call codes_grib_new_from_file(ifile, igrib, iret) - end do - if (iret /= CODES_END_OF_FILE) then - call codes_check(iret,'new_from_file','') - endif + end do + if (iret /= CODES_END_OF_FILE) then + call codes_check(iret, 'new_from_file', '') + end if - - call codes_close_file(ifile) + call codes_close_file(ifile) end program diff --git a/examples/F90/precision_fortran.f90 b/examples/F90/precision_fortran.f90 index 7481140b6..4a64abf43 100644 --- a/examples/F90/precision_fortran.f90 +++ b/examples/F90/precision_fortran.f90 @@ -11,82 +11,82 @@ ! ! program precision - use eccodes - implicit none - integer(kind = 4) :: size - integer :: infile,outfile - integer :: igrib - real(kind = 8), dimension(:), allocatable :: values1 - real(kind = 8), dimension(:), allocatable :: values2 - real(kind = 8) :: maxa,a,maxv,minv,maxr,r - integer( kind = 4) :: decimalPrecision,bitsPerValue1,bitsPerValue2 - integer :: i, iret + use eccodes + implicit none + integer(kind=4) :: size + integer :: infile, outfile + integer :: igrib + real(kind=8), dimension(:), allocatable :: values1 + real(kind=8), dimension(:), allocatable :: values2 + real(kind=8) :: maxa, a, maxv, minv, maxr, r + integer(kind=4) :: decimalPrecision, bitsPerValue1, bitsPerValue2 + integer :: i, iret - call codes_open_file(infile, & - '../../data/regular_latlon_surface_constant.grib1','r') + call codes_open_file(infile, & + '../../data/regular_latlon_surface_constant.grib1', 'r') - call codes_open_file(outfile, & - '../../data/regular_latlon_surface_prec.grib1','w') + call codes_open_file(outfile, & + '../../data/regular_latlon_surface_prec.grib1', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! bitsPerValue before changing the packing parameters - call codes_get(igrib,'bitsPerValue',bitsPerValue1) + ! bitsPerValue before changing the packing parameters + call codes_get(igrib, 'bitsPerValue', bitsPerValue1) - ! get the size of the values array - call codes_get_size(igrib,"values",size) + ! get the size of the values array + call codes_get_size(igrib, "values", size) - allocate(values1(size), stat=iret) - allocate(values2(size), stat=iret) - ! get data values before changing the packing parameters*/ - call codes_get(igrib,"values",values1) + allocate (values1(size), stat=iret) + allocate (values2(size), stat=iret) + ! get data values before changing the packing parameters*/ + call codes_get(igrib, "values", values1) - ! setting decimal precision=2 means that 2 decimal digits - ! are preserved when packing. - decimalPrecision=2 - call codes_set(igrib,"setDecimalPrecision", & - decimalPrecision) + ! setting decimal precision=2 means that 2 decimal digits + ! are preserved when packing. + decimalPrecision = 2 + call codes_set(igrib, "setDecimalPrecision", & + decimalPrecision) - ! bitsPerValue after changing the packing parameters - call codes_get(igrib,"bitsPerValue",bitsPerValue2) + ! bitsPerValue after changing the packing parameters + call codes_get(igrib, "bitsPerValue", bitsPerValue2) - ! get data values after changing the packing parameters - call codes_get(igrib,"values",values2) + ! get data values after changing the packing parameters + call codes_get(igrib, "values", values2) - ! computing error - maxa=0 - maxr=0 - maxv=values2(1) - minv=maxv - do i=1,size - a=abs(values2(i)-values1(i)) - if ( values2(i) .gt. maxv ) maxv=values2(i) - if ( values2(i) .lt. maxv ) minv=values2(i) - if ( values2(i) .ne. 0 ) then - r=abs((values2(i)-values1(i))/values2(i)) - endif - if ( a .gt. maxa ) maxa=a - if ( r .gt. maxr ) maxr=r - enddo - write(*,*) "max absolute error = ",maxa - write(*,*) "max relative error = ",maxr - write(*,*) "min value = ",minv - write(*,*) "max value = ",maxv + ! computing error + maxa = 0 + maxr = 0 + maxv = values2(1) + minv = maxv + do i = 1, size + a = abs(values2(i) - values1(i)) + if (values2(i) .gt. maxv) maxv = values2(i) + if (values2(i) .lt. maxv) minv = values2(i) + if (values2(i) .ne. 0) then + r = abs((values2(i) - values1(i))/values2(i)) + end if + if (a .gt. maxa) maxa = a + if (r .gt. maxr) maxr = r + end do + write (*, *) "max absolute error = ", maxa + write (*, *) "max relative error = ", maxr + write (*, *) "min value = ", minv + write (*, *) "max value = ", maxv - write(*,*) "old number of bits per value=",bitsPerValue1 - write(*,*) "new number of bits per value=",bitsPerValue2 + write (*, *) "old number of bits per value=", bitsPerValue1 + write (*, *) "new number of bits per value=", bitsPerValue2 - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) - deallocate(values1) - deallocate(values2) + deallocate (values1) + deallocate (values2) end program precision diff --git a/examples/F90/print_data_fortran.f90 b/examples/F90/print_data_fortran.f90 index 731df8947..8283637df 100644 --- a/examples/F90/print_data_fortran.f90 +++ b/examples/F90/print_data_fortran.f90 @@ -13,41 +13,41 @@ ! ! program print_data_fortran -use eccodes -implicit none -integer :: ifile -integer :: igrib -integer :: i -real(kind=8), dimension(:), allocatable :: values -real(kind=8) :: average -real(kind=8) :: max -real(kind=8) :: min + use eccodes + implicit none + integer :: ifile + integer :: igrib + integer :: i + real(kind=8), dimension(:), allocatable :: values + real(kind=8) :: average + real(kind=8) :: max + real(kind=8) :: min - call codes_open_file(ifile, & - '../../data/constant_field.grib1','r') + call codes_open_file(ifile, & + '../../data/constant_field.grib1', 'r') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(ifile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(ifile, igrib) - call codes_get(igrib,'values',values) + call codes_get(igrib, 'values', values) - do i=1,size(values) - write(*,*)' ',i,values(i) - enddo + do i = 1, size(values) + write (*, *) ' ', i, values(i) + end do - write(*,*)size(values),' values found ' + write (*, *) size(values), ' values found ' - call codes_get(igrib,'max',max) - write(*,*) 'max=',max - call codes_get(igrib,'min',min) - write(*,*) 'min=',min - call codes_get(igrib,'average',average) - write(*,*) 'average=',average + call codes_get(igrib, 'max', max) + write (*, *) 'max=', max + call codes_get(igrib, 'min', min) + write (*, *) 'min=', min + call codes_get(igrib, 'average', average) + write (*, *) 'average=', average - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(ifile) + call codes_close_file(ifile) - deallocate(values) + deallocate (values) end program print_data_fortran diff --git a/examples/F90/read_from_file.f90 b/examples/F90/read_from_file.f90 index 112d19f02..3ea16ea9f 100644 --- a/examples/F90/read_from_file.f90 +++ b/examples/F90/read_from_file.f90 @@ -10,88 +10,88 @@ ! See GRIB-292 ! program read_from_file -use eccodes - implicit none - character(len=32) :: input_grib_file - integer,dimension(26) :: message_lengths ! expected message lengths + use eccodes + implicit none + character(len=32) :: input_grib_file + integer, dimension(26) :: message_lengths ! expected message lengths - input_grib_file = '../../data/v.grib2' - message_lengths = (/ 95917, 96963, 97308, 97386, 97215, 97440, 98451, 98629, 98448, & - 99186, 97517, 97466, 99307, 98460,101491, 99361,100292, 96838, & - 91093, 83247, 78244, 74872, 72663, 69305, 69881, 68572 /) + input_grib_file = '../../data/v.grib2' + message_lengths = (/95917, 96963, 97308, 97386, 97215, 97440, 98451, 98629, 98448, & + 99186, 97517, 97466, 99307, 98460, 101491, 99361, 100292, 96838, & + 91093, 83247, 78244, 74872, 72663, 69305, 69881, 68572/) - ! Get the grib message length using two different interfaces - call read_using_size_t() - call read_using_integer() - print *,'Passed' + ! Get the grib message length using two different interfaces + call read_using_size_t() + call read_using_integer() + print *, 'Passed' contains !====================================== -subroutine read_using_size_t - implicit none - integer :: size,intsize - parameter (intsize=100000,size=intsize*4) - integer :: ifile - integer :: iret - integer :: count1=0 - integer(kind=4),dimension(intsize) :: buffer - integer(kind=kindOfSize_t) :: len1 ! For large messages + subroutine read_using_size_t + implicit none + integer :: size, intsize + parameter(intsize=100000, size=intsize*4) + integer :: ifile + integer :: iret + integer :: count1 = 0 + integer(kind=4), dimension(intsize) :: buffer + integer(kind=kindOfSize_t) :: len1 ! For large messages - ifile=5 - call codes_open_file(ifile, input_grib_file, 'r') + ifile = 5 + call codes_open_file(ifile, input_grib_file, 'r') - len1=size - call codes_read_from_file(ifile, buffer, len1, iret) + len1 = size + call codes_read_from_file(ifile, buffer, len1, iret) - do while (iret==CODES_SUCCESS) - count1=count1+1 - if (len1 /= message_lengths(count1)) then - write(*,'(a,i3,a,i8,a,i8)') 'Error: Message #',count1,' length=', len1,'. Expected=',message_lengths(count1) - stop - end if - len1=size - call codes_read_from_file(ifile, buffer, len1, iret) - end do + do while (iret == CODES_SUCCESS) + count1 = count1 + 1 + if (len1 /= message_lengths(count1)) then + write (*, '(a,i3,a,i8,a,i8)') 'Error: Message #', count1, ' length=', len1, '. Expected=', message_lengths(count1) + stop + end if + len1 = size + call codes_read_from_file(ifile, buffer, len1, iret) + end do - if (iret/=CODES_END_OF_FILE) then - call codes_check(iret,'read_from_file','') - endif - call codes_close_file(ifile) + if (iret /= CODES_END_OF_FILE) then + call codes_check(iret, 'read_from_file', '') + end if + call codes_close_file(ifile) -end subroutine read_using_size_t + end subroutine read_using_size_t !====================================== -subroutine read_using_integer - implicit none - integer :: size,intsize - parameter (intsize=100000,size=intsize*4) - integer :: ifile - integer :: iret - integer :: count1=0 - integer(kind=4),dimension(intsize) :: buffer - integer :: len1 + subroutine read_using_integer + implicit none + integer :: size, intsize + parameter(intsize=100000, size=intsize*4) + integer :: ifile + integer :: iret + integer :: count1 = 0 + integer(kind=4), dimension(intsize) :: buffer + integer :: len1 - ifile=5 - call codes_open_file(ifile, input_grib_file, 'r') + ifile = 5 + call codes_open_file(ifile, input_grib_file, 'r') - len1=size - call codes_read_from_file(ifile, buffer, len1, iret) + len1 = size + call codes_read_from_file(ifile, buffer, len1, iret) - do while (iret==CODES_SUCCESS) - count1=count1+1 - if (len1 /= message_lengths(count1)) then - write(*,'(a,i3,a,i8,a,i8)') 'Error: Message #',count1,' length=', len1,'. Expected=',message_lengths(count1) - stop - end if - len1=size - call codes_read_from_file(ifile, buffer, len1, iret) - end do + do while (iret == CODES_SUCCESS) + count1 = count1 + 1 + if (len1 /= message_lengths(count1)) then + write (*, '(a,i3,a,i8,a,i8)') 'Error: Message #', count1, ' length=', len1, '. Expected=', message_lengths(count1) + stop + end if + len1 = size + call codes_read_from_file(ifile, buffer, len1, iret) + end do - if (iret/=CODES_END_OF_FILE) then - call codes_check(iret,'read_from_file','') - endif - call codes_close_file(ifile) + if (iret /= CODES_END_OF_FILE) then + call codes_check(iret, 'read_from_file', '') + end if + call codes_close_file(ifile) -end subroutine read_using_integer + end subroutine read_using_integer !====================================== end program diff --git a/examples/F90/set_fortran.f90 b/examples/F90/set_fortran.f90 index d976c1256..7e3f4ad2f 100644 --- a/examples/F90/set_fortran.f90 +++ b/examples/F90/set_fortran.f90 @@ -10,49 +10,49 @@ ! ! program set - use eccodes - implicit none + use eccodes + implicit none - integer(kind = 4) :: centre - integer(kind = 4) :: int_value - character(len = 10) :: string_value - character(len = 20) :: string_centre - integer :: infile,outfile - integer :: igrib + integer(kind=4) :: centre + integer(kind=4) :: int_value + character(len=10) :: string_value + character(len=20) :: string_centre + integer :: infile, outfile + integer :: igrib - infile=5 - outfile=6 + infile = 5 + outfile = 6 - call codes_open_file(infile, & - '../../data/regular_latlon_surface_constant.grib1','r') + call codes_open_file(infile, & + '../../data/regular_latlon_surface_constant.grib1', 'r') - call codes_open_file(outfile, & - '../../data/out.grib1','w') + call codes_open_file(outfile, & + '../../data/out.grib1', 'w') - ! A new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! A new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - ! set centre as a long */ - centre=80 - call codes_set(igrib,'centre',centre) + ! set centre as a long */ + centre = 80 + call codes_set(igrib, 'centre', centre) - ! get centre as a integer*4 - call codes_get(igrib,'centre',int_value) - write(*,*) 'centre=',int_value + ! get centre as a integer*4 + call codes_get(igrib, 'centre', int_value) + write (*, *) 'centre=', int_value - ! get centre as a string - call codes_get(igrib,'centre',string_value) - string_centre='centre='//string_value - write(*,*) string_centre + ! get centre as a string + call codes_get(igrib, 'centre', string_value) + string_centre = 'centre='//string_value + write (*, *) string_centre - ! write modified message to a file - call codes_write(igrib,outfile) + ! write modified message to a file + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) end program set diff --git a/examples/F90/set_missing_fortran.f90 b/examples/F90/set_missing_fortran.f90 index afb1cbd73..17379f2c8 100644 --- a/examples/F90/set_missing_fortran.f90 +++ b/examples/F90/set_missing_fortran.f90 @@ -10,34 +10,34 @@ ! ! program set - use eccodes - implicit none - integer :: infile,outfile - integer :: igrib + use eccodes + implicit none + integer :: infile, outfile + integer :: igrib - infile=5 - outfile=6 + infile = 5 + outfile = 6 - call codes_open_file(infile, & - '../../data/reduced_gaussian_pressure_level.grib2','r') + call codes_open_file(infile, & + '../../data/reduced_gaussian_pressure_level.grib2', 'r') - call codes_open_file(outfile, & - 'out_surface_level.grib2','w') + call codes_open_file(outfile, & + 'out_surface_level.grib2', 'w') - ! a new grib message is loaded from file - ! igrib is the grib id to be used in subsequent calls - call codes_grib_new_from_file(infile,igrib) + ! a new grib message is loaded from file + ! igrib is the grib id to be used in subsequent calls + call codes_grib_new_from_file(infile, igrib) - call codes_set(igrib,'typeOfFirstFixedSurface','sfc') - call codes_set_missing(igrib,'scaleFactorOfFirstFixedSurface') - call codes_set_missing(igrib,'scaledValueOfFirstFixedSurface') + call codes_set(igrib, 'typeOfFirstFixedSurface', 'sfc') + call codes_set_missing(igrib, 'scaleFactorOfFirstFixedSurface') + call codes_set_missing(igrib, 'scaledValueOfFirstFixedSurface') - call codes_write(igrib,outfile) + call codes_write(igrib, outfile) - call codes_release(igrib) + call codes_release(igrib) - call codes_close_file(infile) + call codes_close_file(infile) - call codes_close_file(outfile) + call codes_close_file(outfile) end program set diff --git a/examples/python/grib_iterator.c b/examples/python/grib_iterator.c index 94d6987bf..07e18649a 100644 --- a/examples/python/grib_iterator.c +++ b/examples/python/grib_iterator.c @@ -11,78 +11,85 @@ /* * C Implementation: grib_iterator * - * Description: how to use an iterator on lat/lon/values. + * Description: how to use an iterator on lat/lon/values for GRIB messages * */ #include #include -#include -#include "grib_api.h" +#include "grib_api.h" -static void usage(const char* prog) { - printf("Usage: %s grib_file\n",prog); - exit(1); +static void usage(const char* prog) +{ + printf("Usage: %s grib_file\n", prog); + exit(1); } -int main(int argc, char** argv) { - FILE* in = NULL; - int err = 0; - double lat,lon,value; +int main(int argc, char** argv) +{ + FILE* in = NULL; + int err = 0; + double lat, lon, value; double missingValue = 1e+20; /* A value out of range */ - int n=0; - char* filename = NULL; + int n = 0; + long bitmapPresent = 0; + char* filename = NULL; - /* Message handle. Required in all the grib_api calls acting on a message.*/ - grib_handle *h = NULL; - /* Iterator on lat/lon/values.*/ - grib_iterator* iter=NULL; + /* Message handle. Required in all the ecCodes calls acting on a message.*/ + grib_handle* h = NULL; + /* Iterator on lat/lon/values.*/ + grib_iterator* iter = NULL; - if (argc != 2) usage(argv[0]); + if (argc != 2) usage(argv[0]); - filename=strdup(argv[1]); + filename = argv[1]; - in = fopen(filename,"rb"); - if(!in) { - printf("ERROR: unable to open file %s\n",filename); - return 1; - } + in = fopen(filename, "rb"); + if (!in) { + fprintf(stderr, "Error: unable to open file %s\n", filename); + return 1; + } - /* Loop on all the messages in a file.*/ - while ((h = grib_handle_new_from_file(0,in,&err)) != NULL ) { - /* Check of errors after reading a message. */ - if (err != GRIB_SUCCESS) GRIB_CHECK(err,0); + /* Loop on all the messages in a file.*/ + while ((h = grib_handle_new_from_file(0, in, &err)) != NULL) { + /* Check of errors after reading a message. */ + if (err != GRIB_SUCCESS) GRIB_CHECK(err, 0); - /* Set the double representing the missing value in the field. */ - /* Choose a missingValue that does not correspond to any real value in the data array */ - GRIB_CHECK(grib_set_double(h, "missingValue", missingValue),0); + /* Check if a bitmap applies */ + GRIB_CHECK(grib_get_long(h, "bitmapPresent", &bitmapPresent), 0); - /* A new iterator on lat/lon/values is created from the message handle h. */ - iter=grib_iterator_new(h,0,&err); - if (err != GRIB_SUCCESS) GRIB_CHECK(err,0); + if (bitmapPresent) { + /* Set the double representing the missing value in the field. */ + /* Choose a missingValue that does not correspond to any real value in the data array */ + GRIB_CHECK(grib_set_double(h, "missingValue", missingValue), 0); + } - n = 0; - /* Loop on all the lat/lon/values. */ - while(grib_iterator_next(iter,&lat,&lon,&value)) { - /* You can now print lat and lon, */ - printf("- %d - lat=%.6e lon=%.6e value=",n,lat,lon); - /* decide what to print if a missing value is found. */ - if (value == missingValue ) printf("missing\n"); - /* and print the value if is not missing. */ - else printf("%f\n",value); - n++; - } + /* A new iterator on lat/lon/values is created from the message handle h. */ + iter = grib_iterator_new(h, 0, &err); + if (err != GRIB_SUCCESS) GRIB_CHECK(err, 0); - /* At the end the iterator is deleted to free memory. */ - grib_iterator_delete(iter); + n = 0; + /* Loop on all the lat/lon/values. */ + while (grib_iterator_next(iter, &lat, &lon, &value)) { + /* You can now print lat and lon, */ + printf("- %d - lat=%.6e lon=%.6e value=", n, lat, lon); + /* decide what to print if a missing value is found. */ + if (bitmapPresent && value == missingValue) printf("missing\n"); + /* and print the value if is not missing. */ + else + printf("%f\n", value); + n++; + } - /* At the end the grib_handle is deleted to free memory. */ - grib_handle_delete(h); - } + /* At the end the iterator is deleted to free memory. */ + grib_iterator_delete(iter); + /* At the end the grib_handle is deleted to free memory. */ + grib_handle_delete(h); + } - fclose(in); + fclose(in); - return 0; + return 0; } diff --git a/examples/python/grib_iterator.py b/examples/python/grib_iterator.py index cdb984eea..2c7d5ede8 100644 --- a/examples/python/grib_iterator.py +++ b/examples/python/grib_iterator.py @@ -19,16 +19,19 @@ missingValue = 1e+20 # A value out of range def example(INPUT): - f = open(INPUT, 'rb') + f = open(INPUT, "rb") while 1: gid = codes_grib_new_from_file(f) if gid is None: break - # Set the value representing the missing value in the field. - # Choose a missingValue that does not correspond to any real value in the data array - codes_set(gid, "missingValue", missingValue) + bitmapPresent = codes_get(gid, "bitmapPresent") + + if bitmapPresent: + # Set the value representing the missing value in the field. + # Choose a missingValue that does not correspond to any real value in the data array + codes_set(gid, "missingValue", missingValue) iterid = codes_grib_iterator_new(gid, 0) @@ -42,7 +45,7 @@ def example(INPUT): sys.stdout.write("- %d - lat=%.6e lon=%.6e value=" % (i, lat, lon)) - if value == missingValue: + if bitmapPresent and value == missingValue: print("missing") else: print("%.6f" % value) diff --git a/fortran/eccodes_f90_head.f90 b/fortran/eccodes_f90_head.f90 index 36e73b40d..2373e288c 100644 --- a/fortran/eccodes_f90_head.f90 +++ b/fortran/eccodes_f90_head.f90 @@ -17,13 +17,12 @@ module eccodes include "eccodes_visibility.h" include "eccodes_settings.h" - real(8), parameter,public :: CODES_MISSING_DOUBLE = -1.D+100 - integer(4), parameter,public :: CODES_MISSING_LONG = 2147483647 - - integer, parameter,public :: CODES_PRODUCT_ANY = 0 - integer, parameter,public :: CODES_PRODUCT_GRIB = 1 - integer, parameter,public :: CODES_PRODUCT_BUFR = 2 + real(8), parameter, public :: CODES_MISSING_DOUBLE = -1.D+100 + integer(4), parameter, public :: CODES_MISSING_LONG = 2147483647 + integer, parameter, public :: CODES_PRODUCT_ANY = 0 + integer, parameter, public :: CODES_PRODUCT_GRIB = 1 + integer, parameter, public :: CODES_PRODUCT_BUFR = 2 !> Create a new message in memory from an integer or character array containting the coded message. !> @@ -42,8 +41,8 @@ module eccodes !> @param message array containing the coded message !> @param status CODES_SUCCESS if OK, integer value on error interface codes_new_from_message - module procedure codes_new_from_message_int4 - module procedure codes_new_from_message_char + module procedure codes_new_from_message_int4 + module procedure codes_new_from_message_char end interface codes_new_from_message !> Get a value of specified index from an array key. @@ -70,9 +69,9 @@ module eccodes !> @param[out] status CODES_SUCCESS if OK, integer value on error interface codes_get_element module procedure codes_get_real4_element, & - codes_get_real8_element, & - codes_get_real4_elements, & - codes_get_real8_elements + codes_get_real8_element, & + codes_get_real4_elements, & + codes_get_real8_elements end interface codes_get_element !> Find the nearest point/points of a given latitude/longitude point. @@ -113,8 +112,8 @@ module eccodes !> @param[out] status CODES_SUCCESS if OK, integer value on error interface codes_grib_find_nearest module procedure codes_grib_find_nearest_single, & - codes_grib_find_nearest_four_single, & - codes_grib_find_nearest_multiple + codes_grib_find_nearest_four_single, & + codes_grib_find_nearest_multiple end interface codes_grib_find_nearest !> Get latitude/longitude and data values. @@ -136,5 +135,5 @@ module eccodes !> @param[out] values data values array with dimension "size" interface codes_grib_get_data module procedure codes_grib_get_data_real4, & - codes_grib_get_data_real8 + codes_grib_get_data_real8 end interface codes_grib_get_data diff --git a/fortran/eccodes_f90_int.f90 b/fortran/eccodes_f90_int.f90 index f3062c6e4..6f1aa7964 100644 --- a/fortran/eccodes_f90_int.f90 +++ b/fortran/eccodes_f90_int.f90 @@ -2,11 +2,10 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. - !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. !> !> @@ -22,8 +21,8 @@ !> @param status CODES_SUCCESS if OK, integer value on error interface codes_index_get module procedure codes_index_get_int, & - codes_index_get_string, & - codes_index_get_real8 + codes_index_get_string, & + codes_index_get_real8 end interface codes_index_get !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. @@ -40,10 +39,10 @@ !> @param size number of distinct values of the key in the index !> @param status CODES_SUCCESS if OK, integer value on error interface codes_index_get_size - module procedure codes_index_get_size_int + module procedure codes_index_get_size_int end interface codes_index_get_size - - !> Select the message subset with key==value. + + !> Select the message subset with key==value. !> !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -58,8 +57,8 @@ !> @param status CODES_SUCCESS if OK, integer value on error interface codes_index_select module procedure codes_index_select_int, & - codes_index_select_string, & - codes_index_select_real8 + codes_index_select_string, & + codes_index_select_real8 end interface codes_index_select !> Get the value for a key from a message. @@ -96,15 +95,14 @@ !> @param[out] status CODES_SUCCESS if OK, integer value on error interface codes_get module procedure codes_get_int, & - codes_get_real4, & - codes_get_real8, & - codes_get_string, & - codes_get_byte_array, & - codes_get_int_array, & - codes_get_real4_array, & - codes_get_real8_array + codes_get_real4, & + codes_get_real8, & + codes_get_string, & + codes_get_byte_array, & + codes_get_int_array, & + codes_get_real4_array, & + codes_get_real8_array end interface codes_get - !> Get the size of an array key. !> @@ -119,7 +117,7 @@ !> @param size size of the array key !> @param status CODES_SUCCESS if OK, integer value on error interface codes_get_size - module procedure codes_get_size_int + module procedure codes_get_size_int end interface codes_get_size !> Set the value for a key in a message. @@ -147,17 +145,17 @@ !> @param[out] status CODES_SUCCESS if OK, integer value on error interface codes_set module procedure codes_set_int, & - codes_set_real4, & - codes_set_real8, & - codes_set_string, & - codes_set_int_array, & - codes_set_byte_array, & - codes_set_real4_array, & - codes_set_real8_array + codes_set_real4, & + codes_set_real8, & + codes_set_string, & + codes_set_int_array, & + codes_set_byte_array, & + codes_set_real4_array, & + codes_set_real8_array end interface codes_set interface codes_set_force module procedure codes_set_force_real4_array, & - codes_set_force_real8_array + codes_set_force_real8_array end interface codes_set_force diff --git a/fortran/eccodes_f90_int_size_t.f90 b/fortran/eccodes_f90_int_size_t.f90 index b33bc5617..f795b5bad 100644 --- a/fortran/eccodes_f90_int_size_t.f90 +++ b/fortran/eccodes_f90_int_size_t.f90 @@ -17,8 +17,8 @@ !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error interface codes_read_from_file - module procedure codes_read_from_file_int4 - module procedure codes_read_from_file_char + module procedure codes_read_from_file_int4 + module procedure codes_read_from_file_char end interface codes_read_from_file !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. @@ -32,10 +32,10 @@ !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error interface codes_read_bytes - module procedure codes_read_bytes_int4 - module procedure codes_read_bytes_char - module procedure codes_read_bytes_real8 - module procedure codes_read_bytes_real4 + module procedure codes_read_bytes_int4 + module procedure codes_read_bytes_char + module procedure codes_read_bytes_real8 + module procedure codes_read_bytes_real4 end interface codes_read_bytes !> Write nbytes bytes from the buffer in a file opened with codes_open_file. @@ -49,10 +49,10 @@ !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error interface codes_write_bytes - module procedure codes_write_bytes_int4 - module procedure codes_write_bytes_char - module procedure codes_write_bytes_real8 - module procedure codes_write_bytes_real4 + module procedure codes_write_bytes_int4 + module procedure codes_write_bytes_char + module procedure codes_write_bytes_real8 + module procedure codes_write_bytes_real4 end interface codes_write_bytes !> Get the size of a coded message. diff --git a/fortran/eccodes_f90_long_int.f90 b/fortran/eccodes_f90_long_int.f90 index abb465493..937e4aad8 100644 --- a/fortran/eccodes_f90_long_int.f90 +++ b/fortran/eccodes_f90_long_int.f90 @@ -2,11 +2,10 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. - !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. !> !> @@ -22,9 +21,9 @@ !> @param status CODES_SUCCESS if OK, integer value on error interface codes_index_get module procedure codes_index_get_int, & - codes_index_get_long, & - codes_index_get_string, & - codes_index_get_real8 + codes_index_get_long, & + codes_index_get_string, & + codes_index_get_real8 end interface codes_index_get !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. @@ -41,10 +40,10 @@ !> @param status CODES_SUCCESS if OK, integer value on error interface codes_index_get_size module procedure codes_index_get_size_int, & - codes_index_get_size_long + codes_index_get_size_long end interface codes_index_get_size - - !> Select the message subset with key==value. + + !> Select the message subset with key==value. !> !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -59,11 +58,11 @@ !> @param status CODES_SUCCESS if OK, integer value on error interface codes_index_select module procedure codes_index_select_int, & - codes_index_select_long, & - codes_index_select_string, & - codes_index_select_real8 + codes_index_select_long, & + codes_index_select_string, & + codes_index_select_real8 end interface codes_index_select - + !> Get the value for a key from a message. !> !> Given a \em msgid and \em key as input a \em value for the \em key is returned. @@ -96,14 +95,14 @@ !> @param[out] status CODES_SUCCESS if OK, integer value on error interface codes_get module procedure codes_get_int, & - codes_get_long, & - codes_get_real4, & - codes_get_real8, & - codes_get_string, & - codes_get_byte_array, & - codes_get_int_array, & - codes_get_real4_array, & - codes_get_real8_array + codes_get_long, & + codes_get_real4, & + codes_get_real8, & + codes_get_string, & + codes_get_byte_array, & + codes_get_int_array, & + codes_get_real4_array, & + codes_get_real8_array end interface codes_get !> Get the size of an array key. @@ -119,8 +118,8 @@ !> @param size size of the array key !> @param status CODES_SUCCESS if OK, integer value on error interface codes_get_size - module procedure codes_get_size_int, & - codes_get_size_long + module procedure codes_get_size_int, & + codes_get_size_long end interface codes_get_size !> Set the value for a key in a message. @@ -148,19 +147,19 @@ !> @param[out] status CODES_SUCCESS if OK, integer value on error interface codes_set module procedure codes_set_int, & - codes_set_long, & - codes_set_real4, & - codes_set_real8, & - codes_set_string, & - codes_set_int_array, & - codes_set_long_array, & - codes_set_byte_array, & - codes_set_real4_array, & - codes_set_real8_array + codes_set_long, & + codes_set_real4, & + codes_set_real8, & + codes_set_string, & + codes_set_int_array, & + codes_set_long_array, & + codes_set_byte_array, & + codes_set_real4_array, & + codes_set_real8_array end interface codes_set interface codes_set_force module procedure codes_set_force_real4_array, & - codes_set_force_real8_array + codes_set_force_real8_array end interface codes_set_force diff --git a/fortran/eccodes_f90_long_size_t.f90 b/fortran/eccodes_f90_long_size_t.f90 index 282d3cf89..ea954d322 100644 --- a/fortran/eccodes_f90_long_size_t.f90 +++ b/fortran/eccodes_f90_long_size_t.f90 @@ -17,10 +17,10 @@ !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error interface codes_read_from_file - module procedure codes_read_from_file_int4 - module procedure codes_read_from_file_int4_size_t - module procedure codes_read_from_file_char - module procedure codes_read_from_file_char_size_t + module procedure codes_read_from_file_int4 + module procedure codes_read_from_file_int4_size_t + module procedure codes_read_from_file_char + module procedure codes_read_from_file_char_size_t end interface codes_read_from_file !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. @@ -34,14 +34,14 @@ !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error interface codes_read_bytes - module procedure codes_read_bytes_int4 - module procedure codes_read_bytes_int4_size_t - module procedure codes_read_bytes_char - module procedure codes_read_bytes_char_size_t - module procedure codes_read_bytes_real8 - module procedure codes_read_bytes_real8_size_t - module procedure codes_read_bytes_real4 - module procedure codes_read_bytes_real4_size_t + module procedure codes_read_bytes_int4 + module procedure codes_read_bytes_int4_size_t + module procedure codes_read_bytes_char + module procedure codes_read_bytes_char_size_t + module procedure codes_read_bytes_real8 + module procedure codes_read_bytes_real8_size_t + module procedure codes_read_bytes_real4 + module procedure codes_read_bytes_real4_size_t end interface codes_read_bytes !> Write nbytes bytes from the buffer in a file opened with codes_open_file. @@ -55,14 +55,14 @@ !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error interface codes_write_bytes - module procedure codes_write_bytes_int4 - module procedure codes_write_bytes_int4_size_t - module procedure codes_write_bytes_char - module procedure codes_write_bytes_char_size_t - module procedure codes_write_bytes_real8 - module procedure codes_write_bytes_real8_size_t - module procedure codes_write_bytes_real4 - module procedure codes_write_bytes_real4_size_t + module procedure codes_write_bytes_int4 + module procedure codes_write_bytes_int4_size_t + module procedure codes_write_bytes_char + module procedure codes_write_bytes_char_size_t + module procedure codes_write_bytes_real8 + module procedure codes_write_bytes_real8_size_t + module procedure codes_write_bytes_real4 + module procedure codes_write_bytes_real4_size_t end interface codes_write_bytes !> Get the size of a coded message. diff --git a/fortran/eccodes_f90_tail.f90 b/fortran/eccodes_f90_tail.f90 index 31a8e73ee..a4672d204 100644 --- a/fortran/eccodes_f90_tail.f90 +++ b/fortran/eccodes_f90_tail.f90 @@ -19,13 +19,13 @@ !> @param id ID of the message loaded in memory !> @param key key name !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_missing ( id, key, status ) - integer(kind=kindOfInt), intent(in) :: id - character(len=*), intent(in) :: key - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_missing(id, key, status) + integer(kind=kindOfInt), intent(in) :: id + character(len=*), intent(in) :: key + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_missing ( id, key, status ) -end subroutine codes_set_missing + call grib_set_missing(id, key, status) + end subroutine codes_set_missing !> Create a new index form a file. The file is indexed with the keys in argument. !> @@ -41,14 +41,14 @@ end subroutine codes_set_missing !> The type of the key can be explicitly declared appending :l for long (or alternatively :i), :d for double, :s for string to the key name. !> If the type is not declared explicitly, the native type is assumed. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_create ( indexid, filename, keys, status ) - integer(kind=kindOfInt), intent(inout) :: indexid + subroutine codes_index_create(indexid, filename, keys, status) + integer(kind=kindOfInt), intent(inout) :: indexid character(len=*), intent(in) :: filename character(len=*), intent(in) :: keys - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_create ( indexid, filename, keys, status ) -end subroutine codes_index_create + call grib_index_create(indexid, filename, keys, status) + end subroutine codes_index_create !> Add a file to an index. !> @@ -61,13 +61,13 @@ end subroutine codes_index_create !> @param indexid id of the index I want to add a file to !> @param filename name of the file I want to add to the index !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_add_file ( indexid, filename, status ) + subroutine codes_index_add_file(indexid, filename, status) integer(kind=kindOfInt), intent(in) :: indexid character(len=*), intent(in) :: filename - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_add_file ( indexid, filename, status ) -end subroutine codes_index_add_file + call grib_index_add_file(indexid, filename, status) + end subroutine codes_index_add_file !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. !> @@ -81,14 +81,14 @@ end subroutine codes_index_add_file !> @param key key for which the number of values is computed !> @param size number of distinct values of the key in the index !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_get_size_long( indexid, key, size, status ) - integer(kind=kindOfInt), intent(in) :: indexid + subroutine codes_index_get_size_long(indexid, key, size, status) + integer(kind=kindOfInt), intent(in) :: indexid character(len=*), intent(in) :: key - integer(kind=kindOfLong), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfLong), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_get_size_long( indexid, key, size, status ) -end subroutine codes_index_get_size_long + call grib_index_get_size_long(indexid, key, size, status) + end subroutine codes_index_get_size_long !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. !> @@ -102,14 +102,14 @@ end subroutine codes_index_get_size_long !> @param key key for which the number of values is computed !> @param size number of distinct values of the key in the index !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_get_size_int( indexid, key, size, status ) - integer(kind=kindOfInt), intent(in) :: indexid + subroutine codes_index_get_size_int(indexid, key, size, status) + integer(kind=kindOfInt), intent(in) :: indexid character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_get_size_int( indexid, key, size, status ) -end subroutine codes_index_get_size_int + call grib_index_get_size_int(indexid, key, size, status) + end subroutine codes_index_get_size_int !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. This function is used when the type of the key was explicitly defined as long or when the native type of the key is long. !> @@ -124,14 +124,14 @@ end subroutine codes_index_get_size_int !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_get_int( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_get_int(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key integer(kind=kindOfInt), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_get_int( indexid, key, values, status ) -end subroutine codes_index_get_int + call grib_index_get_int(indexid, key, values, status) + end subroutine codes_index_get_int !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. This function is used when the type of the key was explicitly defined as long or when the native type of the key is long. !> @@ -146,14 +146,14 @@ end subroutine codes_index_get_int !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_get_long( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_get_long(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key integer(kind=kindOfLong), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_get_long( indexid, key, values, status ) -end subroutine codes_index_get_long + call grib_index_get_long(indexid, key, values, status) + end subroutine codes_index_get_long !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. This function is used when the type of the key was explicitly defined as long or when the native type of the key is long. !> @@ -168,17 +168,17 @@ end subroutine codes_index_get_long !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_get_real8( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_get_real8(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key real(kind=kindOfDouble), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_get_real8( indexid, key, values, status ) -end subroutine codes_index_get_real8 + call grib_index_get_real8(indexid, key, values, status) + end subroutine codes_index_get_real8 - !> Get the distinct values of the key in argument contained in the index. - !> The key must belong to the index. + !> Get the distinct values of the key in argument contained in the index. + !> The key must belong to the index. !> This function is used when the type of the key was explicitly defined as string or when the native type of the key is string. !> !> @@ -192,16 +192,16 @@ end subroutine codes_index_get_real8 !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_get_string( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_get_string(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key character(len=*), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_get_string( indexid, key, values, status ) -end subroutine codes_index_get_string + call grib_index_get_string(indexid, key, values, status) + end subroutine codes_index_get_string - !> Select the message subset with key==value. The value is a integer. + !> Select the message subset with key==value. The value is a integer. !> The key must have been created with string type or have string as native type if the type was not explicitly defined in the index creation. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -214,14 +214,14 @@ end subroutine codes_index_get_string !> @param key key to be selected !> @param value value of the key to select !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_select_string( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_select_string(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key character(len=*), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_select_string( indexid, key, value, status ) -end subroutine codes_index_select_string + call grib_index_select_string(indexid, key, value, status) + end subroutine codes_index_select_string !> Select the message subset with key==value. The value is a integer. The key must have been created with integer type or have integer as native type if the type was not explicitly defined in the index creation. !> @@ -236,14 +236,14 @@ end subroutine codes_index_select_string !> @param key key to be selected !> @param value value of the key to select !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_select_int( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_select_int(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key integer(kind=kindOfInt), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_select_int( indexid, key, value, status ) -end subroutine codes_index_select_int + call grib_index_select_int(indexid, key, value, status) + end subroutine codes_index_select_int !> Select the message subset with key==value. The value is a integer. The key must have been created with integer type or have integer as native type if the type was not explicitly defined in the index creation. !> @@ -258,14 +258,14 @@ end subroutine codes_index_select_int !> @param key key to be selected !> @param value value of the key to select !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_select_long( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_select_long(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key integer(kind=kindOfLong), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_select_long( indexid, key, value, status ) -end subroutine codes_index_select_long + call grib_index_select_long(indexid, key, value, status) + end subroutine codes_index_select_long !> Select the message subset with key==value. The value is a real. The key must have been created with real type or have real as native type if the type was not explicitly defined in the index creation. !> @@ -280,14 +280,14 @@ end subroutine codes_index_select_long !> @param key key to be selected !> @param value value of the key to select !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_select_real8( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine codes_index_select_real8(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key real(kind=kindOfDouble), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_select_real8( indexid, key, value, status ) -end subroutine codes_index_select_real8 + call grib_index_select_real8(indexid, key, value, status) + end subroutine codes_index_select_real8 !> Create a new handle from an index after having selected the key values. !> All the keys belonging to the index must be selected before calling this function. Successive calls to this function will return all the handles compatible with the constraints defined selecting the values of the index keys. @@ -301,13 +301,13 @@ end subroutine codes_index_select_real8 !> @param indexid id of an index created from a file. !> @param msgid id of the message loaded in memory !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_new_from_index ( indexid, msgid , status) - integer(kind=kindOfInt),intent(in) :: indexid - integer(kind=kindOfInt),intent(out) :: msgid - integer(kind=kindOfInt),optional,intent(out) :: status + subroutine codes_new_from_index(indexid, msgid, status) + integer(kind=kindOfInt), intent(in) :: indexid + integer(kind=kindOfInt), intent(out) :: msgid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_new_from_index ( indexid, msgid , status) -end subroutine codes_new_from_index + call grib_new_from_index(indexid, msgid, status) + end subroutine codes_new_from_index !> Load an index file previously created with @ref codes_index_write. !> @@ -321,13 +321,13 @@ end subroutine codes_new_from_index !> @param indexid id of loaded index !> @param filename name of the index file to load !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_read ( indexid, filename, status ) - integer(kind=kindOfInt), intent(inout) :: indexid + subroutine codes_index_read(indexid, filename, status) + integer(kind=kindOfInt), intent(inout) :: indexid character(len=*), intent(in) :: filename - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_read ( indexid, filename, status ) -end subroutine codes_index_read + call grib_index_read(indexid, filename, status) + end subroutine codes_index_read !> Saves an index to a file for later reuse. Index files can be read with !> @ref codes_index_read. @@ -341,13 +341,13 @@ end subroutine codes_index_read !> @param indexid id of the index to save to file !> @param filename name of file to save the index to !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_write ( indexid, filename, status ) - integer(kind=kindOfInt), intent(inout) :: indexid + subroutine codes_index_write(indexid, filename, status) + integer(kind=kindOfInt), intent(inout) :: indexid character(len=*), intent(in) :: filename - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_write ( indexid, filename, status ) -end subroutine codes_index_write + call grib_index_write(indexid, filename, status) + end subroutine codes_index_write !> Delete the index. !> @@ -358,12 +358,12 @@ end subroutine codes_index_write !> !> @param indexid id of an index created from a file. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_index_release ( indexid, status ) - integer(kind=kindOfInt), intent(in) :: indexid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_index_release(indexid, status) + integer(kind=kindOfInt), intent(in) :: indexid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_index_release ( indexid, status ) -end subroutine codes_index_release + call grib_index_release(indexid, status) + end subroutine codes_index_release !> Open a file according to a mode. !> @@ -377,14 +377,14 @@ end subroutine codes_index_release !> @param filename name of the file to be open !> @param mode open mode can be 'r' (read), 'w' (write) or 'a' (append) !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_open_file ( ifile, filename, mode, status ) - integer(kind=kindOfInt),intent(out) :: ifile + subroutine codes_open_file(ifile, filename, mode, status) + integer(kind=kindOfInt), intent(out) :: ifile character(len=*), intent(in) :: filename character(LEN=*), intent(in) :: mode - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_open_file ( ifile, filename, mode, status ) -end subroutine codes_open_file + call grib_open_file(ifile, filename, mode, status) + end subroutine codes_open_file !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -397,14 +397,14 @@ end subroutine codes_open_file !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_char ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_char(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_char ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_char + call grib_read_bytes_char(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_char !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -418,14 +418,14 @@ end subroutine codes_read_bytes_char !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_char_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_char_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_char_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_char_size_t + call grib_read_bytes_char_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_char_size_t !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -439,14 +439,14 @@ end subroutine codes_read_bytes_char_size_t !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_int4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_int4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_int4 ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_int4 + call grib_read_bytes_int4(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_int4 !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -460,14 +460,14 @@ end subroutine codes_read_bytes_int4 !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_int4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_int4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_int4_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_int4_size_t + call grib_read_bytes_int4_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_int4_size_t !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -479,14 +479,14 @@ end subroutine codes_read_bytes_int4_size_t !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_real4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_real4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_real4 ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_real4 + call grib_read_bytes_real4(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_real4 !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -500,14 +500,14 @@ end subroutine codes_read_bytes_real4 !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_real4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_real4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_real4_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_real4_size_t + call grib_read_bytes_real4_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_real4_size_t !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -521,14 +521,14 @@ end subroutine codes_read_bytes_real4_size_t !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_real8 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_real8(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_real8 ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_real8 + call grib_read_bytes_real8(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_real8 !> Reads nbytes bytes into the buffer from a file opened with codes_open_file. !> @@ -542,14 +542,14 @@ end subroutine codes_read_bytes_real8 !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_bytes_real8_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer + subroutine codes_read_bytes_real8_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_bytes_real8_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_bytes_real8_size_t + call grib_read_bytes_real8_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_bytes_real8_size_t !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -563,14 +563,14 @@ end subroutine codes_read_bytes_real8_size_t !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_int4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_int4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_int4 ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_int4 + call grib_read_from_file_int4(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_int4 !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -584,14 +584,14 @@ end subroutine codes_read_from_file_int4 !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_int4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_int4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_int4_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_int4_size_t + call grib_read_from_file_int4_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_int4_size_t !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -605,14 +605,14 @@ end subroutine codes_read_from_file_int4_size_t !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_real4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_real4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_real4 ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_real4 + call grib_read_from_file_real4(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_real4 !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -626,14 +626,14 @@ end subroutine codes_read_from_file_real4 !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_real4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_real4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_real4_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_real4_size_t + call grib_read_from_file_real4_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_real4_size_t !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -645,14 +645,14 @@ end subroutine codes_read_from_file_real4_size_t !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_real8 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_real8(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_real8 ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_real8 + call grib_read_from_file_real8(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_real8 !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -666,14 +666,14 @@ end subroutine codes_read_from_file_real8 !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_real8_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_real8_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_real8_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_real8_size_t + call grib_read_from_file_real8_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_real8_size_t !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -687,14 +687,14 @@ end subroutine codes_read_from_file_real8_size_t !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_char ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_char(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_char ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_char + call grib_read_from_file_char(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_char !> Reads a message in the buffer array from the file opened with codes_open_file. !> @@ -707,14 +707,14 @@ end subroutine codes_read_from_file_char !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_read_from_file_char_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer + subroutine codes_read_from_file_char_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_read_from_file_char_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_read_from_file_char_size_t + call grib_read_from_file_char_size_t(ifile, buffer, nbytes, status) + end subroutine codes_read_from_file_char_size_t !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -728,14 +728,14 @@ end subroutine codes_read_from_file_char_size_t !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_char ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_char(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(in) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_char ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_char + call grib_write_bytes_char(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_char !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -749,14 +749,14 @@ end subroutine codes_write_bytes_char !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_char_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_char_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(in) :: buffer integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_char_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_char_size_t + call grib_write_bytes_char_size_t(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_char_size_t !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -770,14 +770,14 @@ end subroutine codes_write_bytes_char_size_t !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_int4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_int4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(in) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_int4 ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_int4 + call grib_write_bytes_int4(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_int4 !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -789,14 +789,14 @@ end subroutine codes_write_bytes_int4 !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_int4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_int4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(in) :: buffer integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_int4_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_int4_size_t + call grib_write_bytes_int4_size_t(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_int4_size_t !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -809,14 +809,14 @@ end subroutine codes_write_bytes_int4_size_t !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_real4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_real4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(in) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_real4 ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_real4 + call grib_write_bytes_real4(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_real4 !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -830,14 +830,14 @@ end subroutine codes_write_bytes_real4 !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_real4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_real4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(in) :: buffer integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_real4_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_real4_size_t + call grib_write_bytes_real4_size_t(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_real4_size_t !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -851,14 +851,14 @@ end subroutine codes_write_bytes_real4_size_t !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_real8 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_real8(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(in) :: buffer integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_real8 ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_real8 + call grib_write_bytes_real8(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_real8 !> Write nbytes bytes from the buffer in a file opened with codes_open_file. !> @@ -872,14 +872,14 @@ end subroutine codes_write_bytes_real8 !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write_bytes_real8_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8), dimension(:),intent(in) :: buffer + subroutine codes_write_bytes_real8_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(in) :: buffer integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write_bytes_real8_size_t ( ifile, buffer, nbytes, status ) -end subroutine codes_write_bytes_real8_size_t + call grib_write_bytes_real8_size_t(ifile, buffer, nbytes, status) + end subroutine codes_write_bytes_real8_size_t !> Close a file. !> @@ -894,12 +894,12 @@ end subroutine codes_write_bytes_real8_size_t !> !> @param ifile is the id of the file to be closed. !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_close_file ( ifile , status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_close_file(ifile, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_close_file ( ifile , status ) -end subroutine codes_close_file + call grib_close_file(ifile, status) + end subroutine codes_close_file !> Counts the messages in a file !> @@ -908,22 +908,22 @@ end subroutine codes_close_file !> @param ifile id of the file opened with @ref codes_open_file !> @param n number of messages in the file !> @param status CODES_SUCCESS if OK or error code -subroutine codes_count_in_file ( ifile, n , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: n - integer(kind=kindOfInt),optional,intent(out) :: status + subroutine codes_count_in_file(ifile, n, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: n + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_count_in_file ( ifile, n , status) -end subroutine codes_count_in_file + call grib_count_in_file(ifile, n, status) + end subroutine codes_count_in_file ! -subroutine codes_headers_only_new_from_file ( ifile, gribid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: gribid - integer(kind=kindOfInt),optional,intent(out) :: status + subroutine codes_headers_only_new_from_file(ifile, gribid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_headers_only_new_from_file ( ifile, gribid , status) -end subroutine codes_headers_only_new_from_file + call grib_headers_only_new_from_file(ifile, gribid, status) + end subroutine codes_headers_only_new_from_file !> Load in memory a message from a file. !> @@ -936,43 +936,43 @@ end subroutine codes_headers_only_new_from_file !> @param msgid id of the message loaded in memory !> @param product_kind One of CODES_PRODUCT_GRIB, CODES_PRODUCT_BUFR or CODES_PRODUCT_ANY !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_new_from_file (ifile, msgid , product_kind, status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: msgid - integer(kind=kindOfInt),intent(in) :: product_kind - integer(kind=kindOfInt),optional,intent(out) :: status + subroutine codes_new_from_file(ifile, msgid, product_kind, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: msgid + integer(kind=kindOfInt), intent(in) :: product_kind + integer(kind=kindOfInt), optional, intent(out) :: status if (product_kind == CODES_PRODUCT_GRIB) then - call codes_grib_new_from_file ( ifile, msgid , status) + call codes_grib_new_from_file(ifile, msgid, status) else if (product_kind == CODES_PRODUCT_BUFR) then - call codes_bufr_new_from_file ( ifile, msgid , status) + call codes_bufr_new_from_file(ifile, msgid, status) else - if (product_kind /= CODES_PRODUCT_ANY) then - call grib_check(CODES_INTERNAL_ERROR,'new_from_file','invalid_product_kind') - end if - call codes_any_new_from_file ( ifile, msgid , status) + if (product_kind /= CODES_PRODUCT_ANY) then + call grib_check(CODES_INTERNAL_ERROR, 'new_from_file', 'invalid_product_kind') + end if + call codes_any_new_from_file(ifile, msgid, status) end if -end subroutine codes_new_from_file + end subroutine codes_new_from_file !> Scan a file to search for messages without decoding. !> !> @param ifile id of the file opened with @ref codes_open_file !> @param nmessages number of messages found !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_any_scan_file ( ifile, nmessages , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: nmessages + subroutine codes_any_scan_file(ifile, nmessages, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: nmessages integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - iret=any_f_scan_file ( ifile, nmessages) + iret = any_f_scan_file(ifile, nmessages) if (present(status)) then status = iret else - call grib_check(iret,'any_f_scan_file','') - endif + call grib_check(iret, 'any_f_scan_file', '') + end if -end subroutine codes_any_scan_file + end subroutine codes_any_scan_file !> Decode message from scanned file. This function provides direct access to the n-th message in a file. !> A call to codes_any_scan_file must precede a call to this function. The file needs to be scanned to prepare @@ -985,64 +985,64 @@ end subroutine codes_any_scan_file !> @param nmsg n-th message in the file to be read !> @param msgid id of the message loaded in memory !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_any_new_from_scanned_file ( ifile, nmsg, msgid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(in) :: nmsg - integer(kind=kindOfInt),intent(out) :: msgid + subroutine codes_any_new_from_scanned_file(ifile, nmsg, msgid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(in) :: nmsg + integer(kind=kindOfInt), intent(out) :: msgid integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - iret=any_f_new_from_scanned_file( ifile, nmsg, msgid ) + iret = any_f_new_from_scanned_file(ifile, nmsg, msgid) if (present(status)) then status = iret else - call grib_check(iret,'any_f_new_from_scanned_file','') - endif + call grib_check(iret, 'any_f_new_from_scanned_file', '') + end if -end subroutine codes_any_new_from_scanned_file + end subroutine codes_any_new_from_scanned_file !> Load in memory all messages from a file without decoding. !> !> @param ifile id of the file opened with @ref codes_open_file !> @param nmessages number of messages loaded !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_any_load_all_from_file ( ifile, nmessages , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: nmessages + subroutine codes_any_load_all_from_file(ifile, nmessages, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: nmessages integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - iret=any_f_load_all_from_file ( ifile, nmessages) + iret = any_f_load_all_from_file(ifile, nmessages) if (present(status)) then status = iret else - call grib_check(iret,'any_f_load_all_from_file','') - endif + call grib_check(iret, 'any_f_load_all_from_file', '') + end if -end subroutine codes_any_load_all_from_file + end subroutine codes_any_load_all_from_file !> Decode message from loaded. !> !> The message can be accessed through its msgid and it will be available\n !> until @ref codes_release is called.\n !> - !> @param imsg id of the binary message + !> @param imsg id of the binary message !> @param msgid id of the message loaded in memory !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_any_new_from_loaded ( imsg, msgid , status) - integer(kind=kindOfInt),intent(in) :: imsg - integer(kind=kindOfInt),intent(out) :: msgid + subroutine codes_any_new_from_loaded(imsg, msgid, status) + integer(kind=kindOfInt), intent(in) :: imsg + integer(kind=kindOfInt), intent(out) :: msgid integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt),optional,intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - iret=any_f_new_from_loaded( imsg, msgid ) + iret = any_f_new_from_loaded(imsg, msgid) if (present(status)) then status = iret else - call grib_check(iret,'any_f_new_from_loaded','') - endif + call grib_check(iret, 'any_f_new_from_loaded', '') + end if -end subroutine codes_any_new_from_loaded + end subroutine codes_any_new_from_loaded !> Load in memory a message from a file. !> @@ -1052,13 +1052,13 @@ end subroutine codes_any_new_from_loaded !> @param ifile id of the file opened with @ref codes_open_file !> @param msgid id of the message loaded in memory !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_any_new_from_file ( ifile, msgid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: msgid - integer(kind=kindOfInt),optional,intent(out) :: status + subroutine codes_any_new_from_file(ifile, msgid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: msgid + integer(kind=kindOfInt), optional, intent(out) :: status - call any_new_from_file ( ifile, msgid , status) -end subroutine codes_any_new_from_file + call any_new_from_file(ifile, msgid, status) + end subroutine codes_any_new_from_file !> Load in memory a GRIB message from a file. !> @@ -1070,13 +1070,13 @@ end subroutine codes_any_new_from_file !> @param ifile id of the file opened with @ref codes_open_file !> @param gribid id of the GRIB loaded in memory !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_grib_new_from_file ( ifile, gribid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: gribid - integer(kind=kindOfInt),optional,intent(out) :: status + subroutine codes_grib_new_from_file(ifile, gribid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_new_from_file ( ifile, gribid , status) -end subroutine codes_grib_new_from_file + call grib_new_from_file(ifile, gribid, status) + end subroutine codes_grib_new_from_file !> Load in memory a BUFR message from a file. !> @@ -1088,14 +1088,13 @@ end subroutine codes_grib_new_from_file !> @param ifile id of the file opened with @ref codes_open_file !> @param bufrid id of the BUFR loaded in memory !> @param status CODES_SUCCESS if OK, CODES_END_OF_FILE at the end of file, or error code -subroutine codes_bufr_new_from_file ( ifile, bufrid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: bufrid - integer(kind=kindOfInt),optional,intent(out) :: status - - call bufr_new_from_file ( ifile, bufrid, status) -end subroutine codes_bufr_new_from_file + subroutine codes_bufr_new_from_file(ifile, bufrid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: bufrid + integer(kind=kindOfInt), optional, intent(out) :: status + call bufr_new_from_file(ifile, bufrid, status) + end subroutine codes_bufr_new_from_file !> Create a new message in memory from a character array containting the coded message. !> @@ -1112,13 +1111,13 @@ end subroutine codes_bufr_new_from_file !> @param msgid id of the message loaded in memory !> @param message character array containing the coded message !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_new_from_message_char( msgid, message, status ) - integer(kind=kindOfInt),intent(out) :: msgid - character(len=1), dimension(:),intent(in) :: message - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_new_from_message_char(msgid, message, status) + integer(kind=kindOfInt), intent(out) :: msgid + character(len=1), dimension(:), intent(in) :: message + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_new_from_message_char( msgid, message, status ) -end subroutine codes_new_from_message_char + call grib_new_from_message_char(msgid, message, status) + end subroutine codes_new_from_message_char !> Create a new message in memory from an integer array containting the coded message. !> @@ -1136,13 +1135,13 @@ end subroutine codes_new_from_message_char !> @param msgid id of the message loaded in memory !> @param message integer array containing the coded message !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_new_from_message_int4 ( msgid, message, status ) - integer(kind=kindOfInt),intent(out) :: msgid - integer(kind=4), dimension(:),intent(in) :: message - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_new_from_message_int4(msgid, message, status) + integer(kind=kindOfInt), intent(out) :: msgid + integer(kind=4), dimension(:), intent(in) :: message + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_new_from_message_int4 ( msgid, message, status ) -end subroutine codes_new_from_message_int4 + call grib_new_from_message_int4(msgid, message, status) + end subroutine codes_new_from_message_int4 !> Create a new valid gribid from a GRIB sample contained in a samples directory pointed !> by the environment variable ECCODES_SAMPLES_PATH. @@ -1158,13 +1157,13 @@ end subroutine codes_new_from_message_int4 !> @param gribid id of the grib loaded in memory !> @param samplename name of the sample to be used !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_new_from_samples ( gribid, samplename, status ) - integer(kind=kindOfInt), intent(out) :: gribid + subroutine codes_grib_new_from_samples(gribid, samplename, status) + integer(kind=kindOfInt), intent(out) :: gribid character(len=*), intent(in) :: samplename - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_new_from_samples ( gribid, samplename, status ) -end subroutine codes_grib_new_from_samples + call grib_new_from_samples(gribid, samplename, status) + end subroutine codes_grib_new_from_samples !> Create a new valid bufrid from a BUFR sample contained in a samples directory pointed !> by the environment variable ECCODES_SAMPLES_PATH. @@ -1177,19 +1176,19 @@ end subroutine codes_grib_new_from_samples !> @param bufrid id of the BUFR loaded in memory !> @param samplename name of the BUFR sample to be used !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_bufr_new_from_samples ( bufrid, samplename, status ) - integer(kind=kindOfInt), intent(out) :: bufrid - character(len=*), intent(in) :: samplename - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine codes_bufr_new_from_samples(bufrid, samplename, status) + integer(kind=kindOfInt), intent(out) :: bufrid + character(len=*), intent(in) :: samplename + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=codes_bufr_f_new_from_samples ( bufrid, samplename ) - if (present(status)) then - status = iret - else - call grib_check(iret,'bufr_new_from_samples','('//samplename//')') - endif -end subroutine codes_bufr_new_from_samples + iret = codes_bufr_f_new_from_samples(bufrid, samplename) + if (present(status)) then + status = iret + else + call grib_check(iret, 'bufr_new_from_samples', '('//samplename//')') + end if + end subroutine codes_bufr_new_from_samples !> Free the memory for the message referred as msgid. !> @@ -1201,12 +1200,12 @@ end subroutine codes_bufr_new_from_samples !> !> @param msgid id of the message loaded in memory !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_release ( msgid, status ) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_release(msgid, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_release ( msgid, status ) -end subroutine codes_release + call grib_release(msgid, status) + end subroutine codes_release !> Create a copy of a message. !> @@ -1223,24 +1222,24 @@ end subroutine codes_release !> @param msgid_src message to be cloned !> @param msgid_dest new message returned !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_clone ( msgid_src, msgid_dest, status ) - integer(kind=kindOfInt), intent(in) :: msgid_src - integer(kind=kindOfInt), intent(out) :: msgid_dest - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_clone(msgid_src, msgid_dest, status) + integer(kind=kindOfInt), intent(in) :: msgid_src + integer(kind=kindOfInt), intent(out) :: msgid_dest + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_clone ( msgid_src, msgid_dest, status ) -end subroutine codes_clone + call grib_clone(msgid_src, msgid_dest, status) + end subroutine codes_clone ! -subroutine codes_grib_util_sections_copy ( gribid_from, gribid_to, what, gribid_out,status ) - integer(kind=kindOfInt), intent(in) :: gribid_from - integer(kind=kindOfInt), intent(in) :: gribid_to - integer(kind=kindOfInt), intent(out) :: gribid_out - integer(kind=kindOfInt), intent(in) :: what - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_util_sections_copy(gribid_from, gribid_to, what, gribid_out, status) + integer(kind=kindOfInt), intent(in) :: gribid_from + integer(kind=kindOfInt), intent(in) :: gribid_to + integer(kind=kindOfInt), intent(out) :: gribid_out + integer(kind=kindOfInt), intent(in) :: what + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_util_sections_copy ( gribid_from, gribid_to, what, gribid_out,status ) -end subroutine codes_grib_util_sections_copy + call grib_util_sections_copy(gribid_from, gribid_to, what, gribid_out, status) + end subroutine codes_grib_util_sections_copy !> Copy the value of all the keys belonging to a namespace from the source message !> to the destination message @@ -1254,14 +1253,14 @@ end subroutine codes_grib_util_sections_copy !> @param gribid_dest destination message !> @param namespace namespace to be copied !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_copy_namespace ( gribid_src, namespace, gribid_dest, status ) - integer(kind=kindOfInt), intent(in) :: gribid_src - integer(kind=kindOfInt), intent(in) :: gribid_dest - character(LEN=*), intent(in) :: namespace - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_copy_namespace(gribid_src, namespace, gribid_dest, status) + integer(kind=kindOfInt), intent(in) :: gribid_src + integer(kind=kindOfInt), intent(in) :: gribid_dest + character(LEN=*), intent(in) :: namespace + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_copy_namespace ( gribid_src, namespace, gribid_dest, status ) -end subroutine codes_copy_namespace + call grib_copy_namespace(gribid_src, namespace, gribid_dest, status) + end subroutine codes_copy_namespace !> Check the status returned by a subroutine. !> @@ -1271,13 +1270,13 @@ end subroutine codes_copy_namespace !> @param status the status to be checked !> @param caller name of the caller soubroutine !> @param string a string variable from the caller routine (e.g. key,filename) -subroutine codes_check ( status,caller,string ) + subroutine codes_check(status, caller, string) integer(kind=kindOfInt), intent(in) :: status - character(len=*), intent(in) :: caller - character(len=*), intent(in) :: string + character(len=*), intent(in) :: caller + character(len=*), intent(in) :: string - call grib_check ( status,caller,string ) -end subroutine codes_check + call grib_check(status, caller, string) + end subroutine codes_check !> Get latitudes/longitudes/data values (real(4)). !> @@ -1295,14 +1294,14 @@ end subroutine codes_check !> @param lons longitudes array with dimension "size" !> @param values data values array with dimension "size" !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_get_data_real4 ( gribid, lats, lons, values, status ) - integer(kind=kindOfInt), intent(in) :: gribid - real ( kind = kindOfFloat ), dimension(:),intent(out) :: lats, lons - real ( kind = kindOfFloat ), dimension(:),intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_get_data_real4(gribid, lats, lons, values, status) + integer(kind=kindOfInt), intent(in) :: gribid + real(kind=kindOfFloat), dimension(:), intent(out) :: lats, lons + real(kind=kindOfFloat), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_data_real4 ( gribid, lats, lons, values, status ) -end subroutine codes_grib_get_data_real4 + call grib_get_data_real4(gribid, lats, lons, values, status) + end subroutine codes_grib_get_data_real4 !> Get latitudes/longitudes/data values (real(8)). !> @@ -1319,14 +1318,14 @@ end subroutine codes_grib_get_data_real4 !> @param lons longitudes array !> @param values data values array !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_get_data_real8 ( gribid, lats, lons, values, status ) - integer(kind=kindOfInt), intent(in) :: gribid - real ( kind = kindOfDouble ), dimension(:),intent(out) :: lats, lons - real ( kind = kindOfDouble ), dimension(:),intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_get_data_real8(gribid, lats, lons, values, status) + integer(kind=kindOfInt), intent(in) :: gribid + real(kind=kindOfDouble), dimension(:), intent(out) :: lats, lons + real(kind=kindOfDouble), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_data_real8 ( gribid, lats, lons, values, status ) -end subroutine codes_grib_get_data_real8 + call grib_get_data_real8(gribid, lats, lons, values, status) + end subroutine codes_grib_get_data_real8 !> Create a new iterator on the keys. !> @@ -1349,25 +1348,25 @@ end subroutine codes_grib_get_data_real8 !> @param iterid keys iterator id to be used in the keys iterator functions !> @param namespace the namespace of the keys to search for (all the keys if empty) !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_keys_iterator_new ( msgid, iterid, namespace, status ) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfInt), intent(inout) :: iterid + subroutine codes_keys_iterator_new(msgid, iterid, namespace, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), intent(inout) :: iterid character(LEN=*), intent(in) :: namespace - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_keys_iterator_new ( msgid, iterid, namespace, status ) -end subroutine codes_keys_iterator_new + call grib_keys_iterator_new(msgid, iterid, namespace, status) + end subroutine codes_keys_iterator_new !> Advance to the next keys iterator value. !> !> @param iterid keys iterator id created with @ref codes_keys_iterator_new !> @param status CODES_SUCCESS if next iterator exists, integer value if no more elements to iterate on -subroutine codes_keys_iterator_next ( iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt), intent(out) :: status + subroutine codes_keys_iterator_next(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), intent(out) :: status - call grib_keys_iterator_next ( iterid , status) -end subroutine codes_keys_iterator_next + call grib_keys_iterator_next(iterid, status) + end subroutine codes_keys_iterator_next !> Delete a keys iterator and free memory. !> @@ -1377,12 +1376,12 @@ end subroutine codes_keys_iterator_next !> !> @param iterid keys iterator id created with @ref codes_keys_iterator_new !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_keys_iterator_delete ( iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_keys_iterator_delete(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_keys_iterator_delete ( iterid , status) -end subroutine codes_keys_iterator_delete + call grib_keys_iterator_delete(iterid, status) + end subroutine codes_keys_iterator_delete !> Get the name of a key from a keys iterator. !> @@ -1392,13 +1391,13 @@ end subroutine codes_keys_iterator_delete !> @param iterid keys iterator id created with @ref codes_keys_iterator_new !> @param name key name to be retrieved !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_keys_iterator_get_name ( iterid, name, status ) - integer(kind=kindOfInt), intent(in) :: iterid + subroutine codes_keys_iterator_get_name(iterid, name, status) + integer(kind=kindOfInt), intent(in) :: iterid character(LEN=*), intent(out) :: name - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_keys_iterator_get_name ( iterid, name, status ) -end subroutine codes_keys_iterator_get_name + call grib_keys_iterator_get_name(iterid, name, status) + end subroutine codes_keys_iterator_get_name !> Rewind a keys iterator. !> @@ -1408,13 +1407,12 @@ end subroutine codes_keys_iterator_get_name !> !> @param iterid keys iterator id created with @ref codes_keys_iterator_new !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_keys_iterator_rewind ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_keys_iterator_rewind ( iterid, status ) -end subroutine codes_keys_iterator_rewind + subroutine codes_keys_iterator_rewind(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_keys_iterator_rewind(iterid, status) + end subroutine codes_keys_iterator_rewind ! BUFR keys iterator ! ----------------------- @@ -1431,38 +1429,36 @@ end subroutine codes_keys_iterator_rewind !> @param msgid id of the BUFR message loaded in memory !> @param iterid keys iterator id to be used in the keys iterator functions !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_bufr_keys_iterator_new ( msgid, iterid, status ) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfInt), intent(inout) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_bufr_keys_iterator_new(msgid, iterid, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), intent(inout) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret iret = codes_f_bufr_keys_iterator_new(msgid, iterid) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'bufr_keys_iterator_new','') - endif -end subroutine codes_bufr_keys_iterator_new - + call grib_check(iret, 'bufr_keys_iterator_new', '') + end if + end subroutine codes_bufr_keys_iterator_new !> Advance to the next BUFR keys iterator value. !> !> @param iterid keys iterator id created with @ref codes_bufr_keys_iterator_new !> @param status CODES_SUCCESS if next iterator exists, integer value if no more elements to iterate on -subroutine codes_bufr_keys_iterator_next (iterid , status) + subroutine codes_bufr_keys_iterator_next(iterid, status) integer(kind=kindOfInt), intent(in) :: iterid integer(kind=kindOfInt), intent(out) :: status integer(kind=kindOfInt) :: iret status = GRIB_SUCCESS - iret = codes_f_bufr_keys_iterator_next( iterid ) + iret = codes_f_bufr_keys_iterator_next(iterid) if (iret == 0) then - ! no more elements - status = GRIB_END - endif -end subroutine codes_bufr_keys_iterator_next - + ! no more elements + status = GRIB_END + end if + end subroutine codes_bufr_keys_iterator_next !> Get the name of a key from a BUFR keys iterator. !> @@ -1472,19 +1468,19 @@ end subroutine codes_bufr_keys_iterator_next !> @param iterid keys iterator id created with @ref codes_bufr_keys_iterator_new !> @param name key name to be retrieved !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_bufr_keys_iterator_get_name( iterid, name, status ) - integer(kind=kindOfInt), intent(in) :: iterid + subroutine codes_bufr_keys_iterator_get_name(iterid, name, status) + integer(kind=kindOfInt), intent(in) :: iterid character(LEN=*), intent(out) :: name - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret = codes_f_bufr_keys_iterator_get_name( iterid, name ) + iret = codes_f_bufr_keys_iterator_get_name(iterid, name) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'bufr_keys_iterator_get_name',name) - endif -end subroutine codes_bufr_keys_iterator_get_name + call grib_check(iret, 'bufr_keys_iterator_get_name', name) + end if + end subroutine codes_bufr_keys_iterator_get_name !> Rewind a BUFR keys iterator. !> @@ -1494,17 +1490,17 @@ end subroutine codes_bufr_keys_iterator_get_name !> !> @param iterid keys iterator id created with @ref codes_bufr_keys_iterator_new !> @param status CODES_SUCCESS if OK, integer value on error - subroutine codes_bufr_keys_iterator_rewind( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine codes_bufr_keys_iterator_rewind(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = codes_f_bufr_keys_iterator_rewind( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'bufr_keys_iterator_rewind','') - endif + iret = codes_f_bufr_keys_iterator_rewind(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'bufr_keys_iterator_rewind', '') + end if end subroutine codes_bufr_keys_iterator_rewind !> Delete a BUFR keys iterator and free memory. @@ -1515,21 +1511,19 @@ end subroutine codes_bufr_keys_iterator_get_name !> !> @param iterid keys iterator id created with @ref codes_bufr_keys_iterator_new !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine codes_bufr_keys_iterator_delete (iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine codes_bufr_keys_iterator_delete(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = codes_f_bufr_keys_iterator_delete(iterid) - if (present(status)) then - status = iret - else - call grib_check(iret,'bufr_keys_iterator_delete','') - endif + iret = codes_f_bufr_keys_iterator_delete(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'bufr_keys_iterator_delete', '') + end if end subroutine codes_bufr_keys_iterator_delete - - !> Dump the content of a message. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -1538,13 +1532,12 @@ end subroutine codes_bufr_keys_iterator_get_name !> !> @param msgid id of the message loaded in memory !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_dump ( msgid , status) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_dump (msgid, status) -end subroutine codes_dump + subroutine codes_dump(msgid, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_dump(msgid, status) + end subroutine codes_dump !> Get the API version !> @@ -1554,29 +1547,28 @@ end subroutine codes_dump !> !> @param api_version The version as an integer !> @param status GRIB_SUCCESS if OK, integer value on error -subroutine codes_get_api_version(api_version, status) - integer(kind = kindOfInt), intent(out) :: api_version - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_api_version(api_version, status) + integer(kind=kindOfInt), intent(out) :: api_version + integer(kind=kindOfInt), optional, intent(out) :: status call grib_f_get_api_version(api_version) if (present(status)) then status = CODES_SUCCESS - endif -end subroutine codes_get_api_version - + end if + end subroutine codes_get_api_version !> Get the error message given an error code !> !> @param error error code !> @param error_message error message !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_error_string ( error, error_message, status ) - integer(kind=kindOfInt), intent(in) :: error + subroutine codes_get_error_string(error, error_message, status) + integer(kind=kindOfInt), intent(in) :: error character(len=*), intent(out) :: error_message - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_error_string ( error, error_message, status ) -end subroutine codes_get_error_string + call grib_get_error_string(error, error_message, status) + end subroutine codes_get_error_string !> Get the size of an array key. !> @@ -1590,14 +1582,14 @@ end subroutine codes_get_error_string !> @param key name of the key !> @param size size of the array key !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_size_int ( msgid, key, size , status) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_get_size_int(msgid, key, size, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_size_int ( msgid, key, size , status) -end subroutine codes_get_size_int + call grib_get_size_int(msgid, key, size, status) + end subroutine codes_get_size_int !> Get the size of an array key. !> @@ -1611,14 +1603,14 @@ end subroutine codes_get_size_int !> @param key name of the key !> @param size size of the array key !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_size_long ( msgid, key, size , status) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_get_size_long(msgid, key, size, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind=kindOfLong), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfLong), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_size_long ( msgid, key, size , status) -end subroutine codes_get_size_long + call grib_get_size_long(msgid, key, size, status) + end subroutine codes_get_size_long !> Get the integer value of a key from a message. !> @@ -1630,14 +1622,14 @@ end subroutine codes_get_size_long !> @param key key name !> @param value the integer(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_int(msgid,key,value,status) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_get_int(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind = kindOfInt), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_int(msgid,key,value,status) -end subroutine codes_get_int + call grib_get_int(msgid, key, value, status) + end subroutine codes_get_int !> Get the integer value of a key from a message. !> @@ -1649,14 +1641,14 @@ end subroutine codes_get_int !> @param key key name !> @param value the integer(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_long(msgid,key,value,status) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_get_long(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind = kindOfLong), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfLong), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_long(msgid,key,value,status) -end subroutine codes_get_long + call grib_get_long(msgid, key, value, status) + end subroutine codes_get_long !> Check if the value of a key is MISSING. !> @@ -1668,14 +1660,14 @@ end subroutine codes_get_long !> @param key key name !> @param is_missing 0->not missing, 1->missing !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_is_missing(msgid,key,is_missing,status) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_is_missing(msgid, key, is_missing, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind = kindOfInt), intent(out) :: is_missing - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), intent(out) :: is_missing + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_is_missing(msgid,key,is_missing,status) -end subroutine codes_is_missing + call grib_is_missing(msgid, key, is_missing, status) + end subroutine codes_is_missing !> Check if a key is defined (exists in the message) !> @@ -1687,14 +1679,14 @@ end subroutine codes_is_missing !> @param key key name !> @param is_defined 0->not defined, 1->defined !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_is_defined(msgid,key,is_defined,status) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_is_defined(msgid, key, is_defined, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind = kindOfInt), intent(out) :: is_defined - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), intent(out) :: is_defined + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_is_defined(msgid,key,is_defined,status) -end subroutine codes_is_defined + call grib_is_defined(msgid, key, is_defined, status) + end subroutine codes_is_defined !> Get the real(4) value of a key from a message. !> @@ -1706,14 +1698,14 @@ end subroutine codes_is_defined !> @param key key name !> @param value the real(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real4 ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_real4(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_real4 ( msgid, key, value, status ) -end subroutine codes_get_real4 + call grib_get_real4(msgid, key, value, status) + end subroutine codes_get_real4 !> Get the real(8) value of a key from a message. !> @@ -1725,14 +1717,14 @@ end subroutine codes_get_real4 !> @param key key name !> @param value the real(8) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real8 ( msgid, key, value , status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_real8(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_real8 ( msgid, key, value , status) -end subroutine codes_get_real8 + call grib_get_real8(msgid, key, value, status) + end subroutine codes_get_real8 !> Get the character value of a key from a message. !> @@ -1744,14 +1736,14 @@ end subroutine codes_get_real8 !> @param key key name !> @param value the character value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_string ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=*), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_string(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=*), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_string ( msgid, key, value, status ) -end subroutine codes_get_string + call grib_get_string(msgid, key, value, status) + end subroutine codes_get_string !> Get the string array of values for a key from a message. !> @@ -1764,11 +1756,11 @@ end subroutine codes_get_string !> @param key key name !> @param value string array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_string_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=*), dimension(:),allocatable,intent(inout) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_string_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=*), dimension(:), allocatable, intent(inout) :: value + integer(kind=kindOfInt), optional, intent(out) :: status character :: cvalue(size(value)*len(value(0))) integer(kind=kindOfInt) :: iret @@ -1776,29 +1768,29 @@ subroutine codes_get_string_array ( msgid, key, value, status ) integer(kind=kindOfInt) :: slen if (allocated(value) .eqv. .false.) then - iret=CODES_NULL_POINTER + iret = CODES_NULL_POINTER if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if end if - nb_values=size(value) - slen=len(value(0)) - iret=grib_f_get_string_array ( msgid, key, cvalue , nb_values, slen ) - value=transfer(cvalue,value) + nb_values = size(value) + slen = len(value(0)) + iret = grib_f_get_string_array(msgid, key, cvalue, nb_values, slen) + value = transfer(cvalue, value) if (iret /= 0) then call grib_f_write_on_fail(msgid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if -end subroutine codes_get_string_array + end subroutine codes_get_string_array !> Copy data values from a BUFR message msgid1 to another message msgid2 !> @@ -1809,21 +1801,21 @@ end subroutine codes_get_string_array !> @param msgid1 id of the message from which the data are copied !> @param msgid2 id of the message to which the data are copied !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_bufr_copy_data ( msgid1, msgid2, status ) - integer(kind=kindOfInt), intent(in) :: msgid1 - integer(kind=kindOfInt), intent(in) :: msgid2 - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_bufr_copy_data(msgid1, msgid2, status) + integer(kind=kindOfInt), intent(in) :: msgid1 + integer(kind=kindOfInt), intent(in) :: msgid2 + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=codes_f_bufr_copy_data ( msgid1,msgid2 ) + iret = codes_f_bufr_copy_data(msgid1, msgid2) if (present(status)) then status = iret else - call grib_check(iret,'bufr_copy_data','error while copying') - endif + call grib_check(iret, 'bufr_copy_data', 'error while copying') + end if -end subroutine codes_bufr_copy_data + end subroutine codes_bufr_copy_data !> Set the string values for an array key in a message. !> @@ -1836,41 +1828,40 @@ end subroutine codes_bufr_copy_data !> @param key key name !> @param value string array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_string_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=*), dimension(:),allocatable, intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_string_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=*), dimension(:), allocatable, intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status character :: cvalue(size(value)*len(value(0))) character :: svalue(len(value(0))) integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: slen - integer(kind=kindOfInt) :: i,j + integer(kind=kindOfInt) :: i, j - nb_values=size(value) - slen=len(value(0)) - j=1 - do i=1,nb_values + nb_values = size(value) + slen = len(value(0)) + j = 1 + do i = 1, nb_values !cvalue(j:j+slen-1)=transfer(trim(value(i)),svalue) - cvalue(j:j+slen-1)=transfer(value(i),svalue) - j=j+slen - enddo + cvalue(j:j + slen - 1) = transfer(value(i), svalue) + j = j + slen + end do - iret=grib_f_set_string_array ( msgid, key, cvalue , nb_values, slen ) + iret = grib_f_set_string_array(msgid, key, cvalue, nb_values, slen) if (iret /= 0) then call grib_f_write_on_fail(msgid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'set',key) - endif - -end subroutine codes_set_string_array + call grib_check(iret, 'set', key) + end if + end subroutine codes_set_string_array !> Get the integer array of values for a key from a message. !> @@ -1883,47 +1874,47 @@ end subroutine codes_set_string_array !> @param key key name !> @param value integer(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_int_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), dimension(:),allocatable,intent(inout) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_int_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), allocatable, intent(inout) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value integer(kind=kindOfInt) :: i - iret=grib_f_get_size_int(msgid,key,nb_values) + iret = grib_f_get_size_int(msgid, key, nb_values) if (iret /= 0) then call grib_f_write_on_fail(msgid) if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if return - endif - if (allocated(value) .eqv. .false.) then - allocate(value(nb_values)) end if - size_value=size(value) - iret=grib_f_get_int_array ( msgid, key, value , nb_values ) - if (iret==0 .and. nb_values==1 .and. size_value/=1) then - do i=2,size_value - value(i)=value(1) - enddo - endif - if (iret /= 0) then - call grib_f_write_on_fail(msgid) - endif + if (allocated(value) .eqv. .false.) then + allocate (value(nb_values)) + end if + size_value = size(value) + iret = grib_f_get_int_array(msgid, key, value, nb_values) + if (iret == 0 .and. nb_values == 1 .and. size_value /= 1) then + do i = 2, size_value + value(i) = value(1) + end do + end if + if (iret /= 0) then + call grib_f_write_on_fail(msgid) + end if if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if -end subroutine codes_get_int_array + end subroutine codes_get_int_array !> Get the integer array of values for a key from a message. !> @@ -1936,47 +1927,47 @@ end subroutine codes_get_int_array !> @param key key name !> @param value integer(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_long_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfLong), dimension(:),allocatable,intent(inout) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_long_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), dimension(:), allocatable, intent(inout) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value integer(kind=kindOfInt) :: i - iret=grib_f_get_size_int(msgid,key,nb_values) + iret = grib_f_get_size_int(msgid, key, nb_values) if (iret /= 0) then call grib_f_write_on_fail(msgid) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if return - endif - if (allocated(value) .eqv. .false.) then - allocate(value(nb_values)) end if - size_value=size(value) - iret=grib_f_get_long_array ( msgid, key, value , nb_values ) - if (iret==0 .and. nb_values==1 .and. size_value/=1) then - do i=2,size_value - value(i)=value(1) - enddo - endif + if (allocated(value) .eqv. .false.) then + allocate (value(nb_values)) + end if + size_value = size(value) + iret = grib_f_get_long_array(msgid, key, value, nb_values) + if (iret == 0 .and. nb_values == 1 .and. size_value /= 1) then + do i = 2, size_value + value(i) = value(1) + end do + end if if (iret /= 0) then call grib_f_write_on_fail(msgid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if -end subroutine codes_get_long_array + end subroutine codes_get_long_array !> Get the array of bytes (character) for a key from a message. !> @@ -1989,15 +1980,15 @@ end subroutine codes_get_long_array !> @param value character(len=1) array of byte values !> @param length (optional) output: number of values retrieved !> @param status (optional) CODES_SUCCESS if OK, integer value on error -subroutine codes_get_byte_array ( msgid, key, value, length, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=1), dimension(:), intent(inout) :: value - integer(kind=kindOfInt), optional, intent(out) :: length - integer(kind=kindOfInt), optional, intent(out) :: status + subroutine codes_get_byte_array(msgid, key, value, length, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=1), dimension(:), intent(inout) :: value + integer(kind=kindOfInt), optional, intent(out) :: length + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_byte_array ( msgid, key, value, length, status ) -end subroutine codes_get_byte_array + call grib_get_byte_array(msgid, key, value, length, status) + end subroutine codes_get_byte_array !> Get the real(4) array of values for a key from a message. !> @@ -2010,46 +2001,46 @@ end subroutine codes_get_byte_array !> @param key key name !> @param value real(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real4_array ( msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), dimension(:),allocatable, intent(inout) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_real4_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), dimension(:), allocatable, intent(inout) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value integer(kind=kindOfInt) :: i - iret=grib_f_get_size_int(msgid,key,nb_values) + iret = grib_f_get_size_int(msgid, key, nb_values) if (iret /= 0) then call grib_f_write_on_fail(msgid) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if return - endif - if (allocated(value) .eqv. .false.) then - allocate(value(nb_values)) end if - size_value=size(value) - iret=grib_f_get_real4_array ( msgid, key, value , nb_values ) - if (iret==0 .and. nb_values==1 .and. size_value/=1) then - do i=2,size_value - value(i)=value(1) - enddo - endif + if (allocated(value) .eqv. .false.) then + allocate (value(nb_values)) + end if + size_value = size(value) + iret = grib_f_get_real4_array(msgid, key, value, nb_values) + if (iret == 0 .and. nb_values == 1 .and. size_value /= 1) then + do i = 2, size_value + value(i) = value(1) + end do + end if if (iret /= 0) then call grib_f_write_on_fail(msgid) - endif + end if if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'get',key) - endif -end subroutine codes_get_real4_array + call grib_check(iret, 'get', key) + end if + end subroutine codes_get_real4_array !> Get the real(8) array of values for a key from a message. !> @@ -2062,47 +2053,46 @@ end subroutine codes_get_real4_array !> @param key key name !> @param value real(8) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real8_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), dimension(:),allocatable, intent(inout) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_real8_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), allocatable, intent(inout) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value integer(kind=kindOfInt) :: i - iret=grib_f_get_size_int(msgid,key,nb_values) + iret = grib_f_get_size_int(msgid, key, nb_values) if (iret /= 0) then call grib_f_write_on_fail(msgid) if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if return - endif - if (allocated(value) .eqv. .false.) then - allocate(value(nb_values)) end if - size_value=size(value) - iret=grib_f_get_real8_array ( msgid, key, value, nb_values ) - if (iret==0 .and. nb_values==1 .and. size_value/=1) then - do i=2,size_value - value(i)=value(1) - enddo - endif + if (allocated(value) .eqv. .false.) then + allocate (value(nb_values)) + end if + size_value = size(value) + iret = grib_f_get_real8_array(msgid, key, value, nb_values) + if (iret == 0 .and. nb_values == 1 .and. size_value /= 1) then + do i = 2, size_value + value(i) = value(1) + end do + end if if (iret /= 0) then call grib_f_write_on_fail(msgid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif -end subroutine codes_get_real8_array - + call grib_check(iret, 'get', key) + end if + end subroutine codes_get_real8_array !> Get a real(4) value of specified index from an array key. !> @@ -2115,16 +2105,15 @@ end subroutine codes_get_real8_array !> @param kindex integer(4) index !> @param value real(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real4_element ( msgid, key, kindex,value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(in) :: kindex - real(kind = kindOfFloat), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_get_real4_element ( msgid, key, kindex,value, status ) -end subroutine codes_get_real4_element + subroutine codes_get_real4_element(msgid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: kindex + real(kind=kindOfFloat), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_get_real4_element(msgid, key, kindex, value, status) + end subroutine codes_get_real4_element !> Get a real(8) value of specified index from an array key. !> @@ -2137,16 +2126,15 @@ end subroutine codes_get_real4_element !> @param kindex integer(4) index !> @param value real(8) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real8_element ( msgid, key, kindex,value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(in) :: kindex - real(kind = kindOfDouble), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_get_real8_element ( msgid, key, kindex,value, status ) -end subroutine codes_get_real8_element + subroutine codes_get_real8_element(msgid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: kindex + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_get_real8_element(msgid, key, kindex, value, status) + end subroutine codes_get_real8_element !> Get the real(4) values whose indexes are stored in the array "index" from an array key. !> @@ -2159,15 +2147,15 @@ end subroutine codes_get_real8_element !> @param kindex integer(4) array indexes !> @param value real(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real4_elements ( msgid, key, kindex,value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt),dimension(:), intent(in) :: kindex - real(kind = kindOfFloat), dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_real4_elements(msgid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(in) :: kindex + real(kind=kindOfFloat), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_real4_elements ( msgid, key, kindex,value, status ) -end subroutine codes_get_real4_elements + call grib_get_real4_elements(msgid, key, kindex, value, status) + end subroutine codes_get_real4_elements !> Get the real(8) values whose indexes are stored in the array "index" from an array key. !> @@ -2180,15 +2168,15 @@ end subroutine codes_get_real4_elements !> @param kindex integer(4) array index !> @param value real(8) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_real8_elements ( msgid, key, kindex,value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt),dimension(:), intent(in) :: kindex - real(kind = kindOfDouble), dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_real8_elements(msgid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(in) :: kindex + real(kind=kindOfDouble), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_real8_elements ( msgid, key, kindex,value, status ) -end subroutine codes_get_real8_elements + call grib_get_real8_elements(msgid, key, kindex, value, status) + end subroutine codes_get_real8_elements !> Set the integer value for a key in a message. !> @@ -2200,15 +2188,14 @@ end subroutine codes_get_real8_elements !> @param key key name !> @param value integer(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_int ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_set_int(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_set_int ( msgid, key, value, status ) -end subroutine codes_set_int + integer(kind=kindOfInt), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_set_int(msgid, key, value, status) + end subroutine codes_set_int !> Set the integer value for a key in a message. !> @@ -2220,15 +2207,14 @@ end subroutine codes_set_int !> @param key key name !> @param value integer(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_long ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid + subroutine codes_set_long(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key - integer(kind=kindOfLong), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_set_long ( msgid, key, value, status ) -end subroutine codes_set_long + integer(kind=kindOfLong), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_set_long(msgid, key, value, status) + end subroutine codes_set_long !> Set the real(4) value for a key in a message. !> @@ -2240,14 +2226,14 @@ end subroutine codes_set_long !> @param key key name !> @param value real(4) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_real4 ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_real4(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_real4 ( msgid, key, value, status ) -end subroutine codes_set_real4 + call grib_set_real4(msgid, key, value, status) + end subroutine codes_set_real4 !> Set the real(8) value for a key in a message. !> @@ -2259,15 +2245,14 @@ end subroutine codes_set_real4 !> @param key key name !> @param value real(8) value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_real8 ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_set_real8 ( msgid, key, value, status ) -end subroutine codes_set_real8 + subroutine codes_set_real8(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_set_real8(msgid, key, value, status) + end subroutine codes_set_real8 !> Set the integers values for an array key in a message. !> @@ -2279,14 +2264,14 @@ end subroutine codes_set_real8 !> @param key key name !> @param value integer(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_int_array ( msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_int_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_int_array ( msgid, key, value, status) -end subroutine codes_set_int_array + call grib_set_int_array(msgid, key, value, status) + end subroutine codes_set_int_array !> Set the integers values for an array key in a message. !> @@ -2298,14 +2283,14 @@ end subroutine codes_set_int_array !> @param key key name !> @param value integer(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_long_array ( msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfLong), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_long_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_long_array ( msgid, key, value, status) -end subroutine codes_set_long_array + call grib_set_long_array(msgid, key, value, status) + end subroutine codes_set_long_array !> Set the array of bytes (character) for a key in a message. !> @@ -2318,15 +2303,15 @@ end subroutine codes_set_long_array !> @param value character(len=1) array of byte values !> @param length (optional) output: number of values written !> @param status (optional) CODES_SUCCESS if OK, integer value on error -subroutine codes_set_byte_array ( msgid, key, value, length, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=1), dimension(:), intent(in) :: value - integer(kind=kindOfInt), optional, intent(out) :: length - integer(kind=kindOfInt), optional, intent(out) :: status + subroutine codes_set_byte_array(msgid, key, value, length, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=1), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: length + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_byte_array ( msgid, key, value, length, status ) -end subroutine codes_set_byte_array + call grib_set_byte_array(msgid, key, value, length, status) + end subroutine codes_set_byte_array !> Set the real(4) values for an array key in a message. !> @@ -2338,14 +2323,14 @@ end subroutine codes_set_byte_array !> @param key key name !> @param value real(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_real4_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_real4_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_real4_array ( msgid, key, value, status ) -end subroutine codes_set_real4_array + call grib_set_real4_array(msgid, key, value, status) + end subroutine codes_set_real4_array !> Set the real(8) values for an array key in a message. !> @@ -2357,14 +2342,14 @@ end subroutine codes_set_real4_array !> @param key key name !> @param value real(8) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_real8_array ( msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_real8_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_real8_array ( msgid, key, value, status) -end subroutine codes_set_real8_array + call grib_set_real8_array(msgid, key, value, status) + end subroutine codes_set_real8_array !> @cond !> Set the real(4) values for an array key in a grib message, forces the set if the key is read-only. @@ -2378,14 +2363,14 @@ end subroutine codes_set_real8_array !> @param key key name !> @param value real(4) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_force_real4_array ( msgid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_force_real4_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_force_real4_array ( msgid, key, value, status ) -end subroutine codes_set_force_real4_array + call grib_set_force_real4_array(msgid, key, value, status) + end subroutine codes_set_force_real4_array !> Set the real(8) values for an array key in a grib message, forces the set if the key is read-only. !> Use with great caution!! @@ -2398,14 +2383,14 @@ end subroutine codes_set_force_real4_array !> @param key key name !> @param value real(8) array value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_force_real8_array ( msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_force_real8_array(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_force_real8_array ( msgid, key, value, status) -end subroutine codes_set_force_real8_array + call grib_set_force_real8_array(msgid, key, value, status) + end subroutine codes_set_force_real8_array !> @endcond !> Set the character value for a string key in a message. @@ -2418,14 +2403,14 @@ end subroutine codes_set_force_real8_array !> @param key key name !> @param value character value !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_string ( msgid, key, value , status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=*), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_string(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=*), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_string ( msgid, key, value , status) -end subroutine codes_set_string + call grib_set_string(msgid, key, value, status) + end subroutine codes_set_string !> Get the size of a coded message. !> @@ -2436,14 +2421,13 @@ end subroutine codes_set_string !> @param msgid id of the grib loaded in memory !> @param nbytes size in bytes of the message !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_message_size_int ( msgid, nbytes, status) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfInt), intent(out) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_get_message_size_int ( msgid, nbytes, status) -end subroutine codes_get_message_size_int + subroutine codes_get_message_size_int(msgid, nbytes, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), intent(out) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_get_message_size_int(msgid, nbytes, status) + end subroutine codes_get_message_size_int !> Get the size of a coded message. !> @@ -2454,13 +2438,13 @@ end subroutine codes_get_message_size_int !> @param msgid id of the grib loaded in memory !> @param nbytes size in bytes of the message !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_get_message_size_size_t ( msgid, nbytes, status) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfSize_t), intent(out) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_get_message_size_size_t(msgid, nbytes, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfSize_t), intent(out) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_get_message_size_size_t ( msgid, nbytes, status) -end subroutine codes_get_message_size_size_t + call grib_get_message_size_size_t(msgid, nbytes, status) + end subroutine codes_get_message_size_size_t !> Copy the coded message into an array. !> @@ -2471,13 +2455,13 @@ end subroutine codes_get_message_size_size_t !> @param msgid id of the grib loaded in memory !> @param message array containing the coded message to be copied !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_copy_message ( msgid, message, status ) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=1), dimension(:), intent(out) :: message - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_copy_message(msgid, message, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=1), dimension(:), intent(out) :: message + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_copy_message ( msgid, message, status ) -end subroutine codes_copy_message + call grib_copy_message(msgid, message, status) + end subroutine codes_copy_message !> Write the coded message to a file. !> @@ -2488,13 +2472,13 @@ end subroutine codes_copy_message !> @param msgid id of the grib loaded in memory !> @param ifile file id of a file opened with \ref codes_open_file !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_write ( msgid, ifile , status) - integer(kind=kindOfInt), intent(in) :: msgid - integer(kind=kindOfInt), intent(in) :: ifile - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_write(msgid, ifile, status) + integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_write ( msgid, ifile , status) -end subroutine codes_write + call grib_write(msgid, ifile, status) + end subroutine codes_write !> Write a multi field message to a file. !> @@ -2505,14 +2489,13 @@ end subroutine codes_write !> @param multigribid id of the multi field grib loaded in memory !> @param ifile file id of a file opened with \ref codes_open_file !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_multi_write ( multigribid, ifile , status) - integer(kind=kindOfInt), intent(in) :: multigribid - integer(kind=kindOfInt), intent(in) :: ifile - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_multi_write ( multigribid, ifile , status) -end subroutine codes_grib_multi_write + subroutine codes_grib_multi_write(multigribid, ifile, status) + integer(kind=kindOfInt), intent(in) :: multigribid + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_multi_write(multigribid, ifile, status) + end subroutine codes_grib_multi_write !> Append a single field grib message to a multi field grib message. !> Only the sections with section number greather or equal "startsection" are copied from the input single message to the multi field output grib. @@ -2521,18 +2504,18 @@ end subroutine codes_grib_multi_write !> exit with an error message.\n Otherwise the error message can be !> gathered with @ref codes_get_error_string. !> - !> @param ingribid id of the input single grib + !> @param ingribid id of the input single grib !> @param startsection starting from startsection (included) all the sections are copied from the input single grib to the output multi grib !> @param multigribid id of the output multi field grib !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_multi_append ( ingribid, startsection, multigribid , status) - integer(kind=kindOfInt), intent(in) :: ingribid - integer(kind=kindOfInt), intent(in) :: startsection - integer(kind=kindOfInt), intent(out) :: multigribid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_multi_append(ingribid, startsection, multigribid, status) + integer(kind=kindOfInt), intent(in) :: ingribid + integer(kind=kindOfInt), intent(in) :: startsection + integer(kind=kindOfInt), intent(out) :: multigribid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_multi_append ( ingribid, startsection, multigribid , status) -end subroutine codes_grib_multi_append + call grib_multi_append(ingribid, startsection, multigribid, status) + end subroutine codes_grib_multi_append !> Find the nearest point of a set of points whose latitudes and longitudes !> are given in the inlats, inlons arrays respectively. @@ -2551,24 +2534,24 @@ end subroutine codes_grib_multi_append !> @param indexes output integer(4) array of the zero based indexes !> @param values output real(8) array of the values !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_find_nearest_multiple(gribid,is_lsm, & - inlats,inlons,outlats,outlons, & - values,distances, indexes,status) - integer(kind=kindOfInt), intent(in) :: gribid - logical, intent(in) :: is_lsm - real(kind = kindOfDouble), dimension(:), intent(in) :: inlats - real(kind = kindOfDouble), dimension(:), intent(in) :: inlons - real(kind = kindOfDouble), dimension(:), intent(out) :: outlats - real(kind = kindOfDouble), dimension(:), intent(out) :: outlons - real(kind = kindOfDouble), dimension(:), intent(out) :: distances - real(kind = kindOfDouble), dimension(:), intent(out) :: values - integer(kind = kindOfInt), dimension(:), intent(out) :: indexes - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_find_nearest_multiple(gribid, is_lsm, & + inlats, inlons, outlats, outlons, & + values, distances, indexes, status) + integer(kind=kindOfInt), intent(in) :: gribid + logical, intent(in) :: is_lsm + real(kind=kindOfDouble), dimension(:), intent(in) :: inlats + real(kind=kindOfDouble), dimension(:), intent(in) :: inlons + real(kind=kindOfDouble), dimension(:), intent(out) :: outlats + real(kind=kindOfDouble), dimension(:), intent(out) :: outlons + real(kind=kindOfDouble), dimension(:), intent(out) :: distances + real(kind=kindOfDouble), dimension(:), intent(out) :: values + integer(kind=kindOfInt), dimension(:), intent(out) :: indexes + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_find_nearest_multiple(gribid,is_lsm, & - inlats,inlons,outlats,outlons, & - values,distances, indexes,status) -end subroutine codes_grib_find_nearest_multiple + call grib_find_nearest_multiple(gribid, is_lsm, & + inlats, inlons, outlats, outlons, & + values, distances, indexes, status) + end subroutine codes_grib_find_nearest_multiple !> Find the nearest point of a given latitude/longitude point. !> @@ -2586,25 +2569,24 @@ end subroutine codes_grib_find_nearest_multiple !> @param kindex zero based index !> @param value value of the field in the nearest point !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_find_nearest_single(gribid,is_lsm, & - inlat,inlon,outlat,outlon, & - value,distance, kindex,status) - integer(kind=kindOfInt), intent(in) :: gribid - logical, intent(in) :: is_lsm - real(kind = kindOfDouble), intent(in) :: inlat - real(kind = kindOfDouble), intent(in) :: inlon - real(kind = kindOfDouble), intent(out) :: outlat - real(kind = kindOfDouble), intent(out) :: outlon - real(kind = kindOfDouble), intent(out) :: distance - real(kind = kindOfDouble), intent(out) :: value - integer(kind = kindOfInt), intent(out) :: kindex - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_find_nearest_single(gribid,is_lsm, & - inlat,inlon,outlat,outlon, & - value,distance, kindex,status) -end subroutine codes_grib_find_nearest_single + subroutine codes_grib_find_nearest_single(gribid, is_lsm, & + inlat, inlon, outlat, outlon, & + value, distance, kindex, status) + integer(kind=kindOfInt), intent(in) :: gribid + logical, intent(in) :: is_lsm + real(kind=kindOfDouble), intent(in) :: inlat + real(kind=kindOfDouble), intent(in) :: inlon + real(kind=kindOfDouble), intent(out) :: outlat + real(kind=kindOfDouble), intent(out) :: outlon + real(kind=kindOfDouble), intent(out) :: distance + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), intent(out) :: kindex + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_find_nearest_single(gribid, is_lsm, & + inlat, inlon, outlat, outlon, & + value, distance, kindex, status) + end subroutine codes_grib_find_nearest_single !> Find the 4 nearest points of a latitude longitude point. !> @@ -2622,26 +2604,25 @@ end subroutine codes_grib_find_nearest_single !> @param kindex zero based index !> @param value value of the field in the nearest point !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_find_nearest_four_single(gribid,is_lsm, & - inlat,inlon,outlat,outlon, & - value,distance, kindex,status) - integer(kind=kindOfInt), intent(in) :: gribid - logical, intent(in) :: is_lsm - real(kind = kindOfDouble), intent(in) :: inlat - real(kind = kindOfDouble), intent(in) :: inlon - real(kind = kindOfDouble), dimension(4), intent(out) :: outlat - real(kind = kindOfDouble), dimension(4), intent(out) :: outlon - real(kind = kindOfDouble), dimension(4), intent(out) :: distance - real(kind = kindOfDouble), dimension(4), intent(out) :: value - integer(kind = kindOfInt), dimension(4), intent(out) :: kindex - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_find_nearest_four_single(gribid, is_lsm, & + inlat, inlon, outlat, outlon, & + value, distance, kindex, status) + integer(kind=kindOfInt), intent(in) :: gribid + logical, intent(in) :: is_lsm + real(kind=kindOfDouble), intent(in) :: inlat + real(kind=kindOfDouble), intent(in) :: inlon + real(kind=kindOfDouble), dimension(4), intent(out) :: outlat + real(kind=kindOfDouble), dimension(4), intent(out) :: outlon + real(kind=kindOfDouble), dimension(4), intent(out) :: distance + real(kind=kindOfDouble), dimension(4), intent(out) :: value + integer(kind=kindOfInt), dimension(4), intent(out) :: kindex + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_find_nearest_four_single(gribid,is_lsm, & - inlat,inlon,outlat,outlon, & - value,distance, kindex,status) + call grib_find_nearest_four_single(gribid, is_lsm, & + inlat, inlon, outlat, outlon, & + value, distance, kindex, status) end subroutine codes_grib_find_nearest_four_single - !> Turn on the support for multiple fields in a single message. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -2649,11 +2630,11 @@ subroutine codes_grib_find_nearest_four_single(gribid,is_lsm, & !> gathered with @ref codes_get_error_string. !> !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_multi_support_on (status ) - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_multi_support_on(status) + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_multi_support_on (status ) -end subroutine codes_grib_multi_support_on + call grib_multi_support_on(status) + end subroutine codes_grib_multi_support_on !> Turn off the support for multiple fields in a single message. !> @@ -2662,11 +2643,11 @@ end subroutine codes_grib_multi_support_on !> gathered with @ref codes_get_error_string. !> !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_grib_multi_support_off ( status ) - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_grib_multi_support_off(status) + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_multi_support_off ( status ) -end subroutine codes_grib_multi_support_off + call grib_multi_support_off(status) + end subroutine codes_grib_multi_support_off !> Turn on the compatibility mode with gribex. !> @@ -2675,11 +2656,11 @@ end subroutine codes_grib_multi_support_off !> gathered with @ref codes_get_error_string. !> !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_gribex_mode_on (status ) - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_gribex_mode_on(status) + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_gribex_mode_on (status ) -end subroutine codes_gribex_mode_on + call grib_gribex_mode_on(status) + end subroutine codes_gribex_mode_on !> Turn off the compatibility mode with GRIBEX. !> @@ -2688,11 +2669,11 @@ end subroutine codes_gribex_mode_on !> gathered with @ref codes_get_error_string. !> !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_gribex_mode_off (status ) - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_gribex_mode_off(status) + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_gribex_mode_off (status ) -end subroutine codes_gribex_mode_off + call grib_gribex_mode_off(status) + end subroutine codes_gribex_mode_off !> Skip the computed keys in a keys iterator. !> @@ -2707,12 +2688,12 @@ end subroutine codes_gribex_mode_off !> !> @param iterid keys iterator id !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_skip_computed ( iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_skip_computed(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_skip_computed ( iterid , status) -end subroutine codes_skip_computed + call grib_skip_computed(iterid, status) + end subroutine codes_skip_computed !> Skip the coded keys in a keys iterator. !> @@ -2726,12 +2707,12 @@ end subroutine codes_skip_computed !> !> @param iterid keys iterator id !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_skip_coded ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_skip_coded(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_skip_coded ( iterid, status ) -end subroutine codes_skip_coded + call grib_skip_coded(iterid, status) + end subroutine codes_skip_coded !> Skip the duplicated keys in a keys iterator. !> @@ -2743,12 +2724,12 @@ end subroutine codes_skip_coded !> !> @param iterid keys iterator id !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_skip_duplicates ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_skip_duplicates(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_skip_duplicates ( iterid, status ) -end subroutine codes_skip_duplicates + call grib_skip_duplicates(iterid, status) + end subroutine codes_skip_duplicates !> Skip the read_only keys in a keys iterator. !> @@ -2758,13 +2739,12 @@ end subroutine codes_skip_duplicates !> !> @param iterid keys iterator id !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_skip_read_only ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - - call grib_skip_read_only ( iterid, status ) -end subroutine codes_skip_read_only + subroutine codes_skip_read_only(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + call grib_skip_read_only(iterid, status) + end subroutine codes_skip_read_only !> Set the definition path !> @@ -2774,12 +2754,12 @@ end subroutine codes_skip_read_only !> !> @param path definitions path !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_definitions_path ( path, status ) - character(len=*), intent(in) :: path - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_definitions_path(path, status) + character(len=*), intent(in) :: path + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_definitions_path ( path, status ) -end subroutine codes_set_definitions_path + call grib_set_definitions_path(path, status) + end subroutine codes_set_definitions_path !> Set the samples path !> @@ -2789,47 +2769,46 @@ end subroutine codes_set_definitions_path !> !> @param path samples path !> @param status CODES_SUCCESS if OK, integer value on error -subroutine codes_set_samples_path ( path, status ) - character(len=*), intent(in) :: path - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_set_samples_path(path, status) + character(len=*), intent(in) :: path + integer(kind=kindOfInt), optional, intent(out) :: status - call grib_set_samples_path ( path, status ) -end subroutine codes_set_samples_path + call grib_set_samples_path(path, status) + end subroutine codes_set_samples_path - -subroutine codes_julian_to_datetime ( jd,year,month,day,hour,minute,second, status ) - real(kind=kindOfDouble) , intent(in) :: jd - integer(kind=kindOfLong) , intent(out) :: year,month,day,hour,minute,second - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_julian_to_datetime(jd, year, month, day, hour, minute, second, status) + real(kind=kindOfDouble), intent(in) :: jd + integer(kind=kindOfLong), intent(out) :: year, month, day, hour, minute, second + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_julian_to_datetime(jd,year,month,day,hour,minute,second) + iret = grib_f_julian_to_datetime(jd, year, month, day, hour, minute, second) if (iret /= 0) then if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'codes_julian_to_datetime',' ') - endif + call grib_check(iret, 'codes_julian_to_datetime', ' ') + end if return - endif -end subroutine codes_julian_to_datetime + end if + end subroutine codes_julian_to_datetime -subroutine codes_datetime_to_julian ( year,month,day,hour,minute,second,jd, status ) - integer(kind=kindOfLong) , intent(in) :: year,month,day,hour,minute,second - real (kind=kindOfDouble) , intent(out) :: jd - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_datetime_to_julian(year, month, day, hour, minute, second, jd, status) + integer(kind=kindOfLong), intent(in) :: year, month, day, hour, minute, second + real(kind=kindOfDouble), intent(out) :: jd + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_datetime_to_julian(year,month,day,hour,minute,second,jd) + iret = grib_f_datetime_to_julian(year, month, day, hour, minute, second, jd) if (iret /= 0) then if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'codes_datetime_to_julian',' ') - endif + call grib_check(iret, 'codes_datetime_to_julian', ' ') + end if return - endif -end subroutine codes_datetime_to_julian + end if + end subroutine codes_datetime_to_julian !> Copy the value of a key from the source message to the destination message !> @@ -2841,45 +2820,44 @@ end subroutine codes_datetime_to_julian !> @param msgid_dest destination message !> @param key key whose value is to be copied !> @param status GRIB_SUCCESS if OK, integer value on error -subroutine codes_copy_key( msgid_src, key, msgid_dest, status ) - integer(kind=kindOfInt), intent(in) :: msgid_src - integer(kind=kindOfInt), intent(in) :: msgid_dest - character(LEN=*), intent(in) :: key - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_copy_key(msgid_src, key, msgid_dest, status) + integer(kind=kindOfInt), intent(in) :: msgid_src + integer(kind=kindOfInt), intent(in) :: msgid_dest + character(LEN=*), intent(in) :: key + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_copy_key(msgid_src, key, msgid_dest) + iret = grib_f_copy_key(msgid_src, key, msgid_dest) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'codes_copy_key','('//key//')') - endif -end subroutine codes_copy_key + call grib_check(iret, 'codes_copy_key', '('//key//')') + end if + end subroutine codes_copy_key -subroutine codes_bufr_multi_element_constant_arrays_on (status ) - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_bufr_multi_element_constant_arrays_on(status) + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=codes_f_bufr_multi_element_constant_arrays_on() + iret = codes_f_bufr_multi_element_constant_arrays_on() if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'codes_bufr_multi_element_constant_arrays_on','') - endif -end subroutine codes_bufr_multi_element_constant_arrays_on + call grib_check(iret, 'codes_bufr_multi_element_constant_arrays_on', '') + end if + end subroutine codes_bufr_multi_element_constant_arrays_on -subroutine codes_bufr_multi_element_constant_arrays_off (status ) - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine codes_bufr_multi_element_constant_arrays_off(status) + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=codes_f_bufr_multi_element_constant_arrays_off() + iret = codes_f_bufr_multi_element_constant_arrays_off() if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'codes_bufr_multi_element_constant_arrays_off','') - endif - -end subroutine codes_bufr_multi_element_constant_arrays_off + call grib_check(iret, 'codes_bufr_multi_element_constant_arrays_off', '') + end if + end subroutine codes_bufr_multi_element_constant_arrays_off end module eccodes diff --git a/fortran/fortranCtypes/test.f90 b/fortran/fortranCtypes/test.f90 index 2a059fab0..3461b448c 100644 --- a/fortran/fortranCtypes/test.f90 +++ b/fortran/fortranCtypes/test.f90 @@ -4,25 +4,25 @@ integer function kind_of_long_long integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_long_long=-1 + kind_of_long_long = -1 - call check_long_long(x2(0),x2(1),ret) + call check_long_long(x2(0), x2(1), ret) if (ret == 't') then - kind_of_long_long=2 - return - endif + kind_of_long_long = 2 + return + end if - call check_long_long(x4(0),x4(1),ret) + call check_long_long(x4(0), x4(1), ret) if (ret == 't') then - kind_of_long_long=4 - return - endif + kind_of_long_long = 4 + return + end if - call check_long_long(x8(0),x8(1),ret) + call check_long_long(x8(0), x8(1), ret) if (ret == 't') then - kind_of_long_long=8 - return - endif + kind_of_long_long = 8 + return + end if end function kind_of_long_long @@ -32,25 +32,25 @@ integer function kind_of_size_t integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_size_t=-1 + kind_of_size_t = -1 - call check_size_t(x2(0),x2(1),ret) + call check_size_t(x2(0), x2(1), ret) if (ret == 't') then - kind_of_size_t=2 - return - endif + kind_of_size_t = 2 + return + end if - call check_size_t(x4(0),x4(1),ret) + call check_size_t(x4(0), x4(1), ret) if (ret == 't') then - kind_of_size_t=4 - return - endif + kind_of_size_t = 4 + return + end if - call check_size_t(x8(0),x8(1),ret) + call check_size_t(x8(0), x8(1), ret) if (ret == 't') then - kind_of_size_t=8 - return - endif + kind_of_size_t = 8 + return + end if end function kind_of_size_t @@ -60,25 +60,25 @@ integer function kind_of_long integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_long=-1 + kind_of_long = -1 - call check_long(x2(0),x2(1),ret) + call check_long(x2(0), x2(1), ret) if (ret == 't') then - kind_of_long=2 - return - endif + kind_of_long = 2 + return + end if - call check_long(x4(0),x4(1),ret) + call check_long(x4(0), x4(1), ret) if (ret == 't') then - kind_of_long=4 - return - endif + kind_of_long = 4 + return + end if - call check_long(x8(0),x8(1),ret) + call check_long(x8(0), x8(1), ret) if (ret == 't') then - kind_of_long=8 - return - endif + kind_of_long = 8 + return + end if end function kind_of_long @@ -88,25 +88,25 @@ integer function kind_of_int integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_int=-1 + kind_of_int = -1 - call check_int(x2(0),x2(1),ret) + call check_int(x2(0), x2(1), ret) if (ret == 't') then - kind_of_int=2 - return - endif + kind_of_int = 2 + return + end if - call check_int(x4(0),x4(1),ret) + call check_int(x4(0), x4(1), ret) if (ret == 't') then - kind_of_int=4 - return - endif + kind_of_int = 4 + return + end if - call check_int(x8(0),x8(1),ret) + call check_int(x8(0), x8(1), ret) if (ret == 't') then - kind_of_int=8 - return - endif + kind_of_int = 8 + return + end if end function kind_of_int @@ -115,19 +115,19 @@ integer function kind_of_float real(8), dimension(2) :: x8 = (/1., 2./) character(len=1) :: ret - kind_of_float=-1 + kind_of_float = -1 - call check_float(x4(0),x4(1),ret) + call check_float(x4(0), x4(1), ret) if (ret == 't') then - kind_of_float=4 - return - endif + kind_of_float = 4 + return + end if - call check_float(x8(0),x8(1),ret) + call check_float(x8(0), x8(1), ret) if (ret == 't') then - kind_of_float=8 - return - endif + kind_of_float = 8 + return + end if end function kind_of_float @@ -136,30 +136,30 @@ integer function kind_of_double real(8), dimension(2) :: real8 = (/1., 2./) character(len=1) :: ret - kind_of_double=-1 + kind_of_double = -1 - call check_double(real4(0),real4(1),ret) + call check_double(real4(0), real4(1), ret) if (ret == 't') then - kind_of_double=4 - return - endif + kind_of_double = 4 + return + end if - call check_double(real8(0),real8(1),ret) + call check_double(real8(0), real8(1), ret) if (ret == 't') then - kind_of_double=8 - return - endif + kind_of_double = 8 + return + end if end function kind_of_double program test - print *,'kind_of_double=',kind_of_double() - print *,'kind_of_float=',kind_of_float() - print *,'kind_of_int=',kind_of_int() - print *,'kind_of_long=',kind_of_long() - print *,'kind_of_size_t=',kind_of_size_t() - print *,'kind_of_long_long=',kind_of_long_long() + print *, 'kind_of_double=', kind_of_double() + print *, 'kind_of_float=', kind_of_float() + print *, 'kind_of_int=', kind_of_int() + print *, 'kind_of_long=', kind_of_long() + print *, 'kind_of_size_t=', kind_of_size_t() + print *, 'kind_of_long_long=', kind_of_long_long() end program test diff --git a/fortran/grib_f90_head.f90 b/fortran/grib_f90_head.f90 index 987203b2d..ee3eebdab 100644 --- a/fortran/grib_f90_head.f90 +++ b/fortran/grib_f90_head.f90 @@ -18,9 +18,8 @@ module grib_api include "grib_api_externals.h" include "grib_api_visibility.h" - real(8), parameter,public :: GRIB_MISSING_DOUBLE = -1.D+100 - integer(4), parameter,public :: GRIB_MISSING_LONG = 2147483647 - + real(8), parameter, public :: GRIB_MISSING_DOUBLE = -1.D+100 + integer(4), parameter, public :: GRIB_MISSING_LONG = 2147483647 !> Create a new message in memory from an integer or character array containting the coded message. !> @@ -39,8 +38,8 @@ module grib_api !> @param message array containing the coded message !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_new_from_message - module procedure grib_new_from_message_int4 - module procedure grib_new_from_message_char + module procedure grib_new_from_message_int4 + module procedure grib_new_from_message_char end interface grib_new_from_message !> Get a value of specified index from an array key. @@ -67,9 +66,9 @@ module grib_api !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_get_element module procedure grib_get_real4_element, & - grib_get_real8_element, & - grib_get_real4_elements, & - grib_get_real8_elements + grib_get_real8_element, & + grib_get_real4_elements, & + grib_get_real8_elements end interface grib_get_element !> Find the nearest point/points of a given latitude/longitude point. @@ -110,8 +109,8 @@ module grib_api !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_find_nearest module procedure grib_find_nearest_single, & - grib_find_nearest_four_single, & - grib_find_nearest_multiple + grib_find_nearest_four_single, & + grib_find_nearest_multiple end interface grib_find_nearest !> Get latitude/longitude and data values. @@ -134,6 +133,6 @@ module grib_api !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_get_data module procedure grib_get_data_real4, & - grib_get_data_real8 + grib_get_data_real8 end interface grib_get_data diff --git a/fortran/grib_f90_int.f90 b/fortran/grib_f90_int.f90 index ec4307d40..d474cfa8e 100644 --- a/fortran/grib_f90_int.f90 +++ b/fortran/grib_f90_int.f90 @@ -2,11 +2,10 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. - !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. !> !> @@ -22,8 +21,8 @@ !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_index_get module procedure grib_index_get_int, & - grib_index_get_string, & - grib_index_get_real8 + grib_index_get_string, & + grib_index_get_real8 end interface grib_index_get !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. @@ -40,10 +39,10 @@ !> @param size number of distinct values of the key in the index !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_index_get_size - module procedure grib_index_get_size_int + module procedure grib_index_get_size_int end interface grib_index_get_size - - !> Select the message subset with key==value. + + !> Select the message subset with key==value. !> !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -58,8 +57,8 @@ !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_index_select module procedure grib_index_select_int, & - grib_index_select_string, & - grib_index_select_real8 + grib_index_select_string, & + grib_index_select_real8 end interface grib_index_select !> Get the value for a key from a message. @@ -94,16 +93,15 @@ !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_get module procedure grib_get_int, & - grib_get_real4, & - grib_get_real8, & - grib_get_string, & - grib_get_int_array, & - grib_get_byte_array, & - grib_get_real4_array, & - grib_get_real8_array + grib_get_real4, & + grib_get_real8, & + grib_get_string, & + grib_get_int_array, & + grib_get_byte_array, & + grib_get_real4_array, & + grib_get_real8_array end interface grib_get - !> Get the size of an array key. !> !> To get the size of a key representing an array. @@ -117,7 +115,7 @@ !> @param size size of the array key !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_get_size - module procedure grib_get_size_int + module procedure grib_get_size_int end interface grib_get_size !> Set the value for a key in a message. @@ -145,16 +143,16 @@ !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_set module procedure grib_set_int, & - grib_set_real4, & - grib_set_real8, & - grib_set_string, & - grib_set_int_array, & - grib_set_byte_array, & - grib_set_real4_array, & - grib_set_real8_array + grib_set_real4, & + grib_set_real8, & + grib_set_string, & + grib_set_int_array, & + grib_set_byte_array, & + grib_set_real4_array, & + grib_set_real8_array end interface grib_set interface grib_set_force module procedure grib_set_force_real4_array, & - grib_set_force_real8_array + grib_set_force_real8_array end interface grib_set_force diff --git a/fortran/grib_f90_int_size_t.f90 b/fortran/grib_f90_int_size_t.f90 index bd6cf83de..5468b6f45 100644 --- a/fortran/grib_f90_int_size_t.f90 +++ b/fortran/grib_f90_int_size_t.f90 @@ -18,8 +18,8 @@ !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_read_from_file - module procedure grib_read_from_file_int4 - module procedure grib_read_from_file_char + module procedure grib_read_from_file_int4 + module procedure grib_read_from_file_char end interface grib_read_from_file !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -34,10 +34,10 @@ !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_read_bytes - module procedure grib_read_bytes_int4 - module procedure grib_read_bytes_char - module procedure grib_read_bytes_real8 - module procedure grib_read_bytes_real4 + module procedure grib_read_bytes_int4 + module procedure grib_read_bytes_char + module procedure grib_read_bytes_real8 + module procedure grib_read_bytes_real4 end interface grib_read_bytes !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -52,10 +52,10 @@ !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_write_bytes - module procedure grib_write_bytes_int4 - module procedure grib_write_bytes_char - module procedure grib_write_bytes_real8 - module procedure grib_write_bytes_real4 + module procedure grib_write_bytes_int4 + module procedure grib_write_bytes_char + module procedure grib_write_bytes_real8 + module procedure grib_write_bytes_real4 end interface grib_write_bytes !> Get the size of a coded message. diff --git a/fortran/grib_f90_long_int.f90 b/fortran/grib_f90_long_int.f90 index 53a4e2829..9cd98a352 100644 --- a/fortran/grib_f90_long_int.f90 +++ b/fortran/grib_f90_long_int.f90 @@ -2,11 +2,10 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. - !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. !> !> @@ -22,9 +21,9 @@ !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_index_get module procedure grib_index_get_int, & - grib_index_get_long, & - grib_index_get_string, & - grib_index_get_real8 + grib_index_get_long, & + grib_index_get_string, & + grib_index_get_real8 end interface grib_index_get !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. @@ -42,10 +41,10 @@ !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_index_get_size module procedure grib_index_get_size_int, & - grib_index_get_size_long + grib_index_get_size_long end interface grib_index_get_size - - !> Select the message subset with key==value. + + !> Select the message subset with key==value. !> !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -60,11 +59,11 @@ !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_index_select module procedure grib_index_select_int, & - grib_index_select_long, & - grib_index_select_string, & - grib_index_select_real8 + grib_index_select_long, & + grib_index_select_string, & + grib_index_select_real8 end interface grib_index_select - + !> Get the value for a key from a message. !> !> Given a \em msgid and \em key as input a \em value for the \em key is returned. @@ -97,14 +96,14 @@ !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_get module procedure grib_get_int, & - grib_get_long, & - grib_get_real4, & - grib_get_real8, & - grib_get_string, & - grib_get_int_array, & - grib_get_byte_array, & - grib_get_real4_array, & - grib_get_real8_array + grib_get_long, & + grib_get_real4, & + grib_get_real8, & + grib_get_string, & + grib_get_int_array, & + grib_get_byte_array, & + grib_get_real4_array, & + grib_get_real8_array end interface grib_get !> Get the size of an array key. @@ -120,8 +119,8 @@ !> @param size size of the array key !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_get_size - module procedure grib_get_size_int, & - grib_get_size_long + module procedure grib_get_size_int, & + grib_get_size_long end interface grib_get_size !> Set the value for a key in a message. @@ -149,18 +148,18 @@ !> @param[out] status GRIB_SUCCESS if OK, integer value on error interface grib_set module procedure grib_set_int, & - grib_set_long, & - grib_set_real4, & - grib_set_real8, & - grib_set_string, & - grib_set_int_array, & - grib_set_long_array, & - grib_set_byte_array, & - grib_set_real4_array, & - grib_set_real8_array + grib_set_long, & + grib_set_real4, & + grib_set_real8, & + grib_set_string, & + grib_set_int_array, & + grib_set_long_array, & + grib_set_byte_array, & + grib_set_real4_array, & + grib_set_real8_array end interface grib_set interface grib_set_force module procedure grib_set_force_real4_array, & - grib_set_force_real8_array + grib_set_force_real8_array end interface grib_set_force diff --git a/fortran/grib_f90_long_size_t.f90 b/fortran/grib_f90_long_size_t.f90 index 74ad5b0ce..7aabcfae7 100644 --- a/fortran/grib_f90_long_size_t.f90 +++ b/fortran/grib_f90_long_size_t.f90 @@ -18,10 +18,10 @@ !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_read_from_file - module procedure grib_read_from_file_int4 - module procedure grib_read_from_file_int4_size_t - module procedure grib_read_from_file_char - module procedure grib_read_from_file_char_size_t + module procedure grib_read_from_file_int4 + module procedure grib_read_from_file_int4_size_t + module procedure grib_read_from_file_char + module procedure grib_read_from_file_char_size_t end interface grib_read_from_file !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -36,14 +36,14 @@ !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_read_bytes - module procedure grib_read_bytes_int4 - module procedure grib_read_bytes_int4_size_t - module procedure grib_read_bytes_char - module procedure grib_read_bytes_char_size_t - module procedure grib_read_bytes_real8 - module procedure grib_read_bytes_real8_size_t - module procedure grib_read_bytes_real4 - module procedure grib_read_bytes_real4_size_t + module procedure grib_read_bytes_int4 + module procedure grib_read_bytes_int4_size_t + module procedure grib_read_bytes_char + module procedure grib_read_bytes_char_size_t + module procedure grib_read_bytes_real8 + module procedure grib_read_bytes_real8_size_t + module procedure grib_read_bytes_real4 + module procedure grib_read_bytes_real4_size_t end interface grib_read_bytes !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -58,14 +58,14 @@ !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_write_bytes - module procedure grib_write_bytes_int4 - module procedure grib_write_bytes_int4_size_t - module procedure grib_write_bytes_char - module procedure grib_write_bytes_char_size_t - module procedure grib_write_bytes_real8 - module procedure grib_write_bytes_real8_size_t - module procedure grib_write_bytes_real4 - module procedure grib_write_bytes_real4_size_t + module procedure grib_write_bytes_int4 + module procedure grib_write_bytes_int4_size_t + module procedure grib_write_bytes_char + module procedure grib_write_bytes_char_size_t + module procedure grib_write_bytes_real8 + module procedure grib_write_bytes_real8_size_t + module procedure grib_write_bytes_real4 + module procedure grib_write_bytes_real4_size_t end interface grib_write_bytes !> Get the size of a coded message. diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index 6e73253e1..e58f9debe 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -15,21 +15,21 @@ !> @param gribid id of the grib loaded in memory !> @param key key name !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_missing ( gribid, key, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_missing(gribid, key, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_missing ( gribid, key ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set_missing','('//key//')') - endif + iret = grib_f_set_missing(gribid, key) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set_missing', '('//key//')') + end if end subroutine grib_set_missing !> Create a new index form a file. The file is indexed with the keys in argument. @@ -45,19 +45,19 @@ !> @param filename name of the file of messages to be indexed !> @param keys : comma separated list of keys for the index. The type of the key can be explicitly declared appending :l for long, :d for double, :s for string to the key name. If the type is not declared explicitly, the native type is assumed. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_create ( indexid, filename, keys, status ) - integer(kind=kindOfInt), intent(inout) :: indexid - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: keys - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_create(indexid, filename, keys, status) + integer(kind=kindOfInt), intent(inout) :: indexid + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: keys + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_new_from_file(filename,keys,indexid) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_create','('//filename//')') - endif + iret = grib_f_index_new_from_file(filename, keys, indexid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_create', '('//filename//')') + end if end subroutine grib_index_create !> Add a file to an index. @@ -72,18 +72,18 @@ !> @param indexid id of the index I want to add a file to !> @param filename name of the file I want to add to the index !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_add_file ( indexid, filename, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: filename - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_add_file(indexid, filename, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: filename + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_add_file(indexid,filename) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_add_file','('//filename//')') - endif + iret = grib_f_index_add_file(indexid, filename) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_add_file', '('//filename//')') + end if end subroutine grib_index_add_file !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. @@ -99,19 +99,19 @@ !> @param key key for which the number of values is computed !> @param size number of distinct values of the key in the index !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_get_size_long( indexid, key, size, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - integer(kind=kindOfLong), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_get_size_long(indexid, key, size, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_get_size_long(indexid,key,size) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_get_size','('//key//')') - endif + iret = grib_f_index_get_size_long(indexid, key, size) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_get_size', '('//key//')') + end if end subroutine grib_index_get_size_long !> Get the number of distinct values of the key in argument contained in the index. The key must belong to the index. @@ -127,19 +127,19 @@ !> @param key key for which the number of values is computed !> @param size number of distinct values of the key in the index !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_get_size_int( indexid, key, size, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_get_size_int(indexid, key, size, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_get_size_int(indexid,key,size) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_get_size','('//key//')') - endif + iret = grib_f_index_get_size_int(indexid, key, size) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_get_size', '('//key//')') + end if end subroutine grib_index_get_size_int !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. This function is used when the type of the key was explicitly defined as long or when the native type of the key is long. @@ -155,21 +155,21 @@ !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_get_int( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_index_get_int(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(values) - iret=grib_f_index_get_int ( indexid, key, values , nb_values ) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_get','('//key//')') - endif + nb_values = size(values) + iret = grib_f_index_get_int(indexid, key, values, nb_values) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_get', '('//key//')') + end if end subroutine grib_index_get_int !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. This function is used when the type of the key was explicitly defined as long or when the native type of the key is long. @@ -185,21 +185,21 @@ !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_get_long( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - integer(kind=kindOfLong), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_index_get_long(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(values) - iret=grib_f_index_get_long ( indexid, key, values , nb_values ) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_get','('//key//')') - endif + nb_values = size(values) + iret = grib_f_index_get_long(indexid, key, values, nb_values) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_get', '('//key//')') + end if end subroutine grib_index_get_long !> Get the distinct values of the key in argument contained in the index. The key must belong to the index. This function is used when the type of the key was explicitly defined as long or when the native type of the key is long. @@ -215,25 +215,25 @@ !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_get_real8( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - real(kind=kindOfDouble), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_index_get_real8(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(values) - iret=grib_f_index_get_real8 ( indexid, key, values , nb_values ) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_get','('//key//')') - endif + nb_values = size(values) + iret = grib_f_index_get_real8(indexid, key, values, nb_values) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_get', '('//key//')') + end if end subroutine grib_index_get_real8 - !> Get the distinct values of the key in argument contained in the index. - !> The key must belong to the index. + !> Get the distinct values of the key in argument contained in the index. + !> The key must belong to the index. !> This function is used when the type of the key was explicitly defined as string or when the native type of the key is string. !> !> @@ -247,25 +247,25 @@ !> @param key key for wich the values are returned !> @param values array of values. The array must be allocated before entering this function and its size must be enough to contain all the values. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_get_string( indexid, key, values, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - character(len=*), dimension(:), intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values - integer(kind=kindOfInt) :: size_value + subroutine grib_index_get_string(indexid, key, values, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + character(len=*), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values + integer(kind=kindOfInt) :: size_value size_value = len(values(1)) nb_values = size(values) - iret=grib_f_index_get_string ( indexid, key, values , size_value,nb_values ) + iret = grib_f_index_get_string(indexid, key, values, size_value, nb_values) if (present(status)) then status = iret else - call grib_check(iret,'index_get','('//key//')') - endif + call grib_check(iret, 'index_get', '('//key//')') + end if end subroutine grib_index_get_string - !> Select the message subset with key==value. The value is a integer. + !> Select the message subset with key==value. The value is a integer. !> The key must have been created with string type or have string as native type if the type was not explicitly defined in the index creation. !> !> @@ -279,19 +279,19 @@ !> @param key key to be selected !> @param value value of the key to select !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_select_string( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - character(len=*), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_select_string(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + character(len=*), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_select_string ( indexid, key, value ) + iret = grib_f_index_select_string(indexid, key, value) if (present(status)) then status = iret else - call grib_check(iret,'index_select','('//key//')') - endif + call grib_check(iret, 'index_select', '('//key//')') + end if end subroutine grib_index_select_string !> Select the message subset with key==value. The value is a integer. The key must have been created with integer type or have integer as native type if the type was not explicitly defined in the index creation. @@ -307,19 +307,19 @@ !> @param key key to be selected !> @param value value of the key to select !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_select_int( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine grib_index_select_int(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key integer(kind=kindOfInt), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_index_select_int ( indexid, key, value ) + iret = grib_f_index_select_int(indexid, key, value) if (present(status)) then status = iret else - call grib_check(iret,'index_select','('//key//')') - endif + call grib_check(iret, 'index_select', '('//key//')') + end if end subroutine grib_index_select_int !> Select the message subset with key==value. The value is a integer. The key must have been created with integer type or have integer as native type if the type was not explicitly defined in the index creation. @@ -335,19 +335,19 @@ !> @param key key to be selected !> @param value value of the key to select !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_select_long( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key + subroutine grib_index_select_long(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key integer(kind=kindOfLong), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_index_select_long ( indexid, key, value ) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_select','('//key//')') - endif + iret = grib_f_index_select_long(indexid, key, value) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_select', '('//key//')') + end if end subroutine grib_index_select_long !> Select the message subset with key==value. The value is a real. The key must have been created with real type or have real as native type if the type was not explicitly defined in the index creation. @@ -363,20 +363,20 @@ !> @param key key to be selected !> @param value value of the key to select !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_select_real8( indexid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: indexid - character(len=*), intent(in) :: key - real(kind=kindOfDouble), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_select_real8(indexid, key, value, status) + integer(kind=kindOfInt), intent(in) :: indexid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_select_real8 ( indexid, key, value ) + iret = grib_f_index_select_real8(indexid, key, value) if (present(status)) then status = iret else - call grib_check(iret,'index_select','('//key//')') - endif - end subroutine grib_index_select_real8 + call grib_check(iret, 'index_select', '('//key//')') + end if + end subroutine grib_index_select_real8 !> Create a new handle from an index after having selected the key values. !> All the keys belonging to the index must be selected before calling this function. Successive calls to this function will return all the handles compatible with the constraints defined selecting the values of the index keys. @@ -390,18 +390,18 @@ !> @param indexid id of an index created from a file. !> @param gribid id of the grib loaded in memory !> @param status GRIB_SUCCESS if OK, GRIB_END_OF_FILE at the end of file, or error code - subroutine grib_new_from_index ( indexid, gribid , status) - integer(kind=kindOfInt),intent(in) :: indexid - integer(kind=kindOfInt),intent(out) :: gribid - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_new_from_index(indexid, gribid, status) + integer(kind=kindOfInt), intent(in) :: indexid + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_new_from_index( indexid, gribid ) + iret = grib_f_new_from_index(indexid, gribid) if (present(status)) then status = iret else - call grib_check(iret,'new_from_index','') - endif + call grib_check(iret, 'new_from_index', '') + end if end subroutine grib_new_from_index !> Load an index file previously created with @ref grib_index_write. @@ -416,19 +416,19 @@ !> @param indexid id of loaded index !> @param filename name of the index file to load !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_read ( indexid, filename, status ) - integer(kind=kindOfInt), intent(inout) :: indexid - character(len=*), intent(in) :: filename - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_read(indexid, filename, status) + integer(kind=kindOfInt), intent(inout) :: indexid + character(len=*), intent(in) :: filename + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_read(filename,indexid) + iret = grib_f_index_read(filename, indexid) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'index_read','('//filename//')') - endif - + call grib_check(iret, 'index_read', '('//filename//')') + end if + end subroutine grib_index_read !> Saves an index to a file for later reuse. Index files can be read with @@ -444,19 +444,19 @@ !> @param indexid id of the index to save to file !> @param filename name of file to save the index to !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_write ( indexid, filename, status ) - integer(kind=kindOfInt), intent(inout) :: indexid - character(len=*), intent(in) :: filename - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_write(indexid, filename, status) + integer(kind=kindOfInt), intent(inout) :: indexid + character(len=*), intent(in) :: filename + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_write(indexid,filename) + iret = grib_f_index_write(indexid, filename) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'index_write','('//filename//')') - endif - + call grib_check(iret, 'index_write', '('//filename//')') + end if + end subroutine grib_index_write !> Delete the index. @@ -468,17 +468,17 @@ !> !> @param indexid id of an index created from a file. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_index_release ( indexid, status ) - integer(kind=kindOfInt), intent(in) :: indexid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_index_release(indexid, status) + integer(kind=kindOfInt), intent(in) :: indexid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_index_release ( indexid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'index_release','') - endif + iret = grib_f_index_release(indexid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'index_release', '') + end if end subroutine grib_index_release !> Open a file according to a mode. @@ -494,19 +494,19 @@ !> @param filename name of the file to be open !> @param mode open mode can be 'r' (read only), 'w' (write only) or 'a' (append) !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_open_file ( ifile, filename, mode, status ) - integer(kind=kindOfInt),intent(out) :: ifile - character(len=*), intent(in) :: filename - character(LEN=*), intent(in) :: mode - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_open_file(ifile, filename, mode, status) + integer(kind=kindOfInt), intent(out) :: ifile + character(len=*), intent(in) :: filename + character(LEN=*), intent(in) :: mode + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_open_file(ifile, filename, mode ) - if (present(status)) then - status = iret - else - call grib_check(iret,'open_file','('//filename//')') - endif + iret = grib_f_open_file(ifile, filename, mode) + if (present(status)) then + status = iret + else + call grib_check(iret, 'open_file', '('//filename//')') + end if end subroutine grib_open_file !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -521,21 +521,21 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_char ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_char(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + ibytes = nbytes + iret = grib_f_read_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_char !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -550,19 +550,19 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_char_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_char_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + iret = grib_f_read_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_char_size_t !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -577,21 +577,21 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_int4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_int4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + ibytes = nbytes + iret = grib_f_read_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_int4 !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -606,19 +606,19 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_int4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_int4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + iret = grib_f_read_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_int4_size_t !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -633,21 +633,21 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_real4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_real4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + ibytes = nbytes + iret = grib_f_read_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_real4 !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -662,19 +662,19 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_real4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_real4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + iret = grib_f_read_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_real4_size_t !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -689,21 +689,21 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_real8 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_real8(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + ibytes = nbytes + iret = grib_f_read_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_real8 !> Reads nbytes bytes into the buffer from a file opened with grib_open_file. @@ -718,19 +718,19 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_bytes_real8_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_bytes_real8_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_bytes','') - endif + iret = grib_f_read_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_bytes', '') + end if end subroutine grib_read_bytes_real8_size_t !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -745,25 +745,25 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_int4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_int4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) - if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then - iret = GRIB_MESSAGE_TOO_LARGE - endif - nbytes=ibytes - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + ibytes = nbytes + iret = grib_f_read_any_from_file(ifile, buffer, ibytes) + if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then + iret = GRIB_MESSAGE_TOO_LARGE + end if + nbytes = ibytes + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_int4 !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -778,19 +778,19 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_int4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_int4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + iret = grib_f_read_any_from_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_int4_size_t !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -805,25 +805,25 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_real4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_real4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) - if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then - iret = GRIB_MESSAGE_TOO_LARGE - endif - nbytes=ibytes - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + ibytes = nbytes + iret = grib_f_read_any_from_file(ifile, buffer, ibytes) + if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then + iret = GRIB_MESSAGE_TOO_LARGE + end if + nbytes = ibytes + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_real4 !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -838,19 +838,19 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_real4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_real4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + iret = grib_f_read_any_from_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_real4_size_t !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -865,25 +865,25 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_real8 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_real8(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) - if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then - iret = GRIB_MESSAGE_TOO_LARGE - endif - nbytes=ibytes - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + ibytes = nbytes + iret = grib_f_read_any_from_file(ifile, buffer, ibytes) + if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then + iret = GRIB_MESSAGE_TOO_LARGE + end if + nbytes = ibytes + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_real8 !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -898,19 +898,19 @@ !> @param buffer binary buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_real8_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_real8_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + iret = grib_f_read_any_from_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_real8_size_t !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -925,25 +925,25 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_char ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer - integer(kind=kindOfInt), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_char(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer + integer(kind=kindOfInt), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_read_any_from_file(ifile,buffer,ibytes) - if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then - iret = GRIB_MESSAGE_TOO_LARGE - endif - nbytes=ibytes - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + ibytes = nbytes + iret = grib_f_read_any_from_file(ifile, buffer, ibytes) + if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then + iret = GRIB_MESSAGE_TOO_LARGE + end if + nbytes = ibytes + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_char !> Reads a message in the buffer array from the file opened with grib_open_file. @@ -958,19 +958,19 @@ !> @param buffer buffer to be read !> @param nbytes number of bytes to be read !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_read_from_file_char_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1),dimension(:), intent(out) :: buffer - integer(kind=kindOfSize_t), intent(inout) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_read_from_file_char_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(out) :: buffer + integer(kind=kindOfSize_t), intent(inout) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_read_any_from_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'read_from_file','') - endif + iret = grib_f_read_any_from_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'read_from_file', '') + end if end subroutine grib_read_from_file_char_size_t !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -985,21 +985,21 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_char ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1), dimension(:),intent(in) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_char(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(in) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + ibytes = nbytes + iret = grib_f_write_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_char !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1014,19 +1014,19 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_char_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - character(len=1), dimension(:),intent(in) :: buffer - integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_char_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + character(len=1), dimension(:), intent(in) :: buffer + integer(kind=kindOfSize_t), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + iret = grib_f_write_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_char_size_t !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1041,21 +1041,21 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_int4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4), dimension(:),intent(in) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_int4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(in) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + ibytes = nbytes + iret = grib_f_write_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_int4 !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1070,19 +1070,19 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_int4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=4), dimension(:),intent(in) :: buffer - integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_int4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=4), dimension(:), intent(in) :: buffer + integer(kind=kindOfSize_t), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + iret = grib_f_write_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_int4_size_t !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1097,21 +1097,21 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_real4 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4), dimension(:),intent(in) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_real4(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(in) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + ibytes = nbytes + iret = grib_f_write_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_real4 !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1126,19 +1126,19 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_real4_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=4), dimension(:),intent(in) :: buffer - integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_real4_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=4), dimension(:), intent(in) :: buffer + integer(kind=kindOfSize_t), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + iret = grib_f_write_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_real4_size_t !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1153,21 +1153,21 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_real8 ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8), dimension(:),intent(in) :: buffer - integer(kind=kindOfInt), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfSize_t) :: ibytes - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_real8(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(in) :: buffer + integer(kind=kindOfInt), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: ibytes + integer(kind=kindOfInt) :: iret - ibytes=nbytes - iret=grib_f_write_file(ifile,buffer,ibytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + ibytes = nbytes + iret = grib_f_write_file(ifile, buffer, ibytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_real8 !> Write nbytes bytes from the buffer in a file opened with grib_open_file. @@ -1182,19 +1182,19 @@ !> @param buffer buffer to be written !> @param nbytes number of bytes to be written !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write_bytes_real8_size_t ( ifile, buffer, nbytes, status ) - integer(kind=kindOfInt),intent(in) :: ifile - real(kind=8), dimension(:),intent(in) :: buffer - integer(kind=kindOfSize_t), intent(in) :: nbytes - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_write_bytes_real8_size_t(ifile, buffer, nbytes, status) + integer(kind=kindOfInt), intent(in) :: ifile + real(kind=8), dimension(:), intent(in) :: buffer + integer(kind=kindOfSize_t), intent(in) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_write_file(ifile,buffer,nbytes) - if (present(status)) then - status = iret - else - call grib_check(iret,'write_bytes','') - endif + iret = grib_f_write_file(ifile, buffer, nbytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write_bytes', '') + end if end subroutine grib_write_bytes_real8_size_t !> Close a file. @@ -1210,17 +1210,17 @@ !> !> @param ifile is the id of the file to be closed. !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_close_file ( ifile , status ) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_close_file(ifile, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_close_file(ifile) - if (present(status)) then - status = iret - else - call grib_check(iret,'close_file','') - endif + iret = grib_f_close_file(ifile) + if (present(status)) then + status = iret + else + call grib_check(iret, 'close_file', '') + end if end subroutine grib_close_file !> Counts the messages in a file @@ -1230,18 +1230,18 @@ !> @param ifile id of the file opened with @ref grib_open_file !> @param n number of messages in the file !> @param status GRIB_SUCCESS if OK or error code - subroutine grib_count_in_file ( ifile, n , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: n - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_count_in_file(ifile, n, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: n + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_count_in_file( ifile, n ) - if (present(status)) then - status = iret - else - call grib_check(iret,'count_in_file','') - endif + iret = grib_f_count_in_file(ifile, n) + if (present(status)) then + status = iret + else + call grib_check(iret, 'count_in_file', '') + end if end subroutine grib_count_in_file !> Load in memory only the headers of a grib message from a file. @@ -1254,18 +1254,18 @@ !> @param ifile id of the file opened with @ref grib_open_file !> @param gribid id of the grib loaded in memory !> @param status GRIB_SUCCESS if OK, GRIB_END_OF_FILE at the end of file, or error code - subroutine grib_headers_only_new_from_file ( ifile, gribid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: gribid - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_headers_only_new_from_file(ifile, gribid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_headers_only_new_from_file( ifile, gribid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'headers_only_new_from_file','') - endif + iret = grib_f_headers_only_new_from_file(ifile, gribid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'headers_only_new_from_file', '') + end if end subroutine grib_headers_only_new_from_file !> Load in memory a grib message from a file. @@ -1278,18 +1278,18 @@ !> @param ifile id of the file opened with @ref grib_open_file !> @param gribid id of the grib loaded in memory !> @param status GRIB_SUCCESS if OK, GRIB_END_OF_FILE at the end of file, or error code - subroutine grib_new_from_file ( ifile, gribid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: gribid - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_new_from_file(ifile, gribid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_new_from_file( ifile, gribid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_new_from_file','') - endif + iret = grib_f_new_from_file(ifile, gribid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_new_from_file', '') + end if end subroutine grib_new_from_file !> Load in memory a BUFR message from a file. @@ -1302,18 +1302,18 @@ !> @param ifile id of the file opened with @ref codes_open_file !> @param bufrid id of the BUFR loaded in memory !> @param status GRIB_SUCCESS if OK, GRIB_END_OF_FILE at the end of file, or error code - subroutine bufr_new_from_file ( ifile, bufrid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: bufrid - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine bufr_new_from_file(ifile, bufrid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: bufrid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=bufr_f_new_from_file( ifile, bufrid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'bufr_new_from_file','') - endif + iret = bufr_f_new_from_file(ifile, bufrid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'bufr_new_from_file', '') + end if end subroutine bufr_new_from_file !> Load in memory a message from a file. @@ -1324,21 +1324,20 @@ !> @param ifile id of the file opened with @ref codes_open_file !> @param msgid id of the message loaded in memory !> @param status GRIB_SUCCESS if OK, GRIB_END_OF_FILE at the end of file, or error code - subroutine any_new_from_file ( ifile, msgid , status) - integer(kind=kindOfInt),intent(in) :: ifile - integer(kind=kindOfInt),intent(out) :: msgid - integer(kind=kindOfInt),optional,intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine any_new_from_file(ifile, msgid, status) + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), intent(out) :: msgid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=any_f_new_from_file( ifile, msgid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'any_new_from_file','') - endif + iret = any_f_new_from_file(ifile, msgid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'any_new_from_file', '') + end if end subroutine any_new_from_file - !> Create a new message in memory from a character array containting the coded message. !> !> The message can be accessed through its gribid and it will be available\n @@ -1354,20 +1353,20 @@ !> @param gribid id of the grib loaded in memory !> @param message character array containing the coded message !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_new_from_message_char( gribid, message, status ) - integer(kind=kindOfInt),intent(out) :: gribid - character(len=1), dimension(:),intent(in) :: message - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: size_bytes - integer(kind=kindOfInt) :: iret + subroutine grib_new_from_message_char(gribid, message, status) + integer(kind=kindOfInt), intent(out) :: gribid + character(len=1), dimension(:), intent(in) :: message + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: size_bytes + integer(kind=kindOfInt) :: iret - size_bytes=size(message,dim=1) - iret = grib_f_new_from_message ( gribid, message, size_bytes ) - if (present(status)) then - status = iret - else - call grib_check(iret,'new_from_message','') - endif + size_bytes = size(message, dim=1) + iret = grib_f_new_from_message(gribid, message, size_bytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'new_from_message', '') + end if end subroutine grib_new_from_message_char @@ -1387,20 +1386,20 @@ !> @param gribid id of the grib loaded in memory !> @param message integer array containing the coded message !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_new_from_message_int4 ( gribid, message, status ) - integer(kind=kindOfInt),intent(out) :: gribid - integer(kind=4), dimension(:),intent(in) :: message - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfSize_t) :: size_bytes - integer(kind=kindOfInt) :: iret + subroutine grib_new_from_message_int4(gribid, message, status) + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=4), dimension(:), intent(in) :: message + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: size_bytes + integer(kind=kindOfInt) :: iret - size_bytes=size(message,dim=1)*sizeOfInteger4 - iret = grib_f_new_from_message ( gribid, message, size_bytes ) - if (present(status)) then - status = iret - else - call grib_check(iret,'new_from_message','') - endif + size_bytes = size(message, dim=1)*sizeOfInteger4 + iret = grib_f_new_from_message(gribid, message, size_bytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'new_from_message', '') + end if end subroutine grib_new_from_message_int4 @@ -1418,21 +1417,20 @@ !> @param gribid id of the grib loaded in memory !> @param samplename name of the sample to be used !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_new_from_samples ( gribid, samplename, status ) - integer(kind=kindOfInt), intent(out) :: gribid - character(len=*), intent(in) :: samplename - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_new_from_samples(gribid, samplename, status) + integer(kind=kindOfInt), intent(out) :: gribid + character(len=*), intent(in) :: samplename + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_new_from_samples ( gribid, samplename ) - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_new_from_samples','('//samplename//')') - endif + iret = grib_f_new_from_samples(gribid, samplename) + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_new_from_samples', '('//samplename//')') + end if end subroutine grib_new_from_samples - !> Free the memory for the message referred as gribid. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -1443,20 +1441,20 @@ !> !> @param gribid id of the grib loaded in memory !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_release ( gribid, status ) - integer(kind=kindOfInt), intent(in) :: gribid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_release(gribid, status) + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_release ( gribid ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'release','') - endif + iret = grib_f_release(gribid) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'release', '') + end if end subroutine grib_release !> Create a copy of a message. @@ -1474,40 +1472,40 @@ !> @param gribid_src grib to be cloned !> @param gribid_dest new grib returned !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_clone ( gribid_src, gribid_dest, status ) - integer(kind=kindOfInt), intent(in) :: gribid_src - integer(kind=kindOfInt), intent(out) :: gribid_dest - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_clone(gribid_src, gribid_dest, status) + integer(kind=kindOfInt), intent(in) :: gribid_src + integer(kind=kindOfInt), intent(out) :: gribid_dest + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_clone(gribid_src,gribid_dest) - if (iret /= 0) then - call grib_f_write_on_fail(gribid_src) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'clone','') - endif + iret = grib_f_clone(gribid_src, gribid_dest) + if (iret /= 0) then + call grib_f_write_on_fail(gribid_src) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'clone', '') + end if end subroutine grib_clone - subroutine grib_util_sections_copy ( gribid_from, gribid_to, what, gribid_out,status ) - integer(kind=kindOfInt), intent(in) :: gribid_from - integer(kind=kindOfInt), intent(in) :: gribid_to - integer(kind=kindOfInt), intent(out) :: gribid_out - integer(kind=kindOfInt), intent(in) :: what - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_util_sections_copy(gribid_from, gribid_to, what, gribid_out, status) + integer(kind=kindOfInt), intent(in) :: gribid_from + integer(kind=kindOfInt), intent(in) :: gribid_to + integer(kind=kindOfInt), intent(out) :: gribid_out + integer(kind=kindOfInt), intent(in) :: what + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_util_sections_copy(gribid_from,gribid_to,what,gribid_out) - if (iret /= 0) then - call grib_f_write_on_fail(gribid_from) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_util_sections_copy','') - endif + iret = grib_f_util_sections_copy(gribid_from, gribid_to, what, gribid_out) + if (iret /= 0) then + call grib_f_write_on_fail(gribid_from) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_util_sections_copy', '') + end if end subroutine grib_util_sections_copy !> Copy the value of all the keys belonging to a namespace from the source message @@ -1523,19 +1521,19 @@ !> @param gribid_dest destination message !> @param namespace namespace to be copied !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_copy_namespace ( gribid_src, namespace, gribid_dest, status ) - integer(kind=kindOfInt), intent(in) :: gribid_src - integer(kind=kindOfInt), intent(in) :: gribid_dest - character(LEN=*), intent(in) :: namespace - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_copy_namespace(gribid_src, namespace, gribid_dest, status) + integer(kind=kindOfInt), intent(in) :: gribid_src + integer(kind=kindOfInt), intent(in) :: gribid_dest + character(LEN=*), intent(in) :: namespace + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_copy_namespace(gribid_src,namespace,gribid_dest) - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_copy_namespace','('//namespace//')') - endif + iret = grib_f_copy_namespace(gribid_src, namespace, gribid_dest) + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_copy_namespace', '('//namespace//')') + end if end subroutine grib_copy_namespace !> Check the status returned by a subroutine. @@ -1546,15 +1544,14 @@ !> @param status the status to be checked !> @param caller name of the caller soubroutine !> @param string a string variable from the caller routine (e.g. key,filename) - subroutine grib_check ( status,caller,string ) - integer(kind=kindOfInt), intent(in) :: status - character(len=*), intent(in) :: caller - character(len=*), intent(in) :: string + subroutine grib_check(status, caller, string) + integer(kind=kindOfInt), intent(in) :: status + character(len=*), intent(in) :: caller + character(len=*), intent(in) :: string - call grib_f_check( status,caller,string ) + call grib_f_check(status, caller, string) end subroutine grib_check - !> Get latitudes/longitudes/data values (real(4)). !> !> Latitudes, longitudes, data values arrays are returned. @@ -1571,24 +1568,24 @@ !> @param lons longitudes array with dimension "size" !> @param values data values array with dimension "size" !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_data_real4 ( gribid, lats, lons, values, status ) - integer(kind=kindOfInt), intent(in) :: gribid - real ( kind = kindOfFloat ), dimension(:),intent(out) :: lats, lons - real ( kind = kindOfFloat ), dimension(:),intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfSize_t) :: npoints + subroutine grib_get_data_real4(gribid, lats, lons, values, status) + integer(kind=kindOfInt), intent(in) :: gribid + real(kind=kindOfFloat), dimension(:), intent(out) :: lats, lons + real(kind=kindOfFloat), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfSize_t) :: npoints - npoints=size(lats) - iret = grib_f_get_data_real4 ( gribid, lats, lons, values,npoints ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_get_data','') - endif + npoints = size(lats) + iret = grib_f_get_data_real4(gribid, lats, lons, values, npoints) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_get_data', '') + end if end subroutine grib_get_data_real4 @@ -1607,24 +1604,24 @@ !> @param lons longitudes array !> @param values data values array !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_data_real8 ( gribid, lats, lons, values, status ) - integer(kind=kindOfInt), intent(in) :: gribid - real ( kind = kindOfDouble ), dimension(:),intent(out) :: lats, lons - real ( kind = kindOfDouble ), dimension(:),intent(out) :: values - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfSize_t) :: npoints + subroutine grib_get_data_real8(gribid, lats, lons, values, status) + integer(kind=kindOfInt), intent(in) :: gribid + real(kind=kindOfDouble), dimension(:), intent(out) :: lats, lons + real(kind=kindOfDouble), dimension(:), intent(out) :: values + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfSize_t) :: npoints - npoints=size(lats) - iret = grib_f_get_data_real8 ( gribid, lats, lons, values,npoints ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_get_data','') - endif + npoints = size(lats) + iret = grib_f_get_data_real8(gribid, lats, lons, values, npoints) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_get_data', '') + end if end subroutine grib_get_data_real8 @@ -1649,36 +1646,36 @@ !> @param iterid keys iterator id to be used in the keys iterator functions !> @param namespace the namespace of the keys to search for (all the keys if empty) !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_keys_iterator_new ( gribid, iterid, namespace, status ) - integer(kind=kindOfInt), intent(in) :: gribid - integer(kind=kindOfInt), intent(inout) :: iterid - character(LEN=*), intent(in) :: namespace - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_keys_iterator_new(gribid, iterid, namespace, status) + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfInt), intent(inout) :: iterid + character(LEN=*), intent(in) :: namespace + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_keys_iterator_new ( gribid, iterid, namespace ) - if (present(status)) then - status = iret - else - call grib_check(iret,'keys_iterator_new',namespace) - endif + iret = grib_f_keys_iterator_new(gribid, iterid, namespace) + if (present(status)) then + status = iret + else + call grib_check(iret, 'keys_iterator_new', namespace) + end if end subroutine grib_keys_iterator_new !> Advance to the next keys iterator value. !> !> @param iterid keys iterator id created with @ref grib_keys_iterator_new !> @param status GRIB_SUCCESS if next iterator exists, integer value if no more elements to iterate on - subroutine grib_keys_iterator_next ( iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt), intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_keys_iterator_next(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), intent(out) :: status + integer(kind=kindOfInt) :: iret - status = GRIB_SUCCESS - iret = grib_f_keys_iterator_next ( iterid ) - if (iret == 0) then - ! no more elements - status = GRIB_END - endif + status = GRIB_SUCCESS + iret = grib_f_keys_iterator_next(iterid) + if (iret == 0) then + ! no more elements + status = GRIB_END + end if end subroutine grib_keys_iterator_next !> Delete a keys iterator and free memory. @@ -1689,17 +1686,17 @@ !> !> @param iterid keys iterator id created with @ref grib_keys_iterator_new !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_keys_iterator_delete ( iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_keys_iterator_delete(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_keys_iterator_delete ( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'keys_iterator_delete','') - endif + iret = grib_f_keys_iterator_delete(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'keys_iterator_delete', '') + end if end subroutine grib_keys_iterator_delete !> Get the name of a key from a keys iterator. @@ -1710,18 +1707,18 @@ !> @param iterid keys iterator id created with @ref grib_keys_iterator_new !> @param name key name to be retrieved !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_keys_iterator_get_name ( iterid, name, status ) - integer(kind=kindOfInt), intent(in) :: iterid - character(LEN=*), intent(out) :: name - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_keys_iterator_get_name(iterid, name, status) + integer(kind=kindOfInt), intent(in) :: iterid + character(LEN=*), intent(out) :: name + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_keys_iterator_get_name ( iterid, name ) - if (present(status)) then - status = iret - else - call grib_check(iret,'keys_iterator_get_name',name) - endif + iret = grib_f_keys_iterator_get_name(iterid, name) + if (present(status)) then + status = iret + else + call grib_check(iret, 'keys_iterator_get_name', name) + end if end subroutine grib_keys_iterator_get_name !> Rewind a keys iterator. @@ -1732,17 +1729,17 @@ !> !> @param iterid keys iterator id created with @ref grib_keys_iterator_new !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_keys_iterator_rewind ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_keys_iterator_rewind(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_keys_iterator_rewind ( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'keys_iterator_rewind','') - endif + iret = grib_f_keys_iterator_rewind(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'keys_iterator_rewind', '') + end if end subroutine grib_keys_iterator_rewind !> Dump the content of a grib message. @@ -1753,17 +1750,17 @@ !> !> @param gribid id of the grib loaded in memory !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_dump ( gribid , status) - integer(kind=kindOfInt), intent(in) :: gribid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_dump(gribid, status) + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_dump ( gribid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'dump','') - endif + iret = grib_f_dump(gribid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'dump', '') + end if end subroutine grib_dump !> Get the error message given an error code @@ -1771,18 +1768,18 @@ !> @param error error code !> @param error_message error message !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_error_string ( error, error_message, status ) - integer(kind=kindOfInt), intent(in) :: error - character(len=*), intent(out) :: error_message - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_error_string(error, error_message, status) + integer(kind=kindOfInt), intent(in) :: error + character(len=*), intent(out) :: error_message + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_error_string ( error, error_message ) - if (present(status)) then - status = iret - else - call grib_check(iret,'get_error_string','') - endif + iret = grib_f_get_error_string(error, error_message) + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_error_string', '') + end if end subroutine grib_get_error_string !> Get the size of an array key. @@ -1797,22 +1794,22 @@ !> @param key name of the key !> @param size size of the array key !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_size_int ( gribid, key, size , status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_size_int(gribid, key, size, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_size_int ( gribid, key, size ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get_size',key) - endif + iret = grib_f_get_size_int(gribid, key, size) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_size', key) + end if end subroutine grib_get_size_int !> Get the size of an array key. @@ -1827,22 +1824,22 @@ !> @param key name of the key !> @param size size of the array key !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_size_long ( gribid, key, size , status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfLong), intent(out) :: size - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_size_long(gribid, key, size, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), intent(out) :: size + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_size_long ( gribid, key, size ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get_size',key) - endif + iret = grib_f_get_size_long(gribid, key, size) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_size', key) + end if end subroutine grib_get_size_long !> Get the integer value of a key from a grib message. @@ -1855,22 +1852,22 @@ !> @param key key name !> @param value the integer(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_int(gribid,key,value,status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind = kindOfInt), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_int(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_int ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + iret = grib_f_get_int(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_int !> Get the integer value of a key from a grib message. @@ -1883,22 +1880,22 @@ !> @param key key name !> @param value the integer(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_long(gribid,key,value,status) - integer(kind=kindOfInt), intent(in) :: gribid + subroutine grib_get_long(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid character(len=*), intent(in) :: key - integer(kind = kindOfLong), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfLong), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_get_long ( gribid, key, value ) + iret = grib_f_get_long(gribid, key, value) if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif + call grib_f_write_on_fail(gribid) + end if if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if end subroutine grib_get_long !> Check if the value of a key is MISSING. @@ -1911,22 +1908,22 @@ !> @param key key name !> @param is_missing 0->not missing, 1->missing !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_is_missing(gribid,key,is_missing,status) - integer(kind=kindOfInt), intent(in) :: gribid + subroutine grib_is_missing(gribid, key, is_missing, status) + integer(kind=kindOfInt), intent(in) :: gribid character(len=*), intent(in) :: key - integer(kind = kindOfInt), intent(out) :: is_missing - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfInt), intent(out) :: is_missing + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_is_missing ( gribid, key, is_missing ) + iret = grib_f_is_missing(gribid, key, is_missing) if (iret /= 0) then call grib_f_write_on_fail(gribid) - endif + end if if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'is_missing',key) - endif + call grib_check(iret, 'is_missing', key) + end if end subroutine grib_is_missing !> Check if a key is DEFINED. @@ -1939,22 +1936,22 @@ !> @param key key name !> @param is_defined 0->not defined, 1->defined !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_is_defined(gribid,key,is_defined,status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind = kindOfInt), intent(out) :: is_defined - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_is_defined(gribid, key, is_defined, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: is_defined + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_is_defined( gribid, key, is_defined ) + iret = grib_f_is_defined(gribid, key, is_defined) if (iret /= 0) then call grib_f_write_on_fail(gribid) - endif + end if if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'is_defined',key) - endif + call grib_check(iret, 'is_defined', key) + end if end subroutine grib_is_defined !> Get the real(4) value of a key from a grib message. @@ -1967,22 +1964,22 @@ !> @param key key name !> @param value the real(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real4 ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_real4(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_real4 ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + iret = grib_f_get_real4(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real4 !> Get the real(8) value of a key from a grib message. @@ -1995,22 +1992,22 @@ !> @param key key name !> @param value the real(8) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real8 ( gribid, key, value , status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_real8(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_real8 ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + iret = grib_f_get_real8(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real8 !> Get the character value of a key from a grib message. @@ -2023,25 +2020,24 @@ !> @param key key name !> @param value the real(8) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_string ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - character(len=*), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_string(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + character(len=*), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_string ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + iret = grib_f_get_string(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_string - !> Get the integer array of values for a key from a grib message. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -2052,25 +2048,25 @@ !> @param key key name !> @param value integer(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_int_array ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_get_int_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_get_int_array ( gribid, key, value , nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + nb_values = size(value) + iret = grib_f_get_int_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_int_array !> Get the integer array of values for a key from a grib message. @@ -2083,24 +2079,24 @@ !> @param key key name !> @param value integer(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_long_array ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind = kindOfLong),dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_get_long_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values nb_values = size(value) - iret=grib_f_get_long_array ( gribid, key, value , nb_values ) + iret = grib_f_get_long_array(gribid, key, value, nb_values) if (iret /= 0) then call grib_f_write_on_fail(gribid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if end subroutine grib_get_long_array !> Get the array of bytes (character) for a key from a grib message. @@ -2114,31 +2110,31 @@ !> @param value character(len=1) array of byte values !> @param length (optional) output: number of values retrieved !> @param status (optional) GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_byte_array ( gribid, key, value, length, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - character(len=1),dimension(:),intent(out) :: value - integer(kind=kindOfInt), optional, intent(out) :: length - integer(kind=kindOfInt), optional, intent(out) :: status + subroutine grib_get_byte_array(gribid, key, value, length, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + character(len=1), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: length + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values character :: bytes(size(value)) - nb_values = size (value) + nb_values = size(value) bytes = ACHAR(0) - iret = grib_f_get_byte_array ( gribid, key, bytes, nb_values ) - value = transfer (bytes, value) + iret = grib_f_get_byte_array(gribid, key, bytes, nb_values) + value = transfer(bytes, value) if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif + call grib_f_write_on_fail(gribid) + end if if (present(length)) then - length = nb_values + length = nb_values end if if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'get',key) - endif + call grib_check(iret, 'get', key) + end if end subroutine grib_get_byte_array !> Get the real(4) array of values for a key from a grib message. @@ -2151,24 +2147,24 @@ !> @param key key name !> @param value real(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real4_array ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_get_real4_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_get_real4_array ( gribid, key, value , nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + nb_values = size(value) + iret = grib_f_get_real4_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real4_array !> Get the real(8) array of values for a key from a grib message. @@ -2181,24 +2177,24 @@ !> @param key key name !> @param value real(8) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real8_array ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfDouble),dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_get_real8_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_get_real8_array ( gribid, key, value, nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + nb_values = size(value) + iret = grib_f_get_real8_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real8_array !> Get a real(4) value of specified index from an array key. @@ -2212,23 +2208,23 @@ !> @param kindex integer(4) index !> @param value real(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real4_element ( gribid, key, kindex,value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(in) :: kindex - real(kind = kindOfFloat),intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_real4_element(gribid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: kindex + real(kind=kindOfFloat), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_real4_element ( gribid, key, kindex,value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + iret = grib_f_get_real4_element(gribid, key, kindex, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real4_element !> Get a real(8) value of specified index from an array key. @@ -2242,23 +2238,23 @@ !> @param kindex integer(4) index !> @param value real(8) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real8_element ( gribid, key, kindex,value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(in) :: kindex - real(kind = kindOfDouble), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_real8_element(gribid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: kindex + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_real8_element ( gribid, key, kindex,value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + iret = grib_f_get_real8_element(gribid, key, kindex, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real8_element !> Get the real(4) values whose indexes are stored in the array "index" from an array key. @@ -2272,25 +2268,25 @@ !> @param kindex integer(4) array indexes !> @param value real(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real4_elements ( gribid, key, kindex, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt),dimension(:), intent(in) :: kindex - real(kind = kindOfFloat), dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) ::npoints + subroutine grib_get_real4_elements(gribid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(in) :: kindex + real(kind=kindOfFloat), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) ::npoints - npoints=size(value) - iret=grib_f_get_real4_elements ( gribid, key, kindex,value,npoints ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + npoints = size(value) + iret = grib_f_get_real4_elements(gribid, key, kindex, value, npoints) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real4_elements !> Get the real(8) values whose indexes are stored in the array "index" from an array key. @@ -2304,25 +2300,25 @@ !> @param kindex integer(4) array index !> @param value real(8) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_real8_elements ( gribid, key, kindex, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt),dimension(:), intent(in) :: kindex - real(kind = kindOfDouble), dimension(:), intent(out) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: npoints + subroutine grib_get_real8_elements(gribid, key, kindex, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(in) :: kindex + real(kind=kindOfDouble), dimension(:), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: npoints - npoints=size(value) - iret=grib_f_get_real8_elements ( gribid, key, kindex,value,npoints ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get',key) - endif + npoints = size(value) + iret = grib_f_get_real8_elements(gribid, key, kindex, value, npoints) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get', key) + end if end subroutine grib_get_real8_elements !> Set the integer value for a key in a grib message. @@ -2335,22 +2331,22 @@ !> @param key key name !> @param value integer(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_int ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_int(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_int ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + iret = grib_f_set_int(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_int !> Set the integer value for a key in a grib message. @@ -2363,22 +2359,22 @@ !> @param key key name !> @param value integer(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_long ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid + subroutine grib_set_long(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid character(len=*), intent(in) :: key - integer(kind=kindOfLong), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + integer(kind=kindOfLong), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret=grib_f_set_long ( gribid, key, value ) + iret = grib_f_set_long(gribid, key, value) if (iret /= 0) then call grib_f_write_on_fail(gribid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'set',key) - endif + call grib_check(iret, 'set', key) + end if end subroutine grib_set_long !> Set the real(4) value for a key in a grib message. @@ -2391,22 +2387,22 @@ !> @param key key name !> @param value real(4) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_real4 ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_real4(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_real4 ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + iret = grib_f_set_real4(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_real4 !> Set the real(8) value for a key in a grib message. @@ -2419,22 +2415,22 @@ !> @param key key name !> @param value real(8) value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_real8 ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_real8(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_real8 ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + iret = grib_f_set_real8(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_real8 !> Set the integers values for an array key in a grib message. @@ -2447,24 +2443,24 @@ !> @param key key name !> @param value integer(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_int_array ( gribid, key, value, status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_set_int_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_set_int_array ( gribid, key, value, nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + nb_values = size(value) + iret = grib_f_set_int_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_int_array !> Set the integers values for an array key in a grib message. @@ -2477,25 +2473,25 @@ !> @param key key name !> @param value integer(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_long_array ( gribid, key, value, status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - integer(kind=kindOfLong), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_set_long_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfLong), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values nb_values = size(value) - iret=grib_f_set_long_array ( gribid, key, value, nb_values ) + iret = grib_f_set_long_array(gribid, key, value, nb_values) if (iret /= 0) then call grib_f_write_on_fail(gribid) - endif + end if if (present(status)) then status = iret else - call grib_check(iret,'set',key) - endif - + call grib_check(iret, 'set', key) + end if + end subroutine grib_set_long_array !> Set the array of bytes (character) for a key in a grib message. @@ -2509,30 +2505,30 @@ !> @param value character(len=1) array of byte values !> @param length (optional) output: number of values written !> @param status (optional) GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_byte_array ( gribid, key, value, length, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - character(len=1), dimension(:), intent(in) :: value - integer(kind=kindOfInt), optional, intent(out) :: length - integer(kind=kindOfInt), optional, intent(out) :: status + subroutine grib_set_byte_array(gribid, key, value, length, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + character(len=1), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: length + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values character :: bytes(size(value)) - nb_values = size (value) - bytes = transfer (value, bytes) - iret = grib_f_set_byte_array ( gribid, key, bytes, nb_values ) + nb_values = size(value) + bytes = transfer(value, bytes) + iret = grib_f_set_byte_array(gribid, key, bytes, nb_values) if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif + call grib_f_write_on_fail(gribid) + end if if (present(length)) then - length = nb_values + length = nb_values end if if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'set',key) - endif + call grib_check(iret, 'set', key) + end if end subroutine grib_set_byte_array !> Set the real(4) values for an array key in a grib message. @@ -2545,24 +2541,24 @@ !> @param key key name !> @param value real(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_real4_array ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_set_real4_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_set_real4_array ( gribid, key, value, nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + nb_values = size(value) + iret = grib_f_set_real4_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_real4_array !> Set the real(8) values for an array key in a grib message. @@ -2575,24 +2571,24 @@ !> @param key key name !> @param value real(8) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_real8_array ( gribid, key, value, status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_set_real8_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_set_real8_array ( gribid, key, value, nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + nb_values = size(value) + iret = grib_f_set_real8_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_real8_array !> Set the real(4) values for an array key in a grib message, forces the set if the key is read-only. @@ -2606,24 +2602,24 @@ !> @param key key name !> @param value real(4) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_force_real4_array ( gribid, key, value, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfFloat), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_set_force_real4_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfFloat), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_set_force_real4_array ( gribid, key, value, nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + nb_values = size(value) + iret = grib_f_set_force_real4_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_force_real4_array !> Set the real(8) values for an array key in a grib message, forces the set if the key is read-only. @@ -2637,24 +2633,24 @@ !> @param key key name !> @param value real(8) array value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_force_real8_array ( gribid, key, value, status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - real(kind = kindOfDouble), dimension(:), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values + subroutine grib_set_force_real8_array(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), dimension(:), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values - nb_values = size(value) - iret=grib_f_set_force_real8_array ( gribid, key, value, nb_values ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + nb_values = size(value) + iret = grib_f_set_force_real8_array(gribid, key, value, nb_values) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_force_real8_array !> Set the character value for a string key in a grib message. @@ -2667,22 +2663,22 @@ !> @param key key name !> @param value character value !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_string ( gribid, key, value , status) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=*), intent(in) :: key - character(len=*), intent(in) :: value - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_string(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + character(len=*), intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_string ( gribid, key, value ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'set',key) - endif + iret = grib_f_set_string(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'set', key) + end if end subroutine grib_set_string !> Get the size of a coded message. @@ -2694,26 +2690,26 @@ !> @param gribid id of the grib loaded in memory !> @param nbytes size in bytes of the message !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_message_size_int ( gribid, nbytes, status) - integer(kind=kindOfInt), intent(in) :: gribid - integer(kind=kindOfInt), intent(out) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfSize_t) :: ibytes + subroutine grib_get_message_size_int(gribid, nbytes, status) + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfInt), intent(out) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfSize_t) :: ibytes - iret = grib_f_get_message_size ( gribid, ibytes ) - if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then - iret = GRIB_MESSAGE_TOO_LARGE - endif - nbytes = ibytes - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get_message_size','') - endif + iret = grib_f_get_message_size(gribid, ibytes) + if (iret == GRIB_SUCCESS .and. ibytes > huge(nbytes)) then + iret = GRIB_MESSAGE_TOO_LARGE + end if + nbytes = ibytes + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_message_size', '') + end if end subroutine grib_get_message_size_int !> Get the size of a coded message. @@ -2725,21 +2721,21 @@ !> @param gribid id of the grib loaded in memory !> @param nbytes size in bytes of the message !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_get_message_size_size_t ( gribid, nbytes, status) - integer(kind=kindOfInt), intent(in) :: gribid - integer(kind=kindOfSize_t), intent(out) :: nbytes - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_get_message_size_size_t(gribid, nbytes, status) + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfSize_t), intent(out) :: nbytes + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_get_message_size ( gribid, nbytes ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'get_message_size','') - endif + iret = grib_f_get_message_size(gribid, nbytes) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_message_size', '') + end if end subroutine grib_get_message_size_size_t !> Copy the coded message into an array. @@ -2751,23 +2747,23 @@ !> @param gribid id of the grib loaded in memory !> @param message array containing the coded message to be copied !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_copy_message ( gribid, message, status ) - integer(kind=kindOfInt), intent(in) :: gribid - character(len=1), dimension(:), intent(out) :: message - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret - integer(kind=kindOfSize_t) :: size_bytes + subroutine grib_copy_message(gribid, message, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=1), dimension(:), intent(out) :: message + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + integer(kind=kindOfSize_t) :: size_bytes - size_bytes = size(message,dim=1) - iret=grib_f_copy_message ( gribid, message, size_bytes ) - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif - if (present(status)) then - status = iret - else - call grib_check(iret,'copy_message','') - endif + size_bytes = size(message, dim=1) + iret = grib_f_copy_message(gribid, message, size_bytes) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'copy_message', '') + end if end subroutine grib_copy_message !> Write the coded message to a file. @@ -2779,19 +2775,19 @@ !> @param gribid id of the grib loaded in memory !> @param ifile file id of a file opened with \ref grib_open_file !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_write ( gribid, ifile , status) - integer(kind=kindOfInt), intent(in) :: gribid - integer(kind=kindOfInt), intent(in) :: ifile - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_write(gribid, ifile, status) + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: iret - iret = grib_f_write( gribid, ifile ) - if (present(status)) then - status = iret - else - call grib_check(iret,'write','') - endif + iret = grib_f_write(gribid, ifile) + if (present(status)) then + status = iret + else + call grib_check(iret, 'write', '') + end if end subroutine grib_write !> Write a multi field message to a file. @@ -2803,19 +2799,19 @@ !> @param multigribid id of the multi field grib loaded in memory !> @param ifile file id of a file opened with \ref grib_open_file !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_multi_write ( multigribid, ifile , status) - integer(kind=kindOfInt), intent(in) :: multigribid - integer(kind=kindOfInt), intent(in) :: ifile - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_multi_write(multigribid, ifile, status) + integer(kind=kindOfInt), intent(in) :: multigribid + integer(kind=kindOfInt), intent(in) :: ifile + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret = grib_f_multi_write( multigribid, ifile ) + iret = grib_f_multi_write(multigribid, ifile) if (present(status)) then status = iret else - call grib_check(iret,'grib_multi_write','') - endif - end subroutine grib_multi_write + call grib_check(iret, 'grib_multi_write', '') + end if + end subroutine grib_multi_write !> Append a single field grib message to a multi field grib message. !> Only the sections with section number greather or equal "startsection" are copied from the input single message to the multi field output grib. @@ -2824,24 +2820,24 @@ !> exit with an error message.\n Otherwise the error message can be !> gathered with @ref grib_get_error_string. !> - !> @param ingribid id of the input single grib + !> @param ingribid id of the input single grib !> @param startsection starting from startsection (included) all the sections are copied from the input single grib to the output multi grib !> @param multigribid id of the output multi field grib !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_multi_append ( ingribid, startsection, multigribid , status) - integer(kind=kindOfInt), intent(in) :: ingribid - integer(kind=kindOfInt), intent(in) :: startsection - integer(kind=kindOfInt), intent(out) :: multigribid - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_multi_append(ingribid, startsection, multigribid, status) + integer(kind=kindOfInt), intent(in) :: ingribid + integer(kind=kindOfInt), intent(in) :: startsection + integer(kind=kindOfInt), intent(out) :: multigribid + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - iret = grib_f_multi_append( ingribid, startsection, multigribid ) + iret = grib_f_multi_append(ingribid, startsection, multigribid) if (present(status)) then status = iret else - call grib_check(iret,'grib_multi_append','') - endif + call grib_check(iret, 'grib_multi_append', '') + end if end subroutine grib_multi_append !> Find the nearest point of a set of points whose latitudes and longitudes @@ -2861,34 +2857,34 @@ !> @param indexes output integer(4) array of the zero based indexes !> @param values output real(8) array of the values !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_find_nearest_multiple(gribid,is_lsm, & - inlats,inlons,outlats,outlons, & - values,distances, indexes,status) - integer(kind=kindOfInt), intent(in) :: gribid - logical, intent(in) :: is_lsm - real(kind = kindOfDouble), dimension(:), intent(in) :: inlats - real(kind = kindOfDouble), dimension(:), intent(in) :: inlons - real(kind = kindOfDouble), dimension(:), intent(out) :: outlats - real(kind = kindOfDouble), dimension(:), intent(out) :: outlons - real(kind = kindOfDouble), dimension(:), intent(out) :: distances - real(kind = kindOfDouble), dimension(:), intent(out) :: values - integer(kind = kindOfInt), dimension(:), intent(out) :: indexes - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_find_nearest_multiple(gribid, is_lsm, & + inlats, inlons, outlats, outlons, & + values, distances, indexes, status) + integer(kind=kindOfInt), intent(in) :: gribid + logical, intent(in) :: is_lsm + real(kind=kindOfDouble), dimension(:), intent(in) :: inlats + real(kind=kindOfDouble), dimension(:), intent(in) :: inlons + real(kind=kindOfDouble), dimension(:), intent(out) :: outlats + real(kind=kindOfDouble), dimension(:), intent(out) :: outlons + real(kind=kindOfDouble), dimension(:), intent(out) :: distances + real(kind=kindOfDouble), dimension(:), intent(out) :: values + integer(kind=kindOfInt), dimension(:), intent(out) :: indexes + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: npoints integer(kind=kindOfInt) :: intis_lsm intis_lsm = 0 - if (is_lsm) intis_lsm=1 - npoints=size(inlats) - iret=grib_f_find_nearest_multiple(gribid,intis_lsm,inlats,inlons,outlats,outlons, & - values,distances,indexes,npoints) + if (is_lsm) intis_lsm = 1 + npoints = size(inlats) + iret = grib_f_find_nearest_multiple(gribid, intis_lsm, inlats, inlons, outlats, outlons, & + values, distances, indexes, npoints) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'grib_find_nearest_multiple','') - endif + call grib_check(iret, 'grib_find_nearest_multiple', '') + end if end subroutine grib_find_nearest_multiple !> Find the nearest point of a given latitude/longitude point. @@ -2907,31 +2903,31 @@ !> @param kindex zero based index !> @param value value of the field in the nearest point !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_find_nearest_single(gribid, is_lsm, & - inlat, inlon, outlat, outlon, & - value, distance, kindex, status) - integer(kind=kindOfInt), intent(in) :: gribid - logical, intent(in) :: is_lsm - real(kind = kindOfDouble), intent(in) :: inlat - real(kind = kindOfDouble), intent(in) :: inlon - real(kind = kindOfDouble), intent(out) :: outlat - real(kind = kindOfDouble), intent(out) :: outlon - real(kind = kindOfDouble), intent(out) :: distance - real(kind = kindOfDouble), intent(out) :: value - integer(kind = kindOfInt), intent(out) :: kindex - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_find_nearest_single(gribid, is_lsm, & + inlat, inlon, outlat, outlon, & + value, distance, kindex, status) + integer(kind=kindOfInt), intent(in) :: gribid + logical, intent(in) :: is_lsm + real(kind=kindOfDouble), intent(in) :: inlat + real(kind=kindOfDouble), intent(in) :: inlon + real(kind=kindOfDouble), intent(out) :: outlat + real(kind=kindOfDouble), intent(out) :: outlon + real(kind=kindOfDouble), intent(out) :: distance + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), intent(out) :: kindex + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: intis_lsm =0 + integer(kind=kindOfInt) :: intis_lsm = 0 - if (is_lsm) intis_lsm=1 - iret=grib_f_find_nearest_single(gribid,intis_lsm,inlat,inlon,outlat,outlon, & - value,distance,kindex) + if (is_lsm) intis_lsm = 1 + iret = grib_f_find_nearest_single(gribid, intis_lsm, inlat, inlon, outlat, outlon, & + value, distance, kindex) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'grib_find_nearest_single','') - endif + call grib_check(iret, 'grib_find_nearest_single', '') + end if end subroutine grib_find_nearest_single !> Find the 4 nearest points of a latitude longitude point. @@ -2950,32 +2946,32 @@ !> @param kindex zero based index !> @param value value of the field in the nearest point !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_find_nearest_four_single(gribid,is_lsm, & - inlat,inlon,outlat,outlon, & - value,distance, kindex,status) - integer(kind=kindOfInt), intent(in) :: gribid - logical, intent(in) :: is_lsm - real(kind = kindOfDouble), intent(in) :: inlat - real(kind = kindOfDouble), intent(in) :: inlon - real(kind = kindOfDouble), dimension(4), intent(out) :: outlat - real(kind = kindOfDouble), dimension(4), intent(out) :: outlon - real(kind = kindOfDouble), dimension(4), intent(out) :: distance - real(kind = kindOfDouble), dimension(4), intent(out) :: value - integer(kind = kindOfInt), dimension(4), intent(out) :: kindex - integer(kind=kindOfInt),optional, intent(out) :: status + subroutine grib_find_nearest_four_single(gribid, is_lsm, & + inlat, inlon, outlat, outlon, & + value, distance, kindex, status) + integer(kind=kindOfInt), intent(in) :: gribid + logical, intent(in) :: is_lsm + real(kind=kindOfDouble), intent(in) :: inlat + real(kind=kindOfDouble), intent(in) :: inlon + real(kind=kindOfDouble), dimension(4), intent(out) :: outlat + real(kind=kindOfDouble), dimension(4), intent(out) :: outlon + real(kind=kindOfDouble), dimension(4), intent(out) :: distance + real(kind=kindOfDouble), dimension(4), intent(out) :: value + integer(kind=kindOfInt), dimension(4), intent(out) :: kindex + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: intis_lsm =0 + integer(kind=kindOfInt) :: intis_lsm = 0 - if (is_lsm) intis_lsm=1 + if (is_lsm) intis_lsm = 1 - iret=grib_f_find_nearest_four_single(gribid,intis_lsm,inlat,inlon,outlat,outlon, & - value,distance,kindex) + iret = grib_f_find_nearest_four_single(gribid, intis_lsm, inlat, inlon, outlat, outlon, & + value, distance, kindex) if (present(status)) then - status = iret + status = iret else - call grib_check(iret,'grib_find_nearest_four_single','') - endif + call grib_check(iret, 'grib_find_nearest_four_single', '') + end if end subroutine grib_find_nearest_four_single !> Turn on the support for multiple fields in a single message. @@ -2985,16 +2981,16 @@ !> gathered with @ref grib_get_error_string. !> !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_multi_support_on (status ) - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_multi_support_on(status) + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_multi_support_on ( ) - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_multi_support_on','') - endif + iret = grib_f_multi_support_on() + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_multi_support_on', '') + end if end subroutine grib_multi_support_on !> Turn off the support for multiple fields in a single message. @@ -3004,16 +3000,16 @@ !> gathered with @ref grib_get_error_string. !> !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_multi_support_off ( status ) - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_multi_support_off(status) + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_multi_support_off ( ) - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_multi_support_off','') - endif + iret = grib_f_multi_support_off() + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_multi_support_off', '') + end if end subroutine grib_multi_support_off !> Turn on the compatibility mode with gribex. @@ -3023,16 +3019,16 @@ !> gathered with @ref grib_get_error_string. !> !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_gribex_mode_on (status ) - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_gribex_mode_on(status) + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_gribex_mode_on() - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_gribex_mode_on','') - endif + iret = grib_f_gribex_mode_on() + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_gribex_mode_on', '') + end if end subroutine grib_gribex_mode_on @@ -3043,16 +3039,16 @@ !> gathered with @ref grib_get_error_string. !> !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_gribex_mode_off (status ) - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_gribex_mode_off(status) + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_gribex_mode_off() - if (present(status)) then - status = iret - else - call grib_check(iret,'grib_gribex_mode_off','') - endif + iret = grib_f_gribex_mode_off() + if (present(status)) then + status = iret + else + call grib_check(iret, 'grib_gribex_mode_off', '') + end if end subroutine grib_gribex_mode_off @@ -3069,17 +3065,17 @@ !> !> @param iterid keys iterator id !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_skip_computed ( iterid , status) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_skip_computed(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_skip_computed ( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'skip_computed','') - endif + iret = grib_f_skip_computed(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'skip_computed', '') + end if end subroutine grib_skip_computed !> Skip the coded keys in a keys iterator. @@ -3094,20 +3090,19 @@ !> !> @param iterid keys iterator id !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_skip_coded ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_skip_coded(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_skip_coded ( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'skip_coded','') - endif + iret = grib_f_skip_coded(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'skip_coded', '') + end if end subroutine grib_skip_coded - !> Skip the duplicated keys in a keys iterator. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -3118,20 +3113,19 @@ !> !> @param iterid keys iterator id !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_skip_duplicates ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_skip_duplicates(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_skip_duplicates ( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'skip_duplicates','') - endif + iret = grib_f_skip_duplicates(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'skip_duplicates', '') + end if end subroutine grib_skip_duplicates - !> Skip the read_only keys in a keys iterator. !> !> Read only keys cannot be set. @@ -3140,17 +3134,17 @@ !> !> @param iterid keys iterator id !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_skip_read_only ( iterid, status ) - integer(kind=kindOfInt), intent(in) :: iterid - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_skip_read_only(iterid, status) + integer(kind=kindOfInt), intent(in) :: iterid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret = grib_f_skip_read_only ( iterid ) - if (present(status)) then - status = iret - else - call grib_check(iret,'skip_read_only','') - endif + iret = grib_f_skip_read_only(iterid) + if (present(status)) then + status = iret + else + call grib_check(iret, 'skip_read_only', '') + end if end subroutine grib_skip_read_only !> Set the definition path @@ -3161,17 +3155,17 @@ !> !> @param path definitions path !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_definitions_path ( path, status ) - character(len=*), intent(in) :: path - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_definitions_path(path, status) + character(len=*), intent(in) :: path + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_definitions_path ( path ) - if (present(status)) then - status = iret - else - call grib_check(iret,'set_definitions_path','('//path//')') - endif + iret = grib_f_set_definitions_path(path) + if (present(status)) then + status = iret + else + call grib_check(iret, 'set_definitions_path', '('//path//')') + end if end subroutine grib_set_definitions_path !> Set the samples path @@ -3182,17 +3176,17 @@ !> !> @param path samples path !> @param status GRIB_SUCCESS if OK, integer value on error - subroutine grib_set_samples_path ( path, status ) - character(len=*), intent(in) :: path - integer(kind=kindOfInt),optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + subroutine grib_set_samples_path(path, status) + character(len=*), intent(in) :: path + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret - iret=grib_f_set_samples_path ( path ) - if (present(status)) then - status = iret - else - call grib_check(iret,'set_samples_path','('//path//')') - endif + iret = grib_f_set_samples_path(path) + if (present(status)) then + status = iret + else + call grib_check(iret, 'set_samples_path', '('//path//')') + end if end subroutine grib_set_samples_path end module grib_api diff --git a/fortran/grib_typeSizes.f90 b/fortran/grib_typeSizes.f90 index 0a55f2e47..1379c4640 100644 --- a/fortran/grib_typeSizes.f90 +++ b/fortran/grib_typeSizes.f90 @@ -1,11 +1,11 @@ ! Description: -! Provide named kind parameters for use in declarations of real and integer +! Provide named kind parameters for use in declarations of real and integer ! variables with specific byte sizes (i.e. one, two, four, and eight byte ! integers; four and eight byte reals). The parameters can then be used ! in (KIND = XX) modifiers in declarations. -! A single function (byteSizesOK()) is provided to ensure that the selected +! A single function (byteSizesOK()) is provided to ensure that the selected ! kind parameters are correct. -! +! ! Input Parameters: ! None. ! @@ -19,13 +19,13 @@ ! Robert Pincus ! Cooperative Institue for Meteorological Satellite Studies ! University of Wisconsin - Madison -! 1225 W. Dayton St. +! 1225 W. Dayton St. ! Madison, Wisconsin 53706 ! Robert.Pincus@ssec.wisc.edu ! ! Design Notes: ! Fortran 90 doesn't allow one to check the number of bytes in a real variable; -! we check only that four byte and eight byte reals have different kind parameters. +! we check only that four byte and eight byte reals have different kind parameters. ! module grib_typeSizes implicit none @@ -33,21 +33,21 @@ module grib_typeSizes integer, parameter :: FourByteInt = selected_int_kind(9), & EightByteInt = selected_int_kind(18) - integer, parameter :: FourByteReal = selected_real_kind(P = 6, R = 37), & - EightByteReal = selected_real_kind(P = 13, R = 307) + integer, parameter :: FourByteReal = selected_real_kind(P=6, R=37), & + EightByteReal = selected_real_kind(P=13, R=307) contains logical function byteSizesOK() - ! Users may call this function once to ensure that the kind parameters - ! the module defines are available with the current compiler. - ! We can't ensure that the two REAL kinds are actually four and - ! eight bytes long, but we can ensure that they are distinct. - ! Early Fortran 90 compilers would sometimes report incorrect results for - ! the bit_size intrinsic, but I haven't seen this in a long time. + ! Users may call this function once to ensure that the kind parameters + ! the module defines are available with the current compiler. + ! We can't ensure that the two REAL kinds are actually four and + ! eight bytes long, but we can ensure that they are distinct. + ! Early Fortran 90 compilers would sometimes report incorrect results for + ! the bit_size intrinsic, but I haven't seen this in a long time. ! Local variables - integer (kind = FourByteInt) :: Four + integer(kind=FourByteInt) :: Four - if (bit_size(Four) == 32 .and. & + if (bit_size(Four) == 32 .and. & FourByteReal > 0 .and. EightByteReal > 0 .and. & FourByteReal /= EightByteReal) then byteSizesOK = .true. diff --git a/fortran/grib_types.f90 b/fortran/grib_types.f90 index d897deaa0..e4e95649e 100644 --- a/fortran/grib_types.f90 +++ b/fortran/grib_types.f90 @@ -2,7 +2,7 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. @@ -12,25 +12,25 @@ integer function kind_of_size_t() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_size_t=-1 + kind_of_size_t = -1 - call check_size_t(x2(1),x2(2),ret) + call check_size_t(x2(1), x2(2), ret) if (ret == 't') then - kind_of_size_t=2 - return - endif + kind_of_size_t = 2 + return + end if - call check_size_t(x4(1),x4(2),ret) + call check_size_t(x4(1), x4(2), ret) if (ret == 't') then - kind_of_size_t=4 - return - endif + kind_of_size_t = 4 + return + end if - call check_size_t(x8(1),x8(2),ret) + call check_size_t(x8(1), x8(2), ret) if (ret == 't') then - kind_of_size_t=8 - return - endif + kind_of_size_t = 8 + return + end if end function kind_of_size_t @@ -40,25 +40,25 @@ integer function kind_of_long() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_long=-1 + kind_of_long = -1 - call check_long(x2(1),x2(2),ret) + call check_long(x2(1), x2(2), ret) if (ret == 't') then - kind_of_long=2 - return - endif + kind_of_long = 2 + return + end if - call check_long(x4(1),x4(2),ret) + call check_long(x4(1), x4(2), ret) if (ret == 't') then - kind_of_long=4 - return - endif + kind_of_long = 4 + return + end if - call check_long(x8(1),x8(2),ret) + call check_long(x8(1), x8(2), ret) if (ret == 't') then - kind_of_long=8 - return - endif + kind_of_long = 8 + return + end if end function kind_of_long @@ -68,25 +68,25 @@ integer function kind_of_int() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_int=-1 + kind_of_int = -1 - call check_int(x2(1),x2(2),ret) + call check_int(x2(1), x2(2), ret) if (ret == 't') then - kind_of_int=2 - return - endif + kind_of_int = 2 + return + end if - call check_int(x4(1),x4(2),ret) + call check_int(x4(1), x4(2), ret) if (ret == 't') then - kind_of_int=4 - return - endif + kind_of_int = 4 + return + end if - call check_int(x8(1),x8(2),ret) + call check_int(x8(1), x8(2), ret) if (ret == 't') then - kind_of_int=8 - return - endif + kind_of_int = 8 + return + end if end function kind_of_int @@ -95,19 +95,19 @@ integer function kind_of_float() real(8), dimension(2) :: x8 = (/1., 2./) character(len=1) :: ret - kind_of_float=-1 + kind_of_float = -1 - call check_float(x4(1),x4(2),ret) + call check_float(x4(1), x4(2), ret) if (ret == 't') then - kind_of_float=4 - return - endif + kind_of_float = 4 + return + end if - call check_float(x8(1),x8(2),ret) + call check_float(x8(1), x8(2), ret) if (ret == 't') then - kind_of_float=8 - return - endif + kind_of_float = 8 + return + end if end function kind_of_float @@ -116,19 +116,19 @@ integer function kind_of_double() real(8), dimension(2) :: real8 = (/1., 2./) character(len=1) :: ret - kind_of_double=-1 + kind_of_double = -1 - call check_double(real4(1),real4(2),ret) + call check_double(real4(1), real4(2), ret) if (ret == 't') then - kind_of_double=4 - return - endif + kind_of_double = 4 + return + end if - call check_double(real8(1),real8(2),ret) + call check_double(real8(1), real8(2), ret) if (ret == 't') then - kind_of_double=8 - return - endif + kind_of_double = 8 + return + end if end function kind_of_double @@ -140,22 +140,22 @@ program kind_h real(kind=4), dimension(2) :: r4 real(kind=8), dimension(2) :: r8 - print *,"integer,public,parameter :: kindOfInt=",kind_of_int() - print *,"integer,public,parameter :: kindOfLong=",kind_of_long() - print *,"integer,public,parameter :: kindOfSize_t=",kind_of_size_t() - print *,"integer,public,parameter :: kindOfSize=",kind_of_size_t() - print *,"integer,public,parameter :: kindOfDouble=",kind_of_double() - print *,"integer,public,parameter :: kindOfFloat=",kind_of_float() - call f_sizeof(i(1),i(2),size) - print *,"integer,public,parameter :: sizeOfInteger=",size - call f_sizeof(i2(1),i2(2),size) - print *,"integer,public,parameter :: sizeOfInteger2=",size - call f_sizeof(i4(1),i4(2),size) - print *,"integer,public,parameter :: sizeOfInteger4=",size - call f_sizeof(r4(1),r4(2),size) - print *,"integer,public,parameter :: sizeOfReal4=",size - call f_sizeof(r8(1),r8(2),size) - print *,"integer,public,parameter :: sizeOfReal8=",size + print *, "integer,public,parameter :: kindOfInt=", kind_of_int() + print *, "integer,public,parameter :: kindOfLong=", kind_of_long() + print *, "integer,public,parameter :: kindOfSize_t=", kind_of_size_t() + print *, "integer,public,parameter :: kindOfSize=", kind_of_size_t() + print *, "integer,public,parameter :: kindOfDouble=", kind_of_double() + print *, "integer,public,parameter :: kindOfFloat=", kind_of_float() + call f_sizeof(i(1), i(2), size) + print *, "integer,public,parameter :: sizeOfInteger=", size + call f_sizeof(i2(1), i2(2), size) + print *, "integer,public,parameter :: sizeOfInteger2=", size + call f_sizeof(i4(1), i4(2), size) + print *, "integer,public,parameter :: sizeOfInteger4=", size + call f_sizeof(r4(1), r4(2), size) + print *, "integer,public,parameter :: sizeOfReal4=", size + call f_sizeof(r8(1), r8(2), size) + print *, "integer,public,parameter :: sizeOfReal8=", size end program kind_h diff --git a/fortran/same_int_long.f90 b/fortran/same_int_long.f90 index 15603a0c5..dbb0f3b57 100644 --- a/fortran/same_int_long.f90 +++ b/fortran/same_int_long.f90 @@ -2,7 +2,7 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. @@ -12,25 +12,25 @@ integer function kind_of_long() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_long=-1 + kind_of_long = -1 - call check_long(x2(1),x2(2),ret) + call check_long(x2(1), x2(2), ret) if (ret == 't') then - kind_of_long=2 - return - endif + kind_of_long = 2 + return + end if - call check_long(x4(1),x4(2),ret) + call check_long(x4(1), x4(2), ret) if (ret == 't') then - kind_of_long=4 - return - endif + kind_of_long = 4 + return + end if - call check_long(x8(1),x8(2),ret) + call check_long(x8(1), x8(2), ret) if (ret == 't') then - kind_of_long=8 - return - endif + kind_of_long = 8 + return + end if end function kind_of_long @@ -40,37 +40,37 @@ integer function kind_of_int() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_int=-1 + kind_of_int = -1 - call check_int(x2(1),x2(2),ret) + call check_int(x2(1), x2(2), ret) if (ret == 't') then - kind_of_int=2 - return - endif + kind_of_int = 2 + return + end if - call check_int(x4(1),x4(2),ret) + call check_int(x4(1), x4(2), ret) if (ret == 't') then - kind_of_int=4 - return - endif + kind_of_int = 4 + return + end if - call check_int(x8(1),x8(2),ret) + call check_int(x8(1), x8(2), ret) if (ret == 't') then - kind_of_int=8 - return - endif + kind_of_int = 8 + return + end if end function kind_of_int program same_int_long - integer ki,kl + integer ki, kl - ki=kind_of_int() - kl=kind_of_long() + ki = kind_of_int() + kl = kind_of_long() if (ki /= kl) then - write (*,'(i1)') 0 + write (*, '(i1)') 0 else - write (*,'(i1)') 1 - endif + write (*, '(i1)') 1 + end if end program same_int_long diff --git a/fortran/same_int_size_t.f90 b/fortran/same_int_size_t.f90 index 049be5034..563ac9b5e 100644 --- a/fortran/same_int_size_t.f90 +++ b/fortran/same_int_size_t.f90 @@ -2,7 +2,7 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! +! ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. @@ -12,25 +12,25 @@ integer function kind_of_size_t() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_size_t=-1 + kind_of_size_t = -1 - call check_size_t(x2(1),x2(2),ret) + call check_size_t(x2(1), x2(2), ret) if (ret == 't') then - kind_of_size_t=2 - return - endif + kind_of_size_t = 2 + return + end if - call check_size_t(x4(1),x4(2),ret) + call check_size_t(x4(1), x4(2), ret) if (ret == 't') then - kind_of_size_t=4 - return - endif + kind_of_size_t = 4 + return + end if - call check_size_t(x8(1),x8(2),ret) + call check_size_t(x8(1), x8(2), ret) if (ret == 't') then - kind_of_size_t=8 - return - endif + kind_of_size_t = 8 + return + end if end function kind_of_size_t @@ -40,37 +40,37 @@ integer function kind_of_int() integer(8), dimension(2) :: x8 = (/1, 2/) character(len=1) :: ret - kind_of_int=-1 + kind_of_int = -1 - call check_int(x2(1),x2(2),ret) + call check_int(x2(1), x2(2), ret) if (ret == 't') then - kind_of_int=2 - return - endif + kind_of_int = 2 + return + end if - call check_int(x4(1),x4(2),ret) + call check_int(x4(1), x4(2), ret) if (ret == 't') then - kind_of_int=4 - return - endif + kind_of_int = 4 + return + end if - call check_int(x8(1),x8(2),ret) + call check_int(x8(1), x8(2), ret) if (ret == 't') then - kind_of_int=8 - return - endif + kind_of_int = 8 + return + end if end function kind_of_int program same_int_size_t - integer ki,kl + integer ki, kl - ki=kind_of_int() - kl=kind_of_size_t() + ki = kind_of_int() + kl = kind_of_size_t() if (ki /= kl) then - write (*,'(i1)') 0 + write (*, '(i1)') 0 else - write (*,'(i1)') 1 - endif + write (*, '(i1)') 1 + end if end program same_int_size_t diff --git a/src/grib_accessor_class_data_ccsds_packing.c b/src/grib_accessor_class_data_ccsds_packing.c index 37b59c7dc..600a3d6b3 100644 --- a/src/grib_accessor_class_data_ccsds_packing.c +++ b/src/grib_accessor_class_data_ccsds_packing.c @@ -324,7 +324,7 @@ static int pack_double(grib_accessor* a, const double* val, size_t* len) grib_accessor_data_ccsds_packing* self = (grib_accessor_data_ccsds_packing*)a; grib_handle* hand = grib_handle_of_accessor(a); - int err = GRIB_SUCCESS, i = 0; + int err = GRIB_SUCCESS, i = 0, is_constant_field = 0; size_t buflen = 0; unsigned char* buf = NULL; @@ -373,7 +373,23 @@ static int pack_double(grib_accessor* a, const double* val, size_t* len) return GRIB_SUCCESS; } - if (bits_per_value == 0) { /* constant field */ + max = val[0]; + min = max; + for (i = 1; i < n_vals; i++) { + if (val[i] > max) max = val[i]; + else if (val[i] < min) min = val[i]; + } + + if (min == max) { + is_constant_field = 1; + } else { + if (bits_per_value == 0) { + /* ECC-1202: A non-constant field with bitsPerValue==0! */ + bits_per_value = 24; /* Set sane value */ + } + } + + if (is_constant_field) { #ifdef DEBUG for (i = 1; i < n_vals; i++) { Assert(val[i] == val[0]); @@ -401,15 +417,6 @@ static int pack_double(grib_accessor* a, const double* val, size_t* len) return err; d = grib_power(decimal_scale_factor, 10); - - max = val[0]; - min = max; - for (i = 1; i < n_vals; i++) { - if (val[i] > max) - max = val[i]; - else if (val[i] < min) - min = val[i]; - } min *= d; max *= d; diff --git a/src/grib_util.c b/src/grib_util.c index e2044868d..231162276 100644 --- a/src/grib_util.c +++ b/src/grib_util.c @@ -11,6 +11,7 @@ #include "grib_api_internal.h" #include +#define STR_EQUAL(s1, s2) (strcmp((s1), (s2)) == 0) typedef enum { @@ -888,8 +889,8 @@ grib_handle* grib_util_set_spec2(grib_handle* h, size_t count = 0; int i; long editionNumber; - grib_handle* outh = NULL; - grib_handle* tmp = NULL; + grib_handle* h_out = NULL; + grib_handle* h_sample = NULL; const char* grid_type = NULL; char name[1024]; char input_grid_type[100]; @@ -919,8 +920,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, /* Get edition number from input handle */ if ((*err = grib_get_long(h, "edition", &editionNumber)) != 0) { grib_context* c = grib_context_get_default(); - if (c->write_on_fail) - grib_write_message(h, "error.grib", "w"); + if (c->write_on_fail) grib_write_message(h, "error.grib", "w"); return NULL; } @@ -1026,10 +1026,8 @@ grib_handle* grib_util_set_spec2(grib_handle* h, if ((*err = grib_set_values(h, values, count)) != 0) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Cannot set values %s\n", grib_get_error_message(*err)); - for (i = 0; i < count; i++) - if (values[i].error) - fprintf(stderr, " %s %s\n", values[i].name, grib_get_error_message(values[i].error)); + if (values[i].error) fprintf(stderr, " %s %s\n", values[i].name, grib_get_error_message(values[i].error)); goto cleanup; } if (h->context->debug == -1) { @@ -1090,7 +1088,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } return h; - } + } /* flags & GRIB_UTIL_SET_SPEC_FLAGS_ONLY_PACKING */ grid_type = get_grid_type_name(spec->grid_type); if (grid_type == NULL) { @@ -1143,9 +1141,9 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } } - /* TODO: recycle tmp handle */ - tmp = grib_handle_new_from_samples(NULL, name); - if (!tmp) { + /* TODO: recycle h_sample handle */ + h_sample = grib_handle_new_from_samples(NULL, name); + if (!h_sample) { *err = GRIB_INVALID_FILE; return NULL; } @@ -1446,6 +1444,8 @@ grib_handle* grib_util_set_spec2(grib_handle* h, SET_STRING_VALUE("packingType", "grid_simple"); } } + + /* ECC-1201: case of IEEE input ?? */ switch (packing_spec->accuracy) { case GRIB_UTIL_ACCURACY_SAME_BITS_PER_VALUES_AS_INPUT: { @@ -1470,7 +1470,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, default: fprintf(stderr, "invalid packing_spec->accuracy = %ld\n", (long)packing_spec->accuracy); - grib_handle_delete(tmp); + grib_handle_delete(h_sample); *err = GRIB_INTERNAL_ERROR; goto cleanup; break; @@ -1498,13 +1498,13 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } } /* grib_write_message(h,"input.grib","w"); */ - /* grib_write_message(tmp,"geo.grib","w"); */ - /* copy product and local sections from h to tmp handle and store in outh */ - if ((outh = grib_util_sections_copy(h, tmp, GRIB_SECTION_PRODUCT | GRIB_SECTION_LOCAL, err)) == NULL) { + /* grib_write_message(h_sample,"geo.grib","w"); */ + /* copy product and local sections from h to h_sample handle and store in h_out */ + if ((h_out = grib_util_sections_copy(h, h_sample, GRIB_SECTION_PRODUCT | GRIB_SECTION_LOCAL, err)) == NULL) { goto cleanup; } - grib_handle_delete(tmp); + grib_handle_delete(h_sample); Assert(*err == 0); /* Set "pl" array if provided (For reduced Gaussian grids) */ @@ -1520,7 +1520,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } if (spec->pl_size != 0 && (spec->grid_type == GRIB_UTIL_GRID_SPEC_REDUCED_GG || spec->grid_type == GRIB_UTIL_GRID_SPEC_REDUCED_ROTATED_GG)) { - *err = grib_set_long_array(outh, "pl", spec->pl, spec->pl_size); + *err = grib_set_long_array(h_out, "pl", spec->pl, spec->pl_size); if (*err) { fprintf(stderr, "SET_GRID_DATA_DESCRIPTION: Cannot set pl %s\n", grib_get_error_message(*err)); goto cleanup; @@ -1544,32 +1544,30 @@ grib_handle* grib_util_set_spec2(grib_handle* h, /* Apply adjustments to bounding box if needed */ if (expandBoundingBox) { - if ((*err = expand_bounding_box(outh, values, count)) != 0) { + if ((*err = expand_bounding_box(h_out, values, count)) != 0) { fprintf(stderr, "SET_GRID_DATA_DESCRIPTION: Cannot expand bounding box: %s\n", grib_get_error_message(*err)); if (h->context->write_on_fail) - grib_write_message(outh, "error.grib", "w"); + grib_write_message(h_out, "error.grib", "w"); goto cleanup; } } if (convertEditionEarlier && packing_spec->editionNumber > 1) { - *err = grib_set_long(outh, "edition", packing_spec->editionNumber); + *err = grib_set_long(h_out, "edition", packing_spec->editionNumber); if (*err) { fprintf(stderr, "SET_GRID_DATA_DESCRIPTION: Cannot convert to edition %ld.\n", packing_spec->editionNumber); goto cleanup; } } - if ((*err = grib_set_values(outh, values, count)) != 0) { + if ((*err = grib_set_values(h_out, values, count)) != 0) { fprintf(stderr, "SET_GRID_DATA_DESCRIPTION: Cannot set key values: %s\n", grib_get_error_message(*err)); - for (i = 0; i < count; i++) - if (values[i].error) - fprintf(stderr, " %s %s\n", values[i].name, grib_get_error_message(values[i].error)); + if (values[i].error) fprintf(stderr, " %s %s\n", values[i].name, grib_get_error_message(values[i].error)); goto cleanup; } - if ((*err = grib_set_double_array(outh, "values", data_values, data_values_count)) != 0) { + if ((*err = grib_set_double_array(h_out, "values", data_values, data_values_count)) != 0) { FILE* ferror; size_t ii, lcount; grib_context* c = grib_context_get_default(); @@ -1588,67 +1586,66 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } fprintf(ferror, "%g }", data_values[data_values_count - 1]); fclose(ferror); - if (c->write_on_fail) - grib_write_message(outh, "error.grib", "w"); + if (c->write_on_fail) grib_write_message(h_out, "error.grib", "w"); goto cleanup; } - /* grib_write_message(outh,"h.grib","w"); */ + /* grib_write_message(h_out,"h.grib","w"); */ /* if the field is empty GRIBEX is packing as simple*/ /* if (!strcmp(input_packing_type,"grid_simple_matrix")) { long numberOfValues; - grib_get_long(outh,"numberOfValues",&numberOfValues); + grib_get_long(h_out,"numberOfValues",&numberOfValues); if (numberOfValues==0) { slen=11; - grib_set_string(outh,"packingType","grid_simple",&slen); + grib_set_string(h_out,"packingType","grid_simple",&slen); } } */ if (grib1_high_resolution_fix) { /* GRIB-863: must set increments to MISSING */ /* increments are not coded in message but computed */ - if ((*err = grib_set_missing(outh, "iDirectionIncrement")) != 0) { + if ((*err = grib_set_missing(h_out, "iDirectionIncrement")) != 0) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Cannot set Di to missing: %s\n", grib_get_error_message(*err)); goto cleanup; } - if ((*err = grib_set_missing(outh, "jDirectionIncrement")) != 0) { + if ((*err = grib_set_missing(h_out, "jDirectionIncrement")) != 0) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Cannot set Dj to missing: %s\n", grib_get_error_message(*err)); goto cleanup; } } - /*grib_dump_content(outh, stdout,"debug", ~0, NULL);*/ + /*grib_dump_content(h_out, stdout,"debug", ~0, NULL);*/ /* convert to second_order if not constant field. (Also see ECC-326) */ if (setSecondOrder) { int constant = 0; double missingValue = 0; - grib_get_double(outh, "missingValue", &missingValue); + grib_get_double(h_out, "missingValue", &missingValue); constant = is_constant_field(missingValue, data_values, data_values_count); if (!constant) { if (editionNumber == 1) { long numberOfGroups = 0; - grib_handle* htmp = grib_handle_clone(outh); + grib_handle* htmp = grib_handle_clone(h_out); slen = 17; grib_set_string(htmp, "packingType", "grid_second_order", &slen); grib_get_long(htmp, "numberOfGroups", &numberOfGroups); /* GRIBEX is not able to decode overflown numberOfGroups with SPD */ - if (numberOfGroups > 65534 && outh->context->no_spd) { + if (numberOfGroups > 65534 && h_out->context->no_spd) { slen = 24; - grib_set_string(outh, "packingType", "grid_second_order_no_SPD", &slen); + grib_set_string(h_out, "packingType", "grid_second_order_no_SPD", &slen); grib_handle_delete(htmp); } else { - grib_handle_delete(outh); - outh = htmp; + grib_handle_delete(h_out); + h_out = htmp; } } else { slen = 17; - grib_set_string(outh, "packingType", "grid_second_order", &slen); - *err = grib_set_double_array(outh, "values", data_values, data_values_count); + grib_set_string(h_out, "packingType", "grid_second_order", &slen); + *err = grib_set_double_array(h_out, "values", data_values, data_values_count); if (*err != GRIB_SUCCESS) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: setting data values failed! %s\n", grib_get_error_message(*err)); goto cleanup; @@ -1656,21 +1653,21 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } } else { - if (outh->context->gribex_mode_on) { - outh->context->gribex_mode_on = 0; - grib_set_double_array(outh, "values", data_values, data_values_count); - outh->context->gribex_mode_on = 1; + if (h_out->context->gribex_mode_on) { + h_out->context->gribex_mode_on = 0; + grib_set_double_array(h_out, "values", data_values, data_values_count); + h_out->context->gribex_mode_on = 1; } } } if (packing_spec->editionNumber && packing_spec->editionNumber != editionNumber) { - *err = grib_set_long(outh, "edition", packing_spec->editionNumber); + *err = grib_set_long(h_out, "edition", packing_spec->editionNumber); if (*err != GRIB_SUCCESS) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Failed to change edition to %ld: %s\n", packing_spec->editionNumber, grib_get_error_message(*err)); if (h->context->write_on_fail) - grib_write_message(outh, "error.grib", "w"); + grib_write_message(h_out, "error.grib", "w"); goto cleanup; } } @@ -1679,7 +1676,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, /* ECC-353 */ /* JPEG packing is not available in GRIB edition 1 and has to be done AFTER we set data values */ if (setJpegPacking == 1) { - *err = grib_set_string(outh, "packingType", "grid_jpeg", &slen); + *err = grib_set_string(h_out, "packingType", "grid_jpeg", &slen); if (*err != GRIB_SUCCESS) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Failed to change packingType to JPEG: %s\n", grib_get_error_message(*err)); @@ -1687,7 +1684,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } } if (setCcsdsPacking == 1) { - *err = grib_set_string(outh, "packingType", "grid_ccsds", &slen); + *err = grib_set_string(h_out, "packingType", "grid_ccsds", &slen); if (*err != GRIB_SUCCESS) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Failed to change packingType to CCSDS: %s\n", grib_get_error_message(*err)); @@ -1697,7 +1694,7 @@ grib_handle* grib_util_set_spec2(grib_handle* h, } if (packing_spec->deleteLocalDefinition) { - grib_set_long(outh, "deleteLocalDefinition", 1); + grib_set_long(h_out, "deleteLocalDefinition", 1); } /* ECC-445 */ @@ -1705,36 +1702,32 @@ grib_handle* grib_util_set_spec2(grib_handle* h, Assert(!global_grid); /* ECC-576: "global" should not be set */ } - if ((*err = check_geometry(outh, spec, data_values_count, global_grid)) != GRIB_SUCCESS) { + if ((*err = check_geometry(h_out, spec, data_values_count, global_grid)) != GRIB_SUCCESS) { fprintf(stderr, "GRIB_UTIL_SET_SPEC: Geometry check failed! %s\n", grib_get_error_message(*err)); if (h->context->write_on_fail) - grib_write_message(outh, "error.grib", "w"); + grib_write_message(h_out, "error.grib", "w"); goto cleanup; } /* Disable check: need to re-examine GRIB-864 */ #if 0 - if ( (*err = check_handle_against_spec(outh, editionNumber, spec, global_grid)) != GRIB_SUCCESS) - { - + if ( (*err = check_handle_against_spec(h_out, editionNumber, spec, global_grid)) != GRIB_SUCCESS) { grib_context* c=grib_context_get_default(); fprintf(stderr,"GRIB_UTIL_SET_SPEC: Geometry check failed! %s\n", grib_get_error_message(*err)); if (editionNumber == 1) { fprintf(stderr,"Note: in GRIB edition 1 latitude and longitude values cannot be represented with sub-millidegree precision.\n"); } - if (c->write_on_fail) - grib_write_message(outh,"error.grib","w"); + if (c->write_on_fail) grib_write_message(h_out,"error.grib","w"); goto cleanup; } #endif - if (h->context->debug == -1) - fprintf(stderr, "ECCODES DEBUG: grib_util_set_spec end\n"); + if (h->context->debug == -1) fprintf(stderr, "ECCODES DEBUG: grib_util_set_spec end\n"); - return outh; + return h_out; cleanup: - if (outh) - grib_handle_delete(outh); + if (h_out) + grib_handle_delete(h_out); return NULL; } diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 3281011f5..9d7bfc8f5 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -23,6 +23,7 @@ list(APPEND test_bins gauss_sub grib_nearest_test grib_util_set_spec + grib_check_param_concepts grib_local_MeteoFrance grib_2nd_order_numValues grib_optimize_scaling diff --git a/tests/grib_ccsds.sh b/tests/grib_ccsds.sh index c2c3263f3..374c994d3 100755 --- a/tests/grib_ccsds.sh +++ b/tests/grib_ccsds.sh @@ -32,10 +32,8 @@ ${tools_dir}/grib_set -r -s packingType=grid_ccsds $outfile1 $outfile2 ${tools_dir}/grib_compare -b $BLACKLIST $outfile1 $outfile2 > $REDIRECT templateNumber=`${tools_dir}/grib_get -p dataRepresentationTemplateNumber $outfile2` - -if [ $templateNumber -ne 42 ] -then - echo dataRepresentationTemplateNumber=$templateNumber +if [ $templateNumber -ne 42 ]; then + echo "dataRepresentationTemplateNumber=$templateNumber. Should be 42!" exit 1 fi @@ -58,7 +56,8 @@ res3=`${tools_dir}/grib_get '-F%1.2f' -p min,max,avg $outfile2` rm -f $outfile1 $outfile2 -# ECC-297 +# ECC-297: Basic support +# -------------------------------------- infile=${data_dir}/tigge_ecmwf.grib2 outfile1=$infile.tmp_ccsds.1 outfile2=$infile.tmp_ccsds.2 @@ -68,10 +67,21 @@ ${tools_dir}/grib_set -r -s packingType=grid_ccsds $outfile1 $outfile2 ${tools_dir}/grib_compare -c data:n $outfile1 $outfile2 # ECC-477: redundant error message during conversion +# --------------------------------------------------- infile=${data_dir}/ccsds.grib2 rm -f $outfile2 ${tools_dir}/grib_set -r -s packingType=grid_simple $infile $outfile1 >$outfile2 2>&1 # there should be no error messages printed (to stdout or stderr) [ ! -s $outfile2 ] +# ECC-1202: Check input packingType=grid_ieee +# -------------------------------------------- +infile=${data_dir}/grid_ieee.grib +${tools_dir}/grib_set -r -s packingType=grid_ccsds $infile $outfile1 +grib_check_key_equals $outfile1 packingType grid_ccsds +${tools_dir}/grib_set -r -s packingType=grid_simple $infile $outfile2 +${tools_dir}/grib_compare -c data:n $outfile1 $outfile2 + + +# Clean up rm -f $outfile1 $outfile2 diff --git a/tests/grib_check_param_concepts.c b/tests/grib_check_param_concepts.c new file mode 100644 index 000000000..477bf5e04 --- /dev/null +++ b/tests/grib_check_param_concepts.c @@ -0,0 +1,143 @@ +/* + * (C) Copyright 2005- ECMWF. + * + * This software is licensed under the terms of the Apache Licence Version 2.0 + * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. + * + * In applying this licence, ECMWF does not waive the privileges and immunities granted to it by + * virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction. + */ + +/* + * Check GRIB2 parameter concept file e.g. shortName.def, paramId.def + */ + +#include +#include "grib_api_internal.h" + +typedef struct grib_expression_long { + grib_expression base; + long value; +} grib_expression_long; + +typedef struct grib_expression_functor { + grib_expression base; + char* name; + grib_arguments* args; +} grib_expression_functor; + +typedef struct grib_expression_string { + grib_expression base; + char* value; +} grib_expression_string; + +static int type_of_surface_missing(const char* value) +{ + /* Surface Type is Code Table 4.5 in which 255 is the same as missing */ + if (strcmp(value, "missing") == 0 || strcmp(value, "255") == 0) { + return 1; + } + return 0; +} +static int scale_factor_missing(const char* value) +{ + /* Scale factor is one octet so 255 is the same as missing */ + if (strcmp(value, "missing") == 0 || strcmp(value, "255") == 0) { + return 1; + } + return 0; +} + +static int grib_check_param_concepts(const char* key, const char* filename) +{ + grib_concept_value* concept_value = grib_parse_concept_file(NULL, filename); + if (!concept_value) + return GRIB_IO_PROBLEM; + + while (concept_value) { + grib_concept_condition* concept_condition = concept_value->conditions; + /* Convention: + * -1 key not present + * 0 key present and not missing + * 1 key present and missing + */ + int scaleFactor1Missing = -1, scaleFactor2Missing = -1; + int scaledValue1Missing = -1, scaledValue2Missing = -1; + int type1Missing = -1, type2Missing = -1; + int err = 0; + /* concept_value->name is the value of the key e.g. 151163 */ + while (concept_condition) { + char condition_value[512] = {0,}; + grib_expression* expression = concept_condition->expression; + const char* condition_name = concept_condition->name; + /* condition_name is discipline, parameterCategory etc. */ + if (strcmp(expression->cclass->name, "long") == 0) { + grib_expression_long* el = (grib_expression_long*)expression; + sprintf(condition_value, "%ld", el->value); + } + else if (strcmp(expression->cclass->name, "functor") == 0) { + grib_expression_functor* ef = (grib_expression_functor*)expression; + sprintf(condition_value, "%s", ef->name); + } + else if (strcmp(expression->cclass->name, "string") == 0) { + grib_expression_string* es = (grib_expression_string*)expression; + sprintf(condition_value, "%s", es->value); + } + else { + Assert(0); + } + if (strcmp(condition_name, "typeOfFirstFixedSurface") == 0) { + type1Missing = type_of_surface_missing(condition_value); + } + if (strcmp(condition_name, "typeOfSecondFixedSurface") == 0) { + type2Missing = type_of_surface_missing(condition_value); + } + if (strcmp(condition_name, "scaleFactorOfFirstFixedSurface") == 0) { + scaleFactor1Missing = scale_factor_missing(condition_value); + } + if (strcmp(condition_name, "scaleFactorOfSecondFixedSurface") == 0) { + scaleFactor2Missing = scale_factor_missing(condition_value); + } + if (strcmp(condition_name, "scaledValueOfFirstFixedSurface") == 0) { + scaledValue1Missing = (strcmp(condition_value, "missing") == 0); + } + if (strcmp(condition_name, "scaledValueOfSecondFixedSurface") == 0) { + scaledValue2Missing = (strcmp(condition_value, "missing") == 0); + } + + concept_condition = concept_condition->next; + } + /* Now check the scale factor/value pairs */ + if (type1Missing == 1 && scaleFactor1Missing == 0 && scaledValue1Missing == 0) err = 1; + if (type2Missing == 1 && scaleFactor2Missing == 0 && scaledValue2Missing == 0) err = 1; + if (scaleFactor1Missing == 1 && scaledValue1Missing == 0) err = 1; + if (scaleFactor1Missing == 0 && scaledValue1Missing == 1) err = 1; + if (scaleFactor2Missing == 1 && scaledValue2Missing == 0) err = 1; + if (scaleFactor2Missing == 0 && scaledValue2Missing == 1) err = 1; + if (err) { + fprintf(stderr, + "Error: Mismatched type of surface, scale factor, scaled value keys for %s='%s'.\n" + " If the type of surface is missing so should its scaled keys\n" + " If the scale factor is missing so should the scaled value and vice versa\n", + key, concept_value->name); + return GRIB_INVALID_KEY_VALUE; + } + concept_value = concept_value->next; + } + return GRIB_SUCCESS; +} + +int main(int argc, char** argv) +{ + int err = 0; + const char* concepts_key = argv[1]; + const char* concepts_filename = argv[2]; + + assert(argc == 3); + err = grib_check_param_concepts(concepts_key, concepts_filename); + if (err) return err; + + printf("ALL OK\n"); + + return 0; +} diff --git a/tests/grib_check_param_concepts.sh b/tests/grib_check_param_concepts.sh index e781c2827..161733c18 100755 --- a/tests/grib_check_param_concepts.sh +++ b/tests/grib_check_param_concepts.sh @@ -10,12 +10,21 @@ . ./include.sh -REDIRECT=/dev/null - -# This script will check the following concept files: -# name.def paramId.def shortName.def units.def cfVarName.def +# +# Do various checks on the concepts files # +# First check the GRIB2 paramId.def and shortName.def +# ---------------------------------------------------- +$EXEC ${test_dir}/grib_check_param_concepts paramId $ECCODES_DEFINITION_PATH/grib2/paramId.def +$EXEC ${test_dir}/grib_check_param_concepts paramId $ECCODES_DEFINITION_PATH/grib2/localConcepts/ecmf/paramId.def + +$EXEC ${test_dir}/grib_check_param_concepts shortName $ECCODES_DEFINITION_PATH/grib2/shortName.def +$EXEC ${test_dir}/grib_check_param_concepts shortName $ECCODES_DEFINITION_PATH/grib2/localConcepts/ecmf/shortName.def + + +# Check the group: name.def paramId.def shortName.def units.def cfVarName.def +# ---------------------------------------------------------------------------- # Check whether the Test::More Perl module is available set +e perl -e 'use Test::More;' diff --git a/tests/unit_tests.c b/tests/unit_tests.c index 455c8f439..abbf40aa6 100644 --- a/tests/unit_tests.c +++ b/tests/unit_tests.c @@ -1475,7 +1475,6 @@ static void test_concept_condition_strings() err = get_concept_condition_string(h, "gridType", NULL, result); Assert(!err); - /*printf("%s\n", result);*/ Assert(strcmp(result, "gridDefinitionTemplateNumber=0,PLPresent=0") == 0); err = get_concept_condition_string(h, "stepType", NULL, result);