28 use,
intrinsic :: ieee_exceptions
38 use version_control,
only : swb_version, git_commit_hash_string, &
39 git_branch_string, compile_date, compile_time, &
72 integer(c_int),
parameter ::
nc_nat = 0
76 integer(c_int),
parameter ::
nc_int = 4
139 integer (c_int),
public,
parameter ::
nc_time = 0
140 integer (c_int),
public,
parameter ::
nc_y = 1
141 integer (c_int),
public,
parameter ::
nc_x = 2
142 integer (c_int),
public,
parameter ::
nc_z = 3
143 integer (c_int),
public,
parameter ::
nc_aux = 3
144 integer (c_int),
public,
parameter ::
nc_crs = 4
145 integer (c_int),
public,
parameter ::
nc_lat = 5
146 integer (c_int),
public,
parameter ::
nc_lon = 6
151 integer (c_int),
parameter ::
nc_by = 2
153 integer (c_int),
public,
parameter ::
nc_left = 0
155 integer (c_int),
public,
parameter ::
nc_top = 0
159 integer (c_int),
parameter ::
row = 2
166 [
"NC_FORMAT_CLASSIC ", &
167 "NC_FORMAT_64BIT ", &
168 "NC_FORMAT_NETCDF4 ", &
169 "NC_FORMAT_NETCDF4_CLASSIC" ]
181 character (len=64) :: sdimensionname
183 integer (c_size_t) :: inc_dimsize
184 logical (c_bool) :: lunlimited =
false
188 character (len=64) :: sattributename
189 character (len=256),
dimension(:),
allocatable :: sattvalue
190 integer (c_short),
dimension(:),
allocatable :: i2attvalue
191 integer (c_int),
dimension(:),
allocatable :: iattvalue
192 real (c_float),
dimension(:),
allocatable :: rattvalue
193 real (c_double),
dimension(:),
allocatable :: dpattvalue
194 integer (c_int) :: inc_atttype
195 integer (c_size_t) :: inc_attsize
199 character (len=64) :: svariablename
201 integer (c_int) :: inc_vartype
202 integer (c_int) :: inumberofdimensions
203 integer (c_int),
dimension(0:3) :: inc_dimid =
nc_na_int
204 integer (c_int) :: inumberofattributes
209 integer (c_int) :: incid
210 character (len=256) :: sfilename =
''
211 integer (c_int) :: ifileformat = 0
212 integer (c_int) :: inumberofdimensions = 0
213 integer (c_int) :: inumberofvariables = 0
214 integer (c_int) :: inumberofattributes = 0
215 integer (c_int) :: inc3_unlimiteddimensionnumber = 0
219 integer (c_int) :: ioriginmonth = 0
220 integer (c_int) :: ioriginday = 0
221 integer (c_int) :: ioriginyear = 0
222 integer (c_int) :: ioriginhh = 0
223 integer (c_int) :: ioriginmm = 0
224 integer (c_int) :: ioriginss = 0
226 integer (c_size_t),
dimension(0:3) :: istart = 0
227 integer (c_size_t),
dimension(0:3) :: icount = 0
228 integer (c_size_t),
dimension(0:3) :: istride = 1
229 integer (c_size_t),
dimension(0:1) :: icolbounds = 0
230 integer (c_size_t),
dimension(0:1) :: irowbounds = 0
231 integer (c_int) :: inx = 0
232 integer (c_int) :: iny = 0
233 character (len=3) :: svariableorder =
"tyx"
234 real (c_double),
dimension(0:1) :: rx
235 real (c_double),
dimension(0:1) :: ry
236 real (c_double) :: rcoordinatetolerance = 0.0_c_double
237 logical (c_bool) :: lx_increaseswithindex =
true
238 logical (c_bool) :: ly_increaseswithindex =
false
239 logical (c_bool) :: lallowautomaticdataflipping =
true
241 real (c_double),
dimension(0:1) :: dpfirstandlasttimevalues = 0.
242 character (len=64),
dimension(0:3) :: svarname = [
"time",
"y ",
"x ",
"z "]
244 integer (c_int),
dimension(0:3) :: ivarindex =
nc_na_int
246 character (len=64),
dimension(0:3) :: svarunits =
"NA"
247 integer (c_int),
dimension(0:3, 0:3) :: ivar_dimid =
nc_na_int
248 real (c_double),
dimension(0:3) :: rscalefactor = 1.0_c_double
249 real (c_double),
dimension(0:3) :: raddoffset = 0.0_c_double
250 integer (c_int),
dimension(0:2) :: irowiter = 0
251 integer (c_int),
dimension(0:2) :: icoliter = 0
252 logical (c_bool) :: lfliphorizontal =
false
253 logical (c_bool) :: lflipvertical =
false
255 real (c_double),
allocatable,
dimension(:) :: rx_coords
256 real (c_double),
allocatable,
dimension(:) :: ry_coords
257 real (c_double) :: rx_coord_addoffset = 0.0_c_double
258 real (c_double) :: ry_coord_addoffset = 0.0_c_double
259 real (c_double),
allocatable,
dimension(:) :: rdatetimevalues
260 real (c_double) :: rgridcellsizex
261 real (c_double) :: rgridcellsizey
321 integer (c_int) :: ijulianday
322 logical (c_bool) :: lwithinrange
324 if ( ijulianday >= ncfile%iFirstDayJD &
325 .and. ijulianday <= ncfile%iLastDayJD )
then
347 real (c_double) :: rjulianday
348 integer (c_int) :: iindex
350 iindex = int(aint(rjulianday), c_int) - ncfile%iFirstDayJD
359 integer (c_int) :: iindex
360 real (c_double) :: rdayvalue
362 call assert(iindex >= lbound(ncfile%rDateTimeValues, 1) &
363 .and. iindex <= ubound(ncfile%rDateTimeValues, 1), &
364 "Dimension out of bounds", __file__, __line__)
365 rdayvalue = ncfile%rDateTimeValues(iindex)
374 real (c_double) :: rdayvalue
375 real (c_double) :: rjulianday
377 rjulianday = real(ncfile%iOriginJD, c_double) &
378 + real(ncfile%iOriginHH, c_double) / 24.0_c_double &
379 + real(ncfile%iOriginMM, c_double) / 1440.0_c_double &
380 + real(ncfile%iOriginSS, c_double) / 86400.0_c_double &
390 real (c_double) :: rjulianday
391 integer (c_size_t) :: istart
394 integer (c_int) :: imindiff, idiff
395 integer (c_int) :: icandidateindex
396 integer (c_int) :: iinitialcandidateindex
397 integer (c_int) :: itestindex
398 real (c_double) :: rtestjd
399 integer (c_int) :: iindexlower, iindexupper, iindex
400 logical (c_bool) :: lchanged
408 call assert(icandidateindex >=0,
"Problem finding the index number of the time " &
409 //
"variable in netCDF file "//
dquote(ncfile%sFilename), __file__, __line__)
411 iinitialcandidateindex = icandidateindex
416 iindexlower = max( lbound(ncfile%rDateTimeValues, 1), icandidateindex - 1)
417 iindexupper = min( ubound(ncfile%rDateTimeValues, 1), icandidateindex + 1)
421 do iindex=iindexlower,iindexupper
424 rdayvalue=ncfile%rDateTimeValues(iindex))
426 itestindex = int(aint(rtestjd), c_int) - ncfile%iFirstDayJD
427 idiff = abs(itestindex - iinitialcandidateindex)
429 if (idiff < imindiff )
then
432 icandidateindex = iindex
439 if (.not. lchanged )
exit
443 if (imindiff == 0) istart = int(icandidateindex, c_size_t)
452 integer (c_int) :: ivarindex
453 integer (c_int) :: ivarid
457 pnc_var => ncfile%pNC_VAR(ivarindex)
459 ivarid = pnc_var%iNC_VarID
468 integer (c_int) :: idimindex
469 integer (c_int) :: idimid
473 pnc_dim => ncfile%pNC_DIM(idimindex)
475 idimid = pnc_dim%iNC_DimID
484 integer (c_int) :: ivarid
485 integer (c_int) :: ivarindex
488 integer (c_int) :: iindex
489 logical (c_bool) :: lfound
493 do iindex=0, ncfile%iNumberOfVariables - 1
495 pnc_var => ncfile%pNC_VAR(iindex)
497 if (pnc_var%iNC_VarID == ivarid)
then
504 call assert(lfound,
"INTERNAL PROGRAMMING ERROR - No matching variable " &
505 //
"ID found: was looking for Variable ID: "//trim(
ascharacter(ivarid)), &
517 integer (c_int) :: ivarindex
518 character (len=*) :: sattname
519 character (len=256) :: sattvalue
522 integer (c_int) :: iindex, iindex2
523 logical (c_bool) :: lfound
525 if (ivarindex < 0)
then
527 pnc_att => ncfile%pNC_ATT
531 call assert(ivarindex >= lbound(ncfile%pNC_VAR,1) &
532 .and. ivarindex <= ubound(ncfile%pNC_VAR,1), &
533 "Index out of bounds referencing NCFILE%pNC_VAR" &
534 //
"~Offending index value: "//trim(
ascharacter(ivarindex)), &
537 pnc_att => ncfile%pNC_VAR(ivarindex)%pNC_ATT
543 do iindex=lbound(pnc_att,1), ubound(pnc_att,1)
545 if ( sattname .strequal. pnc_att(iindex)%sAttributeName )
then
552 call assert(lfound,
"INTERNAL PROGRAMMING ERROR - No matching attribute " &
553 //
"name found: was looking for attribute with name: "//
dquote(sattname), &
557 do iindex2=0, ubound(pnc_att(iindex)%sAttValue,1)
558 sattvalue = sattvalue//
" "//trim(pnc_att(iindex)%sAttValue(iindex))
569 integer (c_int) :: idimid
570 integer (c_int) :: idimindex
573 integer (c_int) :: iindex
574 logical (c_bool) :: lfound
578 do iindex=0, ncfile%iNumberOfDimensions - 1
580 pnc_dim => ncfile%pNC_DIM(iindex)
582 if (pnc_dim%iNC_DimID == idimid)
then
589 call assert(lfound,
"INTERNAL PROGRAMMING ERROR - No matching dimension " &
590 //
"ID found: was looking for Dimension ID: "//trim(
ascharacter(idimid)), &
602 integer (c_int) :: idimid
603 integer (c_size_t) :: idimsize
606 integer (c_int) :: iindex
607 logical (c_bool) :: lfound
612 do iindex=0, ncfile%iNumberOfDimensions - 1
614 pnc_dim => ncfile%pNC_DIM(iindex)
616 if (pnc_dim%iNC_DimID == idimid)
then
623 call assert(lfound,
"INTERNAL PROGRAMMING ERROR - No matching dimension " &
624 //
"ID found: was looking for Dimension ID: "//trim(
ascharacter(idimid)), &
627 idimsize = pnc_dim%iNC_DimSize
635 type (T_NETCDF4_FILE ) :: NCFILE
638 integer (c_int) :: iIndex
639 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
641 do iindex=lbound(ncfile%pNC_VAR,1),ubound(ncfile%pNC_VAR,1)
643 pnc_var => ncfile%pNC_VAR(iindex)
645 if ( ( pnc_var%sVariableName .strapprox.
'time') &
646 .or. ( pnc_var%sVariableName .strapprox.
'x') &
647 .or. ( pnc_var%sVariableName .strapprox.
'y') &
648 .or. ( pnc_var%sVariableName .strapprox.
'time_bnds') &
649 .or. ( pnc_var%sVariableName .strapprox.
'lat') &
650 .or. ( pnc_var%sVariableName .strapprox.
'lon') ) cycle
652 ncfile%sVarName(
nc_z) = pnc_var%sVariableName
664 character (len=*),
intent(in) :: sfilename
665 logical (c_bool),
intent(in),
optional :: guess_z_var_name
668 logical (c_bool) :: guess_z_var_name_l
670 if (
present( guess_z_var_name) )
then
671 guess_z_var_name_l = guess_z_var_name
673 guess_z_var_name_l =
false
688 if ( ncfile%iVarID(
nc_time) >= 0 )
then
691 ivarindex=ncfile%iVarIndex(
nc_time) )
707 ncfile%iColBounds(
nc_left) = lbound(ncfile%rX_Coords,1)
708 ncfile%iColBounds(
nc_right) = ubound(ncfile%rX_Coords,1)
710 ncfile%iRowBounds(
nc_top) = lbound(ncfile%rY_Coords,1)
711 ncfile%iRowBounds(
nc_bottom) = ubound(ncfile%rY_Coords,1)
731 lFlipHorizontal, lFlipVertical, &
732 lAllowAutomaticDataFlipping, &
733 rX_Coord_AddOffset, rY_Coord_AddOffset, &
734 sVariableOrder, sVarName_x, &
735 sVarName_y, sVarName_z, sVarName_time, &
736 rCoordinateTolerance, &
740 character (len=*) :: sfilename
741 logical (c_bool),
optional :: lfliphorizontal
742 logical (c_bool),
optional :: lflipvertical
743 logical (c_bool),
optional :: lallowautomaticdataflipping
744 character (len=*),
optional :: svariableorder
745 real (c_double),
optional :: rx_coord_addoffset
746 real (c_double),
optional :: ry_coord_addoffset
747 character (len=*),
optional :: svarname_x
748 character (len=*),
optional :: svarname_y
749 character (len=*),
optional :: svarname_z
750 character (len=*),
optional :: svarname_time
751 real (c_double),
optional :: rcoordinatetolerance
753 integer (c_int),
optional :: ilu
757 integer (c_size_t),
dimension(2) :: icolrow_ll, icolrow_ur, icolrow_lr, icolrow_ul
764 if (
present(lfliphorizontal) ) ncfile%lFlipHorizontal = lfliphorizontal
765 if (
present(lflipvertical) ) ncfile%lFlipVertical = lflipvertical
766 if (
present( lallowautomaticdataflipping) ) &
767 ncfile%lAllowAutomaticDataFlipping = lallowautomaticdataflipping
768 if (
present(rx_coord_addoffset)) ncfile%rX_Coord_AddOffset = rx_coord_addoffset
769 if (
present(ry_coord_addoffset)) ncfile%rY_Coord_AddOffset = ry_coord_addoffset
771 if (
present(rcoordinatetolerance)) ncfile%rCoordinateTolerance = rcoordinatetolerance
773 if (
present(svariableorder) ) ncfile%sVariableOrder = svariableorder
775 if(
present(ilu) )
then
776 inquire (unit=ilu, opened=lfileopen)
780 if (
present(svarname_x) )
then
781 ncfile%sVarName(
nc_x) = svarname_x
783 ncfile%sVarName(
nc_x) =
"x"
786 if (
present(svarname_y) )
then
787 ncfile%sVarName(
nc_y) = svarname_y
789 ncfile%sVarName(
nc_y) =
"y"
792 if (
present(svarname_z) )
then
793 ncfile%sVarName(
nc_z) = svarname_z
795 ncfile%sVarName(
nc_z) =
"prcp"
798 if (
present(svarname_time) )
then
799 ncfile%sVarName(
nc_time) = svarname_time
801 ncfile%sVarName(
nc_time) =
"time"
808 if ( ncfile%iVarID(
nc_time) >= 0 )
then
811 ivarindex=ncfile%iVarIndex(
nc_time) )
831 if (
present(tgridbounds) )
then
839 rx=tgridbounds%rXll, &
843 rx=tgridbounds%rXlr, &
847 rx=tgridbounds%rXul, &
851 rx=tgridbounds%rXur, &
855 write(*, fmt=
"(a)")
"subroutine 'netcdf_open_and_prepare_as_input'"
856 write(*, fmt=
"(a,a,i6)")
"Find correspondence between project bounds (in native projection) and row, col of dataset | ", &
857 trim(__file__), __line__
858 write(*, fmt=
"(a)")
" column row X Y"
859 write(*, fmt=
"(a,i6,i6,a,f14.3,f14.3)")
"LL: ", icolrow_ll(
column), icolrow_ll(
row),
" <==> ", tgridbounds%rXll, tgridbounds%rYll
860 write(*, fmt=
"(a,i6,i6,a,f14.3,f14.3)")
"LR: ", icolrow_lr(
column), icolrow_lr(
row),
" <==> ", tgridbounds%rXlr, tgridbounds%rYlr
861 write(*, fmt=
"(a,i6,i6,a,f14.3,f14.3)")
"UL: ", icolrow_ul(
column), icolrow_ul(
row),
" <==> ", tgridbounds%rXul, tgridbounds%rYul
862 write(*, fmt=
"(a,i6,i6,a,f14.3,f14.3)")
"UR: ", icolrow_ur(
column), icolrow_ur(
row),
" <==> ", tgridbounds%rXur, tgridbounds%rYur
867 int(lbound(ncfile%rX_Coords,1), c_size_t) )
871 int(ubound(ncfile%rX_Coords,1), c_size_t) )
874 ncfile%iRowBounds(
nc_top) = &
875 max( min( icolrow_ul(
row), icolrow_ur(
row), icolrow_ll(
row), icolrow_lr(
row) ) - 4_c_size_t, &
876 int(lbound(ncfile%rY_Coords,1), c_size_t) )
879 min( max( icolrow_ul(
row), icolrow_ur(
row), icolrow_ll(
row), icolrow_lr(
row) ) + 4_c_size_t, &
880 int(ubound(ncfile%rY_Coords,1), c_size_t) )
885 ncfile%iColBounds(
nc_left) = lbound(ncfile%rX_Coords,1)
886 ncfile%iColBounds(
nc_right) = ubound(ncfile%rX_Coords,1)
888 ncfile%iRowBounds(
nc_top) = lbound(ncfile%rY_Coords,1)
889 ncfile%iRowBounds(
nc_bottom) = ubound(ncfile%rY_Coords,1)
911 iOriginMonth, iOriginDay, iOriginYear, iStartYear, iEndYear)
915 integer (c_int) :: ioriginmonth
916 integer (c_int) :: ioriginday
917 integer (c_int) :: ioriginyear
918 integer (c_int) :: istartyear
919 integer (c_int) :: iendyear
922 integer (c_int) :: inumcols, inumrows
923 integer (c_int) :: imincol, imaxcol
924 integer (c_int) :: iminrow, imaxrow
925 real (c_double),
dimension(:),
allocatable :: rx, ry
926 character (len=10) :: sorigintext
927 character (len=256) :: sfilename
929 write(sorigintext, fmt=
"(i4.4,'-',i2.2,'-',i2.2)") ioriginyear, &
930 ioriginmonth, ioriginday
932 imaxrow = int(maxval(ncfile%iRowBounds), c_int)
933 iminrow = int(minval(ncfile%iRowBounds), c_int)
934 imaxcol = int(maxval(ncfile%iColBounds), c_int)
935 imincol = int(minval(ncfile%iColBounds), c_int)
937 inumrows = imaxrow - iminrow + 1
938 inumcols = imaxcol - imincol + 1
940 allocate(rx(inumcols))
941 allocate(ry(inumrows))
942 rx = ncfile%rX_Coords(imincol:imaxcol)
943 ry = ncfile%rY_Coords(iminrow:imaxrow)
945 sfilename = trim(ncfile%sVarName(
nc_z))//
"_"//trim(
ascharacter(istartyear)) &
950 call nf_create(ncfile=ncfile_archive, sfilename=trim(sfilename) )
957 ncfile_archive%sVarUnits(
nc_x) = ncfile%sVarUnits(
nc_x)
958 ncfile_archive%sVarUnits(
nc_y) = ncfile%sVarUnits(
nc_y)
959 ncfile_archive%sVarUnits(
nc_z) = ncfile%sVarUnits(
nc_z)
966 svarname_z = trim(ncfile%sVarName(
nc_z)) )
974 sorigintext=sorigintext)
977 sdatatype=trim(ncfile%sVarName(
nc_z)), &
978 ssourcefile=trim(ncfile%sFilename))
985 ivarid=ncfile_archive%iVarID(
nc_z), &
993 dpx=ncfile%rX_Coords(imincol:imaxcol), &
994 dpy=ncfile%rY_Coords(iminrow:imaxrow) )
1005 iNX, iNY, fX, fY, StartDate, EndDate, PROJ4_string, history_list, executable_name, &
1006 dpLat, dpLon, fValidMin, fValidMax, write_time_bounds, filename_prefix, &
1010 character (len=*),
intent(in) :: svariablename
1011 character (len=*),
intent(in) :: svariableunits
1012 integer (c_int),
intent(in) :: iny
1013 real (c_double),
intent(in) :: fx(:)
1014 integer (c_int),
intent(in) :: inx
1015 real (c_double),
intent(in) :: fy(:)
1018 character (len=*),
intent(in) :: proj4_string
1019 type (
fstring_list_t),
intent(in),
pointer,
optional :: history_list
1020 character (len=*),
intent(in),
optional :: executable_name
1021 real (c_double),
intent(in),
optional :: dplat(:,:)
1022 real (c_double),
intent(in),
optional :: dplon(:,:)
1023 real (c_float),
intent(in),
optional :: fvalidmin
1024 real (c_float),
intent(in),
optional :: fvalidmax
1025 logical (c_bool),
intent(in),
optional :: write_time_bounds
1026 character (len=*),
intent(in),
optional :: filename_prefix
1027 character (len=*),
intent(in),
optional :: filename_modifier
1030 character (len=10) :: sorigintext
1031 character (len=:),
allocatable :: sfilename
1033 logical (c_bool) :: write_time_bounds_l
1034 character (len=:),
allocatable :: executable_name_l
1035 real (c_float) :: valid_minimum
1036 real (c_float) :: valid_maximum
1037 logical (c_bool) :: include_latlon
1039 character (len=:),
allocatable :: date_time_text
1040 character (len=:),
allocatable :: filename_prefix_l
1041 character (len=:),
allocatable :: filename_modifier_l
1043 date_time_text = dt%prettydatetime()
1046 if (
present( fvalidmin ) )
then
1047 valid_minimum = fvalidmin
1049 valid_minimum = -1.0e+3
1052 if (
present( fvalidmax ) )
then
1053 valid_maximum = fvalidmax
1055 valid_maximum = 1.0e+10
1058 if (
present( executable_name ) )
then
1059 executable_name_l = trim( executable_name )
1061 executable_name_l =
"SWB"
1064 if (
present( filename_modifier ) )
then
1065 filename_modifier_l =
"_"//trim( filename_modifier )//
"_"
1067 filename_modifier_l =
"_"
1070 if (
present( filename_prefix ) )
then
1071 if (len_trim(filename_prefix) > 0)
then
1072 filename_prefix_l = trim( filename_prefix )//
"_"
1074 filename_prefix_l =
""
1077 filename_prefix_l =
""
1080 if (
present( history_list) )
then
1081 history_list_l => history_list
1083 allocate( history_list_l )
1084 call history_list_l%append(date_time_text//
": Soil-Water-Balance run started.")
1087 if (
present( write_time_bounds ) )
then
1088 write_time_bounds_l = write_time_bounds
1090 write_time_bounds_l =
false
1093 include_latlon =
logical( present( dpLat ) .and. present( dpLon ), c_bool )
1095 write(sorigintext, fmt=
"(i4.4,'-',i2.2,'-',i2.2)") startdate%iYear, startdate%iMonth, startdate%iDay
1099 if (len_trim(filename_prefix_l) > 0 )
then
1102 //trim(svariablename)//
"_"//filename_modifier_l &
1103 //startdate%prettydate()//
"_to_"//enddate%prettydate()//
"__" &
1109 //trim(svariablename)//
"_"//filename_modifier_l &
1110 //startdate%prettydate()//
"_to_"//enddate%prettydate()//
"__" &
1115 call logs%write(
"Attempting to open netCDF file for writing with filename "//
dquote(sfilename))
1117 call nf_create(ncfile=ncfile, sfilename=trim(sfilename) )
1121 write_time_bounds=write_time_bounds_l )
1126 ncfile%sVarUnits(
nc_z) = svariableunits
1133 llatlon=include_latlon, write_time_bounds=write_time_bounds_l )
1141 proj4_string=proj4_string, llatlon=include_latlon, fvalidmin=valid_minimum, &
1142 fvalidmax=valid_maximum, write_time_bounds=write_time_bounds_l )
1145 sdatatype=trim(ncfile%sVarName(
nc_z)), history_list=history_list_l, &
1146 executable_name=executable_name_l )
1152 ivarid=ncfile%iVarID(
nc_z), &
1167 ncfile%rX_Coords = fx
1168 ncfile%rY_Coords = fy
1170 if (
present( dplat ) .and.
present( dplon ) )
then
1185 type (T_NETCDF4_FILE ) :: NCFILE
1186 character (len=*) :: sVarName_z
1188 ncfile%sVarName(
nc_z) = svarname_z
1196 type (T_NETCDF4_FILE ) :: NCFILE
1204 ncfile%iRowIter(
nc_last) = ncfile%iNY
1205 ncfile%iRowIter(
nc_by) = 1
1214 ncfile%iColIter(
nc_last) = ncfile%iNX
1215 ncfile%iColIter(
nc_by) = 1
1224 type (T_NETCDF4_FILE ) :: NCFILE
1227 integer (c_int) :: iIndex
1233 select case (iindex)
1239 ncfile%iStart(iindex) = minval(ncfile%iColBounds) - 1_c_size_t
1240 ncfile%iNX = int(maxval(ncfile%iColBounds) - minval(ncfile%iColBounds) + 1_c_size_t, c_int)
1241 ncfile%iCount(iindex) = int(ncfile%iNX, c_size_t)
1243 ncfile%iStride(iindex) = 1_c_size_t
1250 ncfile%iStart(iindex) = minval(ncfile%iRowBounds) - 1_c_size_t
1251 ncfile%iNY = int(maxval(ncfile%iRowBounds) - minval(ncfile%iRowBounds) + 1_c_size_t, c_int)
1252 ncfile%iCount(iindex) = int(ncfile%iNY, c_size_t)
1258 ncfile%iStride(iindex) = 1_c_size_t
1262 ncfile%iStart(iindex) = 0_c_size_t
1263 ncfile%iCount(iindex) = 1_c_size_t
1264 ncfile%iStride(iindex) = 1_c_size_t
1278 type (T_NETCDF4_FILE ) :: NCFILE
1281 real (c_double) :: rXmin, rXmax
1282 real (c_double) :: rYmin, rYmax
1285 rxmin = minval(ncfile%rX_Coords(ncfile%iColBounds(
nc_left):ncfile%iColBounds(
nc_right)) )
1286 rxmax = maxval(ncfile%rX_Coords(ncfile%iColBounds(
nc_left):ncfile%iColBounds(
nc_right)) )
1287 rymin = minval(ncfile%rY_Coords(ncfile%iRowBounds(
nc_top):ncfile%iRowBounds(
nc_bottom)) )
1288 rymax = maxval(ncfile%rY_Coords(ncfile%iRowBounds(
nc_top):ncfile%iRowBounds(
nc_bottom)) )
1290 ncfile%rX(
nc_left) = rxmin - ncfile%rGridCellSizeX * 0.5_c_double
1291 ncfile%rX(
nc_right) = rxmax + ncfile%rGridCellSizeX * 0.5_c_double
1292 ncfile%rY(
nc_top) = rymax + ncfile%rGridCellSizeY * 0.5_c_double
1293 ncfile%rY(
nc_bottom) = rymin - ncfile%rGridCellSizeY * 0.5_c_double
1297 print *, repeat(
"-", 80)
1298 print *,
"Filename: ", ncfile%sFilename
1299 print *,
"Grid cell size (X): ", ncfile%rGridCellSizeX
1300 print *,
"Grid cell size (Y): ", ncfile%rGridCellSizeY
1302 print *,
"Bounds of data subset area, in native coordinates"
1303 print *,
"X (left): ", ncfile%rX(
nc_left)
1304 print *,
"X (right): ", ncfile%rX(
nc_right)
1305 print *,
"Y (top): ", ncfile%rY(
nc_top)
1306 print *,
"Y (bottom): ", ncfile%rY(
nc_bottom)
1316 type (T_NETCDF4_FILE ) :: NCFILE
1318 integer (c_int) :: iVarIndex_time
1319 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR_time
1320 type (T_NETCDF_DIMENSION),
pointer :: pNC_DIM_time
1321 integer (c_int) :: iStat
1325 ivarindex_time = ncfile%iVarIndex(
nc_time)
1327 call assert(ivarindex_time >= lbound(ncfile%pNC_VAR,1) &
1328 .and. ivarindex_time <= ubound(ncfile%pNC_VAR,1), &
1329 "INTERNAL PROGRAMMING ERROR - Index out of bounds", __file__, __line__)
1331 pnc_var_time => ncfile%pNC_VAR(ivarindex_time)
1332 pnc_dim_time => ncfile%pNC_DIM( pnc_var_time%iNC_DimID(0) )
1334 if (
allocated(ncfile%rDateTimeValues) )
deallocate(ncfile%rDateTimeValues, stat=istat)
1335 call assert(istat==0,
"Failed to deallocate memory for time values", &
1338 allocate( ncfile%rDateTimeValues(0 : pnc_dim_time%iNC_DimSize-1_c_size_t ), stat=istat )
1339 call assert(istat==0,
"Failed to allocate memory for time values", &
1345 inc_varid=pnc_var_time%iNC_VarID, &
1346 inc_start=0_c_size_t, &
1347 inc_count=pnc_dim_time%iNC_DimSize, &
1348 inc_stride=1_c_size_t, &
1349 dpnc_vars=ncfile%rDateTimeValues)
1357 type (T_NETCDF4_FILE ) :: NCFILE
1359 integer (c_int) :: iVarIndex_x, iVarIndex_y
1360 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR_x, pNC_VAR_y
1361 type (T_NETCDF_DIMENSION),
pointer :: pNC_DIM_x, pNC_DIM_y
1362 integer (c_int) :: iLowerBound, iUpperBound
1363 integer (c_int) :: iStat
1365 ivarindex_x = ncfile%iVarIndex(
nc_x)
1366 ivarindex_y = ncfile%iVarIndex(
nc_y)
1368 call assert(ivarindex_x >= lbound(ncfile%pNC_VAR,1) &
1369 .and. ivarindex_x <= ubound(ncfile%pNC_VAR,1), &
1370 "INTERNAL PROGRAMMING ERROR - Index out of bounds", __file__, __line__)
1372 call assert(ivarindex_y >= lbound(ncfile%pNC_VAR,1) &
1373 .and. ivarindex_y <= ubound(ncfile%pNC_VAR,1), &
1374 "INTERNAL PROGRAMMING ERROR - Index out of bounds", __file__, __line__)
1376 pnc_var_x => ncfile%pNC_VAR(ivarindex_x)
1377 pnc_var_y => ncfile%pNC_VAR(ivarindex_y)
1379 call assert( pnc_var_x%iNumberOfDimensions == 1, &
1380 "Dimensions other than one for the x-coordinate variable are currently unsupported.", &
1383 call assert( pnc_var_y%iNumberOfDimensions == 1, &
1384 "Dimensions other than one for the y-coordinate variable are currently unsupported.", &
1387 pnc_dim_x => ncfile%pNC_DIM( pnc_var_x%iNC_DimID(0) )
1388 pnc_dim_y => ncfile%pNC_DIM( pnc_var_y%iNC_DimID(0) )
1390 allocate( ncfile%rX_Coords( pnc_dim_x%iNC_DimSize ), stat=istat )
1391 call assert(istat==0,
"Failed to allocate memory for X-coordinate values", &
1394 allocate (ncfile%rY_Coords( pnc_dim_y%iNC_DimSize ), stat=istat )
1395 call assert(istat==0,
"Failed to allocate memory for Y-coordinate values", &
1399 inc_varid=pnc_var_x%iNC_VarID, &
1400 inc_start=0_c_size_t, &
1401 inc_count=pnc_dim_x%iNC_DimSize, &
1402 inc_stride=1_c_size_t, &
1403 dpnc_vars=ncfile%rX_Coords)
1406 inc_varid=pnc_var_y%iNC_VarID, &
1407 inc_start=0_c_size_t, &
1408 inc_count=pnc_dim_y%iNC_DimSize, &
1409 inc_stride=1_c_size_t, &
1410 dpnc_vars=ncfile%rY_Coords)
1412 ncfile%rX_Coords = ncfile%rX_Coords + ncfile%rX_Coord_AddOffset
1413 ncfile%rY_Coords = ncfile%rY_Coords + ncfile%rY_Coord_AddOffset
1415 ilowerbound = lbound(ncfile%rX_Coords, 1)
1416 iupperbound = ubound(ncfile%rX_Coords, 1)
1418 if (ncfile%rX_Coords(iupperbound) > ncfile%rX_Coords(ilowerbound) )
then
1419 ncfile%lX_IncreasesWithIndex =
true
1420 if ( ncfile%lAllowAutomaticDataFlipping ) ncfile%lFlipHorizontal =
false
1422 ncfile%lX_IncreasesWithIndex =
false
1423 if ( ncfile%lAllowAutomaticDataFlipping )
then
1424 ncfile%lFlipHorizontal =
true
1425 call logs%write(
"** Horizontal coordinates decrease with index values **", &
1428 call logs%write(
" ==> flipping grid horizontally", &
1434 ilowerbound = lbound(ncfile%rY_Coords, 1)
1435 iupperbound = ubound(ncfile%rY_Coords, 1)
1437 if (ncfile%rY_Coords(iupperbound) > ncfile%rY_Coords(ilowerbound) )
then
1438 ncfile%lY_IncreasesWithIndex =
true
1439 if ( ncfile%lAllowAutomaticDataFlipping )
then
1440 ncfile%lFlipVertical =
true
1441 call logs%write(
"** Vertical coordinates increase with index values **", &
1444 call logs%write(
" ==> flipping grid vertically", &
1449 ncfile%lY_IncreasesWithIndex =
false
1450 if ( ncfile%lAllowAutomaticDataFlipping ) ncfile%lFlipVertical =
false
1453 call assert(pnc_dim_x%iNC_DimSize > 2,
"INTERNAL PROGRAMMING ERROR - " &
1454 //
"netCDF X dimension size must be greater than 2.", __file__, __line__)
1456 call assert(pnc_dim_y%iNC_DimSize > 2,
"INTERNAL PROGRAMMING ERROR - " &
1457 //
"netCDF Y dimension size must be greater than 2.", __file__, __line__)
1459 ncfile%rGridCellSizeX = ( maxval(ncfile%rX_Coords) &
1460 - minval(ncfile%rX_Coords) ) &
1461 / real(pnc_dim_x%iNC_DimSize - 1, c_double)
1463 ncfile%rGridCellSizeY = ( maxval(ncfile%rY_Coords) &
1464 - minval(ncfile%rY_Coords) ) &
1465 / real(pnc_dim_y%iNC_DimSize - 1, c_double)
1480 type (T_NETCDF4_FILE ) :: NCFILE
1481 character (len=*) :: sFilename
1482 integer (c_int),
optional :: iLU
1485 logical :: lFileOpen
1487 call logs%write(
"Attempting to open READONLY netCDF file: " &
1496 call logs%write(
" Succeeded. ncid: "//trim(
ascharacter(ncfile%iNCID)) &
1499 ncfile%sFilename = sfilename
1501 if(
present(ilu) )
then
1502 inquire (unit=ilu, opened=lfileopen)
1513 character (len=*) :: sfilename
1514 integer (c_int),
optional :: ilu
1516 if (
present(ilu) )
then
1519 sfilename=sfilename, &
1525 sfilename=sfilename)
1545 if ( ncfile%iVarID(
nc_time) >= 0 )
then
1548 ivarindex=ncfile%iVarIndex(
nc_time) )
1567subroutine nf_trap( iResultCode, sFilename, iLineNumber, netcdf_filename )
1569 integer (c_int) :: iResultCode
1570 character (len=*),
optional :: sFilename
1571 integer (c_int),
optional :: iLineNumber
1572 character (len=*),
optional :: netcdf_filename
1575 type(c_ptr) :: cpResult
1576 character (len=256) :: sTextString
1577 character (len=256) :: sFile
1578 integer (c_int) :: iLine
1580 if (iresultcode /= 0)
then
1582 if (
present(sfilename))
then
1583 sfile = trim(sfilename)
1588 if (
present(ilinenumber))
then
1597 if (
present( netcdf_filename ) ) &
1598 call logs%write(
"netCDF filename: "//
dquote( netcdf_filename ) )
1600 call logs%write(
"netCDF ERROR: "//
dquote( stextstring )//
" | error code was: " &
1603 call assert(
false,
"SWB is stopping due to a problem reading or writing" &
1604 //
" a netCDF file", trim(sfile), iline)
1616 call logs%write(
"Closing netCDF file with name: "//
dquote(ncfile%sFilename))
1631 integer (c_int) :: iindex
1633 do iindex=0, ncfile%iNumberOfVariables - 1
1635 pnc_var => ncfile%pNC_VAR(iindex)
1637 if (pnc_var%iNumberOfAttributes == 0 ) cycle
1639 if (
associated( pnc_var%pNC_ATT ))
deallocate( pnc_var%pNC_ATT )
1640 pnc_var%pNC_ATT => null()
1644 if (
associated( ncfile%pNC_VAR ))
deallocate( ncfile%pNC_VAR )
1645 if (
associated( ncfile%pNC_ATT ))
deallocate( ncfile%pNC_ATT )
1646 if (
associated( ncfile%pNC_DIM ))
deallocate( ncfile%pNC_DIM )
1648 ncfile%pNC_VAR => null()
1649 ncfile%pNC_ATT => null()
1650 ncfile%pNC_DIM => null()
1662 ncfile%pNC_VAR => null()
1663 ncfile%pNC_ATT => null()
1664 ncfile%pNC_DIM => null()
1672 type (T_NETCDF4_FILE) :: NCFILE
1673 integer (c_int) :: iStat
1674 integer (c_int) :: iIndex
1675 character (len=256) :: sDimName
1678 __file__, __line__ )
1681 if (
associated(ncfile%pNC_DIM) )
deallocate(ncfile%pNC_DIM, stat=istat)
1682 call assert(istat == 0,
"Could not deallocate memory for NC_DIM member in NC_FILE defined type", &
1685 allocate(ncfile%pNC_DIM( 0 : ncfile%iNumberOfDimensions-1), stat=istat )
1686 call assert(istat == 0,
"Could not allocate memory for NC_DIM member in NC_FILE defined type", &
1691 __file__, __line__ )
1693 do iindex = 0, ncfile%iNumberOfDimensions-1
1697 lenp=ncfile%pNC_DIM(iindex)%iNC_DimSize), __file__, __line__ )
1699 ncfile%pNC_DIM(iindex)%iNC_DimID = iindex
1710 type (T_NETCDF4_FILE) :: NCFILE
1712 type (T_NETCDF_ATTRIBUTE),
pointer :: pNC_ATT
1713 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
1714 integer (c_int) :: iStat
1715 integer (c_int) :: iIndex, iIndex2
1716 character (len=256) :: sVarName
1719 __file__, __line__ )
1722 if (
associated(ncfile%pNC_VAR) )
deallocate(ncfile%pNC_VAR, stat=istat)
1723 call assert(istat == 0,
"Could not deallocate memory for NC_VAR member in NC_FILE defined type", &
1726 allocate(ncfile%pNC_VAR( 0 : ncfile%iNumberOfVariables-1), stat=istat )
1727 call assert(istat == 0,
"Could not allocate memory for NC_VAR member in NC_FILE defined type", &
1730 do iindex = 0, ncfile%iNumberOfVariables-1
1732 pnc_var => ncfile%pNC_VAR(iindex)
1737 xtypep=pnc_var%iNC_VarType, &
1738 ndimsp=pnc_var%iNumberOfDimensions, &
1739 dimidsp=pnc_var%iNC_DimID, &
1740 nattsp=pnc_var%iNumberOfAttributes ), __file__, __line__ )
1742 pnc_var%iNC_VarID = iindex
1745 if( pnc_var%iNumberOfAttributes > 0 )
then
1747 if (
associated(pnc_var%pNC_ATT) )
deallocate(pnc_var%pNC_ATT, stat=istat)
1748 call assert(istat == 0,
"Could not deallocate memory for NC_ATT member within NC_VAR in NC_FILE defined type", &
1751 allocate( pnc_var%pNC_ATT( 0:pnc_var%iNumberOfAttributes - 1 ), stat = istat)
1752 call assert(istat == 0,
"Could not allocate memory for NC_ATT member within NC_VAR in NC_FILE defined type", &
1755 do iindex2=0, pnc_var%iNumberOfAttributes - 1
1757 pnc_att => pnc_var%pNC_ATT(iindex2)
1760 inc_varid=iindex, iattnum=iindex2 )
1769 __file__, __line__ )
1772 if (
associated(ncfile%pNC_ATT) )
deallocate(ncfile%pNC_ATT, stat=istat)
1773 call assert(istat == 0,
"Could not deallocate memory for NC_ATT member within NC_FILE defined type", &
1776 allocate(ncfile%pNC_ATT(0:ncfile%iNumberOfAttributes - 1), stat=istat )
1777 call assert(istat == 0,
"Could not allocate memory for NC_ATT member within NC_FILE defined type", &
1780 do iindex=0, ncfile%iNumberOfAttributes - 1
1781 pnc_att => ncfile%pNC_ATT(iindex)
1794 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
1795 type (T_NETCDF_ATTRIBUTE),
pointer :: pNC_ATT
1796 integer (c_int) :: iNC_VarID
1797 integer (c_int) :: iAttNum
1800 integer (c_int) :: iStat
1801 character (len=256) :: sAttName
1802 integer (c_int) :: iIndex
1803 integer (c_int) :: iLength
1808 name=sattname), __file__, __line__ )
1815 xtypep=pnc_att%iNC_AttType, &
1816 lenp=pnc_att%iNC_AttSize), __file__, __line__ )
1818 ilength = int(pnc_att%iNC_AttSize, c_int)
1821 allocate(pnc_att%sAttValue(0:ilength-1), stat=istat )
1822 call assert(istat==0,
"INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1824 pnc_att%sAttValue =
""
1826 select case(pnc_att%iNC_AttType)
1833 ip=pnc_att%sAttValue), __file__, __line__ )
1839 allocate(pnc_att%i2AttValue(0:ilength-1), stat=istat )
1840 call assert(istat==0,
"INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1847 ip=pnc_att%i2AttValue), __file__, __line__ )
1849 do iindex=1,ubound(pnc_att%i2AttValue,1)
1850 pnc_att%sAttValue(iindex) =
ascharacter(pnc_att%i2AttValue(iindex))
1855 allocate(pnc_att%iAttValue(0:ilength-1), stat=istat )
1856 call assert(istat==0,
"INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1862 ip=pnc_att%iAttValue), __file__, __line__ )
1864 do iindex=1,ubound(pnc_att%iAttValue,1)
1865 pnc_att%sAttValue(iindex) =
ascharacter(pnc_att%iAttValue(iindex))
1870 allocate(pnc_att%rAttValue(0:ilength-1), stat=istat )
1871 call assert(istat==0,
"INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1878 ip=pnc_att%rAttValue), __file__, __line__ )
1880 do iindex=1,ubound(pnc_att%rAttValue,1)
1881 pnc_att%sAttValue(iindex) =
ascharacter(pnc_att%rAttValue(iindex))
1886 allocate(pnc_att%dpAttValue(0:ilength-1), stat=istat )
1887 call assert(istat==0,
"INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1893 ip=pnc_att%dpAttValue), __file__, __line__ )
1895 do iindex=1,ubound(pnc_att%dpAttValue,1)
1896 pnc_att%sAttValue(iindex) =
ascharacter(pnc_att%dpAttValue(iindex))
1912 character (len=*),
intent(in) :: variable_name
1913 integer (c_int),
intent(out) :: variable_id
1916 integer (c_int) :: indx
1918 logical (c_bool) :: variable_was_found
1920 variable_was_found =
false
1922 do indx=0, ncfile%iNumberOfVariables-1
1923 pnc_var => ncfile%pNC_VAR( indx )
1924 if (
associated( pnc_var ) )
then
1925 if ( pnc_var%sVariableName .strequal. variable_name )
then
1926 variable_was_found =
true
1932 if ( variable_was_found )
then
1934 variable_id = pnc_var%iNC_VarID
1947 attribute_name_list, &
1948 attribute_value_list )
1951 character (len=*),
intent(in) :: variable_name
1956 integer (c_int) :: indx
1959 logical (c_bool) :: variable_was_found
1960 character (len=256) :: tempstring
1962 variable_was_found =
false
1964 call attribute_name_list%clear
1965 call attribute_value_list%clear
1967 do indx=0, ncfile%iNumberOfVariables-1
1968 pnc_var => ncfile%pNC_VAR( indx )
1969 if (
associated( pnc_var ) )
then
1970 if ( pnc_var%sVariableName .strequal. variable_name )
then
1971 variable_was_found =
true
1977 if ( variable_was_found )
then
1979 do indx=0, pnc_var%iNumberOfAttributes-1
1980 pnc_att => pnc_var%pNC_ATT( indx )
1981 if (
associated( pnc_att) )
then
1983 tempstring = pnc_att%sAttributeName
1984 call attribute_name_list%append( trim( tempstring ) )
1986 select case ( pnc_att%iNC_AttType )
1990 tempstring = pnc_att%sAttValue(0)
1991 call attribute_value_list%append( trim( tempstring ) )
1996 call attribute_value_list%append( trim( tempstring ) )
2001 call attribute_value_list%append( trim( tempstring ) )
2006 call attribute_value_list%append( trim( tempstring ) )
2011 call attribute_value_list%append( trim( tempstring ) )
2021 call attribute_name_list%append(
"<NA>")
2022 call attribute_value_list%append(
"<NA>")
2033 real (c_double),
intent(in) :: tolerance
2035 ncfile%rCoordinateTolerance = tolerance
2047 integer (c_int) :: indx
2050 call variable_list%clear
2052 do indx=0, ncfile%iNumberOfVariables-1
2053 pnc_var => ncfile%pNC_VAR( indx )
2054 if (
associated( pnc_var ) )
call variable_list%append( pnc_var%sVariableName )
2064 integer (c_int) :: ijulianday
2065 logical (c_bool) :: ldatetimefound
2070 rjulianday=real(ijulianday, c_double ) )
2072 if (ncfile%iStart(
nc_time) < 0)
then
2074 ldatetimefound =
false
2076 ldatetimefound =
true
2086 real (c_float),
dimension(:,:),
optional :: rvalues
2087 real (c_double),
dimension(:,:),
optional :: dpvalues
2088 integer (c_int),
dimension(:,:),
optional :: ivalues
2090 real (c_float),
allocatable :: rtempvals(:,:)
2091 integer (c_short),
allocatable :: i2tempvals(:,:)
2092 integer (c_int),
allocatable :: itempvals(:,:)
2093 real (c_double),
allocatable :: dptempvals(:,:)
2094 integer (c_int) :: nrow, ncol
2099 if (
present( rvalues) )
then
2100 nrow =
size(rvalues,2)
2101 ncol =
size(rvalues,1)
2102 elseif (
present( dpvalues) )
then
2103 nrow =
size(dpvalues,2)
2104 ncol =
size(dpvalues,1)
2105 elseif (
present( ivalues) )
then
2106 nrow =
size(ivalues,2)
2107 ncol =
size(ivalues,1)
2109 call die(
"Internal programming error: unhandled data type", &
2116 allocate( i2tempvals(ncol, nrow))
2120 if (
present(rvalues)) rvalues =
asfloat(i2tempvals)
2121 if (
present(ivalues)) ivalues = i2tempvals
2122 if (
present(dpvalues)) dpvalues =
asdouble(i2tempvals)
2127 allocate( itempvals(ncol, nrow))
2130 if (
present(rvalues)) rvalues =
asfloat(itempvals)
2131 if (
present(ivalues)) ivalues = itempvals
2132 if (
present(dpvalues)) dpvalues =
asdouble(itempvals)
2136 allocate( rtempvals(ncol, nrow))
2139 if (
present(rvalues)) rvalues = rtempvals
2140 if (
present(ivalues)) ivalues =
asint(rtempvals)
2141 if (
present(dpvalues)) dpvalues =
asdouble(rtempvals)
2145 allocate( dptempvals(ncol, nrow))
2148 if (
present(rvalues)) rvalues =
asfloat(dptempvals)
2149 if (
present(ivalues)) ivalues =
asint(dptempvals)
2150 if (
present(dpvalues)) dpvalues = dptempvals
2154 call warn(
"Failed to find a method to retrieve data of the given type.", __file__, __line__)
2156 print *,
'var type: ',ncfile%iVarType(
nc_z)
2166 type (T_NETCDF4_FILE) :: NCFILE
2167 integer (c_short),
intent(inout) :: i2Values(:,:)
2171 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
2173 integer (c_short),
dimension(size(i2Values,2) * size(i2Values,1)) :: iTemp
2175 integer (c_int) :: iRow, iCol, iIndex
2176 integer (c_int) :: iFromRow, iToRow, iByRow
2177 integer (c_int) :: iFromCol, iToCol, iByCol
2179 ifromrow = ncfile%iRowIter(
nc_first)
2180 itorow = ncfile%iRowIter(
nc_last)
2181 ibyrow = ncfile%iRowIter(
nc_by)
2183 ifromcol = ncfile%iColIter(
nc_first)
2184 itocol = ncfile%iColIter(
nc_last)
2185 ibycol = ncfile%iColIter(
nc_by)
2189 select case (ncfile%sVariableOrder)
2194 inc_varid=ncfile%iVarID(
nc_z), &
2195 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_x), ncfile%iStart(
nc_y)], &
2196 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_x), ncfile%iCount(
nc_y)], &
2197 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_x), ncfile%iStride(
nc_y)], &
2201 do icol=ifromcol, itocol, ibycol
2202 do irow=ifromrow, itorow, ibyrow
2204 i2values(icol,irow) = itemp(iindex)
2211 inc_varid=ncfile%iVarID(
nc_z), &
2212 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_y), ncfile%iStart(
nc_x)], &
2213 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_y), ncfile%iCount(
nc_x)], &
2214 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_y), ncfile%iStride(
nc_x)], &
2218 do irow=ifromrow, itorow, ibyrow
2219 do icol=ifromcol, itocol, ibycol
2221 i2values(icol,irow) = itemp(iindex)
2227 call warn(
"INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2237 type (T_NETCDF4_FILE) :: NCFILE
2238 integer (c_int),
dimension(:,:) :: iValues
2242 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
2244 integer (c_int),
dimension(size(iValues,2) * size(iValues,1)) :: iTemp
2246 integer (c_int) :: iRow, iCol, iIndex
2247 integer (c_int) :: iFromRow, iToRow, iByRow
2248 integer (c_int) :: iFromCol, iToCol, iByCol
2250 ifromrow = ncfile%iRowIter(
nc_first)
2251 itorow = ncfile%iRowIter(
nc_last)
2252 ibyrow = ncfile%iRowIter(
nc_by)
2254 ifromcol = ncfile%iColIter(
nc_first)
2255 itocol = ncfile%iColIter(
nc_last)
2256 ibycol = ncfile%iColIter(
nc_by)
2260 select case (ncfile%sVariableOrder)
2265 inc_varid=ncfile%iVarID(
nc_z), &
2266 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_x), ncfile%iStart(
nc_y)], &
2267 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_x), ncfile%iCount(
nc_y)], &
2268 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_x), ncfile%iStride(
nc_y)], &
2272 do icol=ifromcol, itocol, ibycol
2273 do irow=ifromrow, itorow, ibyrow
2275 ivalues(icol,irow) = itemp(iindex)
2282 inc_varid=ncfile%iVarID(
nc_z), &
2283 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_y), ncfile%iStart(
nc_x)], &
2284 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_y), ncfile%iCount(
nc_x)], &
2285 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_y), ncfile%iStride(
nc_x)], &
2289 do irow=ifromrow, itorow, ibyrow
2290 do icol=ifromcol, itocol, ibycol
2292 ivalues(icol,irow) = itemp(iindex)
2298 call warn(
"INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2309 type (T_NETCDF4_FILE) :: NCFILE
2310 real (c_float),
dimension(:,:) :: rValues
2313 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
2314 real (c_float),
dimension(size(rValues,2) * size(rValues,1)) :: rTemp
2315 integer (c_int) :: iRow, iCol, iIndex
2316 integer (c_int) :: iFromRow, iToRow, iByRow
2317 integer (c_int) :: iFromCol, iToCol, iByCol
2319 ifromrow = ncfile%iRowIter(
nc_first)
2320 itorow = ncfile%iRowIter(
nc_last)
2321 ibyrow = ncfile%iRowIter(
nc_by)
2323 ifromcol = ncfile%iColIter(
nc_first)
2324 itocol = ncfile%iColIter(
nc_last)
2325 ibycol = ncfile%iColIter(
nc_by)
2329 select case (ncfile%sVariableOrder)
2334 inc_varid=ncfile%iVarID(
nc_z), &
2335 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_x), ncfile%iStart(
nc_y)], &
2336 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_x), ncfile%iCount(
nc_y)], &
2337 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_x), ncfile%iStride(
nc_y)], &
2341 do icol=ifromcol, itocol, ibycol
2342 do irow=ifromrow, itorow, ibyrow
2344 rvalues(icol,irow) = rtemp(iindex)
2351 inc_varid=ncfile%iVarID(
nc_z), &
2352 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_y), ncfile%iStart(
nc_x)], &
2353 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_y), ncfile%iCount(
nc_x)], &
2354 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_y), ncfile%iStride(
nc_x)], &
2358 do irow=ifromrow, itorow, ibyrow
2359 do icol=ifromcol, itocol, ibycol
2361 rvalues(icol,irow) = rtemp(iindex)
2367 call warn(
"INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2377 type (T_NETCDF4_FILE) :: NCFILE
2378 real (c_double),
dimension(:,:) :: dpValues
2381 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
2382 real (c_double),
dimension(size(dpValues,2) * size(dpValues,1)) :: dpTemp
2383 integer (c_int) :: iRow, iCol, iIndex
2384 integer (c_int) :: iFromRow, iToRow, iByRow
2385 integer (c_int) :: iFromCol, iToCol, iByCol
2387 ifromrow = ncfile%iRowIter(
nc_first)
2388 itorow = ncfile%iRowIter(
nc_last)
2389 ibyrow = ncfile%iRowIter(
nc_by)
2391 ifromcol = ncfile%iColIter(
nc_first)
2392 itocol = ncfile%iColIter(
nc_last)
2393 ibycol = ncfile%iColIter(
nc_by)
2397 select case (ncfile%sVariableOrder)
2402 inc_varid=ncfile%iVarID(
nc_z), &
2403 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_x), ncfile%iStart(
nc_y)], &
2404 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_x), ncfile%iCount(
nc_y)], &
2405 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_x), ncfile%iStride(
nc_y)], &
2409 do icol=ifromcol, itocol, ibycol
2410 do irow=ifromrow, itorow, ibyrow
2412 dpvalues(icol,irow) = dptemp(iindex)
2419 inc_varid=ncfile%iVarID(
nc_z), &
2420 inc_start=[ncfile%iStart(
nc_time), ncfile%iStart(
nc_y), ncfile%iStart(
nc_x)], &
2421 inc_count=[ncfile%iCount(
nc_time), ncfile%iCount(
nc_y), ncfile%iCount(
nc_x)], &
2422 inc_stride=[ncfile%iStride(
nc_time), ncfile%iStride(
nc_y), ncfile%iStride(
nc_x)], &
2426 do irow=ifromrow, itorow, ibyrow
2427 do icol=ifromcol, itocol, ibycol
2429 dpvalues(icol,irow) = dptemp(iindex)
2435 call warn(
"INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2444 iNC_Stride, iNC_Vars)
2446 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2447 integer (c_int) :: iNC_VarID
2448 integer (c_size_t) :: iNC_Start
2449 integer (c_size_t) :: iNC_Count
2450 integer (c_size_t) :: iNC_Stride
2451 integer (c_short),
dimension(:) :: iNC_Vars
2455 startp=[inc_start], &
2456 countp=[inc_count], &
2457 stridep=[inc_stride], &
2458 vars=inc_vars), __file__, __line__ )
2465 iNC_Stride, iNC_Vars)
2467 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2468 integer (c_int) :: iNC_VarID
2469 integer (c_size_t),
dimension(:) :: iNC_Start
2470 integer (c_size_t),
dimension(:) :: iNC_Count
2471 integer (c_size_t),
dimension(:) :: iNC_Stride
2472 integer (c_short),
dimension(:,:) :: iNC_Vars
2476 startp=[inc_start], &
2477 countp=[inc_count], &
2478 stridep=[inc_stride], &
2479 vars=inc_vars), __file__, __line__ )
2486 iNC_Stride, iNC_Vars)
2488 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2489 integer (c_int) :: iNC_VarID
2490 integer (c_size_t),
dimension(:) :: iNC_Start
2491 integer (c_size_t),
dimension(:) :: iNC_Count
2492 integer (c_size_t),
dimension(:) :: iNC_Stride
2493 integer (c_short),
dimension(:) :: iNC_Vars
2497 startp=[inc_start], &
2498 countp=[inc_count], &
2499 stridep=[inc_stride], &
2500 vars=inc_vars), __file__, __line__ )
2507 iNC_Stride, iNC_Vars)
2509 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2510 integer (c_int) :: iNC_VarID
2511 integer (c_size_t),
dimension(:) :: iNC_Start
2512 integer (c_size_t),
dimension(:) :: iNC_Count
2513 integer (c_size_t),
dimension(:) :: iNC_Stride
2514 integer (c_int),
dimension(:) :: iNC_Vars
2518 startp=[inc_start], &
2519 countp=[inc_count], &
2520 stridep=[inc_stride], &
2521 vars=inc_vars), __file__, __line__ )
2528 iNC_Stride, iNC_Vars)
2530 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2531 integer (c_int) :: iNC_VarID
2532 integer (c_size_t) :: iNC_Start
2533 integer (c_size_t) :: iNC_Count
2534 integer (c_size_t) :: iNC_Stride
2535 integer (c_int),
dimension(:) :: iNC_Vars
2539 startp=[inc_start], &
2540 countp=[inc_count], &
2541 stridep=[inc_stride], &
2542 vars=inc_vars), __file__, __line__ )
2549 iNC_Stride, dpNC_Vars)
2551 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2552 integer (c_int) :: iNC_VarID
2553 integer (c_size_t) :: iNC_Start
2554 integer (c_size_t) :: iNC_Count
2555 integer (c_size_t) :: iNC_Stride
2556 real (c_double),
dimension(:) :: dpNC_Vars
2560 startp=[inc_start], &
2561 countp=[inc_count], &
2562 stridep=[inc_stride], &
2563 vars=dpnc_vars), __file__, __line__ )
2570 iNC_Stride, dpNC_Vars)
2572 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2573 integer (c_int) :: iNC_VarID
2574 integer (c_size_t),
dimension(:) :: iNC_Start
2575 integer (c_size_t),
dimension(:) :: iNC_Count
2576 integer (c_size_t),
dimension(:) :: iNC_Stride
2577 real (c_double),
dimension(:,:) :: dpNC_Vars
2581 startp=[inc_start], &
2582 countp=[inc_count], &
2583 stridep=[inc_stride], &
2584 vars=dpnc_vars), __file__, __line__ )
2591 iNC_Stride, dpNC_Vars)
2593 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2594 integer (c_int) :: iNC_VarID
2595 integer (c_size_t),
dimension(:) :: iNC_Start
2596 integer (c_size_t),
dimension(:) :: iNC_Count
2597 integer (c_size_t),
dimension(:) :: iNC_Stride
2598 real (c_double),
dimension(:) :: dpNC_Vars
2602 startp=[inc_start], &
2603 countp=[inc_count], &
2604 stridep=[inc_stride], &
2605 vars=dpnc_vars), __file__, __line__ )
2612 iNC_Stride, rNC_Vars )
2614 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2615 integer (c_int) :: iNC_VarID
2616 integer (c_size_t) :: iNC_Start
2617 integer (c_size_t) :: iNC_Count
2618 integer (c_size_t) :: iNC_Stride
2619 real (c_float),
dimension(:) :: rNC_Vars
2623 startp=[inc_start], &
2624 countp=[inc_count], &
2625 stridep=[inc_stride], &
2626 vars=rnc_vars), __file__, __line__ )
2633 iNC_Stride, rNC_Vars )
2635 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2636 integer (c_int) :: iNC_VarID
2637 integer (c_size_t),
dimension(:) :: iNC_Start
2638 integer (c_size_t),
dimension(:) :: iNC_Count
2639 integer (c_size_t),
dimension(:) :: iNC_Stride
2640 real (c_float),
dimension(:,:) :: rNC_Vars
2644 startp=[inc_start], &
2645 countp=[inc_count], &
2646 stridep=[inc_stride], &
2647 vars=rnc_vars), __file__, __line__ )
2654 iNC_Stride, rNC_Vars )
2656 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2657 integer (c_int) :: iNC_VarID
2658 integer (c_size_t),
dimension(:) :: iNC_Start
2659 integer (c_size_t),
dimension(:) :: iNC_Count
2660 integer (c_size_t),
dimension(:) :: iNC_Stride
2661 real (c_float),
dimension(:) :: rNC_Vars
2665 startp=[inc_start], &
2666 countp=[inc_count], &
2667 stridep=[inc_stride], &
2668 vars=rnc_vars), __file__, __line__ )
2681 character (len=256) :: sbuf, sbuf2
2682 character (len=256) :: sdimname
2683 integer (c_int) :: idimid
2684 integer (c_int) :: iubound
2686 integer :: iindex, iindex3, iindex4
2690 write(unit=ilu, fmt=
"(a)")
"netcdf "//trim(ncfile%sFilename)//
" {"
2691 write(unit=ilu, fmt=
"(a)")
" dimensions:"
2693 do iindex = 0, ncfile%iNumberOfDimensions - 1
2694 write(unit=ilu, fmt=
"(4x,a, ' = ', i0, ';')") trim(ncfile%pNC_DIM(iindex)%sDimensionName), &
2695 ncfile%pNC_DIM(iindex)%iNC_DimSize
2698 do iindex = 0, ncfile%iNumberOfVariables - 1
2700 pnc_var => ncfile%pNC_VAR(iindex)
2702 if(pnc_var%iNumberOfDimensions > 0)
then
2706 iubound = pnc_var%iNumberOfDimensions - 1
2707 do iindex3 = 0, iubound
2709 idimid = pnc_var%iNC_DimID(iindex3)
2711 call assert(idimid >=0 .and. &
2712 idimid <= ubound( ncfile%pNC_DIM, 1 ), &
2713 "INTERNAL PROGRAMMING ERROR -- iDimID out of bounds", &
2716 pnc_dim => ncfile%pNC_DIM(idimid)
2717 sdimname = pnc_dim%sDimensionName
2719 write(sbuf2, fmt=
"(i12)") pnc_dim%iNC_DimSize
2720 sbuf = trim(sbuf)//trim(pnc_dim%sDimensionName)//
"=" &
2721 //trim(adjustl(sbuf2))
2723 if (iindex3 /= iubound) sbuf = trim(sbuf)//
", "
2727 sbuf = trim(sbuf)//
')'
2736 //
" "//trim(pnc_var%sVariableName)//sbuf//
";"
2738 write(unit=ilu, fmt=
"(2x,a)") trim(sbuf)
2740 iubound = pnc_var%iNumberOfAttributes - 1
2741 do iindex3 = 0, iubound
2743 pnc_att => ncfile%pNC_VAR(iindex)%pNC_ATT(iindex3)
2745 sbuf = trim(pnc_var%sVariableName)//
":"//trim(pnc_att%sAttributeName )//
" ="
2747 do iindex4=0, ubound(pnc_att%sAttValue, 1)
2749 sbuf = trim(sbuf)//
" "//trim(pnc_att%sAttValue(iindex4))
2755 write(unit=ilu, fmt=
"(4x,a)") trim(sbuf)
2761 do iindex = 0, ncfile%iNumberOfAttributes - 1
2763 pnc_att => ncfile%pNC_ATT(iindex)
2765 sbuf =
":"//trim(pnc_att%sAttributeName )//
" ="
2767 do iindex4=0, ubound(pnc_att%sAttValue, 1)
2769 sbuf = trim(sbuf)//
" "//trim(pnc_att%sAttValue(iindex4))
2775 write(unit=ilu, fmt=
"(a)") trim(sbuf)
2779 write(unit=ilu, fmt=
"(a,/,/)")
"}"
2789 integer (c_int) :: ivarindex
2790 real (c_double),
dimension(0:1) :: dpvalues
2794 integer (c_int) :: idimsize
2795 integer (c_size_t) :: istride
2796 integer (c_size_t) :: icount
2797 integer (c_short),
dimension(0:1) :: spvalues
2798 integer (c_int),
dimension(0:1) :: ipvalues
2799 real (c_float),
dimension(0:1) :: rpvalues
2801 call assert (ivarindex >= lbound(ncfile%pNC_VAR,1) &
2802 .and. ivarindex <= ubound(ncfile%pNC_VAR,1), &
2803 "INTERNAL PROGRAMMING ERROR - index out of bounds NC_FILE%pNC_VAR" &
2804 //
"~Offending index value: "//trim(
ascharacter(ivarindex)), &
2807 pnc_var => ncfile%pNC_VAR(ivarindex)
2810 if (idimsize > 1)
then
2812 istride = int(idimsize, c_size_t) - 1_c_size_t
2815 istride = 1_c_size_t
2818 select case (pnc_var%iNC_VarType )
2823 inc_varid=pnc_var%iNC_VarID, &
2824 inc_start=0_c_size_t, &
2826 inc_stride=istride, &
2829 dpvalues = real(spvalues, c_double)
2834 inc_varid=pnc_var%iNC_VarID, &
2835 inc_start=0_c_size_t, &
2837 inc_stride=istride, &
2840 dpvalues = real(ipvalues, c_double)
2845 inc_varid=pnc_var%iNC_VarID, &
2846 inc_start=0_c_size_t, &
2848 inc_stride=istride, &
2851 dpvalues = real(rpvalues, c_double)
2856 inc_varid=pnc_var%iNC_VarID, &
2857 inc_start=0_c_size_t, &
2859 inc_stride=istride, &
2864 call warn(
"INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2878 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2880 ncfile%iOriginJD =
julian_day(ncfile%iOriginYear, &
2881 ncfile%iOriginMonth, ncfile%iOriginDay)
2883 ncfile%iFirstDayJD = ncfile%iOriginJD + int(ncfile%dpFirstAndLastTimeValues(
nc_first), c_int)
2884 ncfile%iLastDayJD = ncfile%iOriginJD + int(ncfile%dpFirstAndLastTimeValues(
nc_last), c_int)
2892 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2895 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
2896 character (len=256) :: sDateTime
2897 character (len=256) :: sItem
2898 integer (c_int) :: iIndex
2899 logical (c_bool) :: lFound
2900 integer (c_int) :: iStat
2901 real (c_float) :: fTempVal
2903 call assert(ncfile%iVarID(
nc_time) >= 0,
"INTERNAL PROGRAMMING ERROR -- " &
2904 //
"nf_get_time_units must be called only after a call is made to ~" &
2905 //
"netcdf_get_variable_ids", __file__, __line__)
2907 pnc_var => ncfile%pNC_VAR(ncfile%iVarID(
nc_time) )
2911 do iindex=0, pnc_var%iNumberOfAttributes - 1
2913 if ( pnc_var%pNC_ATT(iindex)%sAttributeName .strequal.
"units" )
then
2920 call assert (lfound,
"Failed to find the 'units' attribute associated " &
2921 //
"with time variable "//
dquote(pnc_var%sVariableName), &
2924 sdatetime = pnc_var%pNC_ATT(iindex)%sAttValue(0)
2926 call chomp(sdatetime, sitem)
2927 call chomp(sdatetime, sitem)
2929 call chomp(sdatetime, sitem,
"/-")
2930 read(sitem, *) ncfile%iOriginYear
2932 call chomp(sdatetime, sitem,
"/-")
2933 read(sitem, *) ncfile%iOriginMonth
2938 read(sdatetime, *) ncfile%iOriginDay
2940 call chomp(sdatetime, sitem,
":")
2941 read(sitem, *, iostat=istat) ncfile%iOriginHH
2942 if (istat /=0) ncfile%iOriginHH = 0
2944 call chomp(sdatetime, sitem,
":")
2945 read(sitem, *, iostat=istat) ncfile%iOriginMM
2946 if (istat /=0) ncfile%iOriginMM = 0
2950 read(sdatetime, *, iostat=istat) ftempval
2952 ncfile%iOriginSS = int(ftempval, c_int)
2954 ncfile%iOriginSS = 0
2963 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
2966 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
2967 integer (c_int) :: iIndex, iIndex2
2968 logical (c_bool) :: lFound
2972 call assert(ncfile%iVarID(iindex) >= 0,
"INTERNAL PROGRAMMING ERROR -- " &
2973 //
"nc_get_XYZ_units must be called only after a call is made to ~" &
2974 //
"netcdf_get_variable_ids", __file__, __line__)
2976 pnc_var => ncfile%pNC_VAR(ncfile%iVarID(iindex) )
2980 do iindex2=0, pnc_var%iNumberOfAttributes - 1
2982 if ( pnc_var%pNC_ATT(iindex2)%sAttributeName .strequal.
"units" )
then
2990 ncfile%sVarUnits(iindex) = trim(pnc_var%pNC_ATT(iindex2)%sAttValue(0))
3001 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
3004 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
3005 integer (c_int) :: iIndex
3006 logical (c_bool) :: lFound
3007 character (len=32) :: sBuf
3009 pnc_var => ncfile%pNC_VAR(ncfile%iVarID(
nc_z) )
3013 do iindex=0, pnc_var%iNumberOfAttributes - 1
3015 if ( pnc_var%pNC_ATT(iindex)%sAttributeName .strequal.
"scale_factor" )
then
3023 if (
allocated( pnc_var%pNC_ATT(iindex)%i2AttValue ))
then
3024 ncfile%rScaleFactor(
nc_z) =
asfloat( pnc_var%pNC_ATT(iindex)%i2AttValue(0) )
3025 elseif (
allocated( pnc_var%pNC_ATT(iindex)%iAttValue ))
then
3026 ncfile%rScaleFactor(
nc_z) =
asfloat( pnc_var%pNC_ATT(iindex)%iAttValue(0) )
3027 elseif (
allocated( pnc_var%pNC_ATT(iindex)%rAttValue ))
then
3028 ncfile%rScaleFactor(
nc_z) = pnc_var%pNC_ATT(iindex)%rAttValue(0)
3029 elseif (
allocated( pnc_var%pNC_ATT(iindex)%dpAttValue ))
then
3030 ncfile%rScaleFactor(
nc_z) =
asfloat( pnc_var%pNC_ATT(iindex)%dpAttValue(0) )
3031 elseif (len_trim(pnc_var%pNC_ATT(iindex)%sAttValue(0)) > 0)
then
3032 sbuf = trim(pnc_var%pNC_ATT(iindex)%sAttValue(0) )
3033 read(sbuf,*) ncfile%rScaleFactor(
nc_z)
3035 call die(
"Error reading the 'scale_factor' attribute from the netCDF file" &
3036 //
dquote(ncfile%sFilename))
3043 do iindex=0, pnc_var%iNumberOfAttributes - 1
3045 if ( pnc_var%pNC_ATT(iindex)%sAttributeName .strequal.
"add_offset" )
then
3053 if (
allocated( pnc_var%pNC_ATT(iindex)%i2AttValue ))
then
3054 ncfile%rAddOffset(
nc_z) =
asfloat( pnc_var%pNC_ATT(iindex)%i2AttValue(0) )
3055 elseif (
allocated( pnc_var%pNC_ATT(iindex)%iAttValue ))
then
3056 ncfile%rAddOffset(
nc_z) =
asfloat( pnc_var%pNC_ATT(iindex)%iAttValue(0) )
3057 elseif (
allocated( pnc_var%pNC_ATT(iindex)%rAttValue ))
then
3058 ncfile%rAddOffset(
nc_z) = pnc_var%pNC_ATT(iindex)%rAttValue(0)
3059 elseif (
allocated( pnc_var%pNC_ATT(iindex)%dpAttValue ))
then
3060 ncfile%rAddOffset(
nc_z) =
asfloat( pnc_var%pNC_ATT(iindex)%dpAttValue(0) )
3061 elseif (len_trim(pnc_var%pNC_ATT(iindex)%sAttValue(0)) > 0)
then
3062 sbuf = trim(pnc_var%pNC_ATT(iindex)%sAttValue(0) )
3063 read(sbuf,*) ncfile%rAddOffset(
nc_z)
3065 call die(
"Error reading the 'add_offset' attribute from the netCDF file" &
3066 //
dquote(ncfile%sFilename))
3075 type (T_NETCDF4_FILE),
intent(inout) :: NCFILE
3076 logical (c_bool),
intent(in),
optional :: strict_asserts
3079 integer (c_int) :: iIndex
3080 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
3081 logical (c_bool) :: strict_asserts_l
3083 if (
present( strict_asserts ) )
then
3084 strict_asserts_l = strict_asserts
3086 strict_asserts_l =
true
3089 ncfile%iVarID = -9999
3091 do iindex=0, ncfile%iNumberOfVariables - 1
3093 pnc_var => ncfile%pNC_VAR(iindex)
3095 if ( pnc_var%sVariableName .strequal. ncfile%sVarName(
nc_x) )
then
3096 ncfile%iVarIndex(
nc_x) = iindex
3097 ncfile%iVarID(
nc_x) = pnc_var%iNC_VarID
3098 ncfile%iVarType(
nc_x) = pnc_var%iNC_VarType
3099 ncfile%iVar_DimID(
nc_x,:) = pnc_var%iNC_DimID
3101 elseif ( pnc_var%sVariableName .strequal. ncfile%sVarName(
nc_y) )
then
3102 ncfile%iVarIndex(
nc_y) = iindex
3103 ncfile%iVarID(
nc_y) = pnc_var%iNC_VarID
3104 ncfile%iVarType(
nc_y) = pnc_var%iNC_VarType
3105 ncfile%iVar_DimID(
nc_y,:) = pnc_var%iNC_DimID
3107 elseif ( pnc_var%sVariableName .strequal. ncfile%sVarName(
nc_z) )
then
3108 ncfile%iVarIndex(
nc_z) = iindex
3109 ncfile%iVarID(
nc_z) = pnc_var%iNC_VarID
3110 ncfile%iVarType(
nc_z) = pnc_var%iNC_VarType
3111 ncfile%iVar_DimID(
nc_z,:) = pnc_var%iNC_DimID
3113 elseif ( pnc_var%sVariableName .strequal. ncfile%sVarName(
nc_time) )
then
3114 ncfile%iVarIndex(
nc_time) = iindex
3115 ncfile%iVarID(
nc_time) = pnc_var%iNC_VarID
3116 ncfile%iVarType(
nc_time) = pnc_var%iNC_VarType
3117 ncfile%iVar_DimID(
nc_time,:) = pnc_var%iNC_DimID
3122 if ( strict_asserts_l )
then
3125 "Unable to find the variable named "//
dquote(ncfile%sVarName(
nc_x) )//
" in " &
3126 //
"file "//
dquote(ncfile%sFilename), __file__, __line__)
3129 "Unable to find the variable named "//
dquote(ncfile%sVarName(
nc_y))//
" in " &
3130 //
"file "//
dquote(ncfile%sFilename), __file__, __line__)
3133 "Unable to find the variable named "//
dquote(ncfile%sVarName(
nc_z))//
" in " &
3134 //
"file "//
dquote(ncfile%sFilename), __file__, __line__)
3136 if ( ncfile%iVarID(
nc_time) < 0 ) &
3137 call warn(
"Unable to find the variable named "//
dquote(ncfile%sVarName(
nc_time))//
" in " &
3138 //
"file "//
dquote(ncfile%sFilename) )
3148 real (c_double),
dimension(:) :: rvalues
3149 real (c_double) :: rtargetvalue
3150 real (c_double) :: roffsetvalue
3151 integer (c_int) :: iindex
3154 integer (c_int) :: icount
3155 real (c_double) :: rdiff, rdiffmin
3162 if ( .not. (rtargetvalue >= (minval(rvalues) - roffsetvalue) ) &
3163 .and. (rtargetvalue <= (maxval(rvalues) + roffsetvalue) ) )
then
3164 call logs%write(
"rTargetValue (" &
3165 //trim(
ascharacter(rtargetvalue))//
") is not within the range " &
3168 call assert(
false,
"INTERNAL PROGRAMMING ERROR", __file__, __line__)
3173 do icount=lbound(rvalues,1), ubound(rvalues,1)
3175 rdiff = abs(rvalues(icount) - rtargetvalue)
3177 if ( rdiff < rdiffmin )
then
3195 real (c_double) :: rx
3196 real (c_double) :: ry
3197 integer (c_size_t),
dimension(2) :: icolrow
3200 integer (c_int) :: icolnum, irownum
3201 real (c_double) :: x_offset
3202 real (c_double) :: y_offset
3204 x_offset = ncfile%rGridCellSizeX / 2.0_c_double + ncfile%rCoordinateTolerance
3205 y_offset = ncfile%rGridCellSizeY / 2.0_c_double + ncfile%rCoordinateTolerance
3207 call assert(
allocated( ncfile%rX_Coords ),
"Internal programming error -- attempt " &
3208 //
"to access unallocated array rX_Coords.", __file__, __line__ )
3210 if (rx < (minval(ncfile%rX_Coords) - x_offset) ) &
3211 call die(
"X coordinate value "//
ascharacter(rx)//
" is less than the minimum X coordinate " &
3212 //
"value ("//
ascharacter(minval(ncfile%rX_Coords)-x_offset)//
") contained in the netCDF file " &
3213 //
dquote(ncfile%sFilename), trim(__file__), __line__ )
3215 if (rx > (maxval(ncfile%rX_Coords) + x_offset) ) &
3216 call die(
"X coordinate value "//
ascharacter(rx)//
" is greater than the maximum X coordinate " &
3217 //
"value ("//
ascharacter(maxval(ncfile%rX_Coords)+x_offset)//
") contained in the netCDF file " &
3218 //
dquote(ncfile%sFilename), trim(__file__), __line__ )
3220 if (ry < (minval(ncfile%rY_Coords) - y_offset) ) &
3221 call die(
"Y coordinate value "//
ascharacter(ry)//
" is less than the minimum Y coordinate " &
3222 //
"value ("//
ascharacter(minval(ncfile%rY_Coords)-y_offset)//
") contained in the netCDF file " &
3223 //
dquote(ncfile%sFilename), trim(__file__), __line__ )
3225 if (ry > (maxval(ncfile%rY_Coords) + y_offset) ) &
3226 call die(
"Y coordinate value "//
ascharacter(ry)//
" is greater than the maximum Y coordinate " &
3227 //
"value ("//
ascharacter(maxval(ncfile%rY_Coords)+y_offset)//
") contained in the netCDF file " &
3228 //
dquote(ncfile%sFilename), trim(__file__), __line__ )
3233 icolrow(
column) = int(icolnum, c_size_t)
3234 icolrow(
row) = int(irownum, c_size_t)
3243 character (len=*) :: svariablename
3244 integer (c_int) :: inc_varid
3246 integer (c_int) :: iindex
3251 do iindex=0, ncfile%iNumberOfVariables - 1
3253 pnc_var => ncfile%pNC_VAR(iindex)
3255 if(trim(svariablename) .eq. trim(pnc_var%sVariableName) )
then
3270 type (T_NETCDF4_FILE ) :: NCFILE
3271 character (len=*) :: sFilename
3272 integer (c_int),
optional :: iLU
3274 logical :: old_invalid, old_div0, old_overflow
3276 ncfile%sFilename = trim(sfilename)
3281 call ieee_get_halting_mode(ieee_invalid, old_invalid)
3282 call ieee_get_halting_mode(ieee_divide_by_zero, old_div0)
3283 call ieee_get_halting_mode(ieee_overflow, old_overflow)
3286 call ieee_set_halting_mode(ieee_invalid, .
false.)
3287 call ieee_set_halting_mode(ieee_divide_by_zero, .
false.)
3288 call ieee_set_halting_mode(ieee_overflow, .
false.)
3292 ncidp=ncfile%iNCID), &
3296 call ieee_set_halting_mode(ieee_invalid, old_invalid)
3297 call ieee_set_halting_mode(ieee_divide_by_zero, old_div0)
3298 call ieee_set_halting_mode(ieee_overflow, old_overflow)
3317 if (
present(ilu) )
then
3318 call logs%write(
"Created netCDF file for output. Filename: " &
3328 type (T_NETCDF4_FILE ) :: NCFILE
3329 integer (c_int) :: iVarID
3330 integer (c_int) :: iShuffle
3331 integer (c_int) :: iDeflate
3332 integer (c_int) :: iDeflate_level
3338 deflate_level=ideflate_level), &
3347 type (T_NETCDF4_FILE ) :: NCFILE
3358 type (T_NETCDF4_FILE ) :: NCFILE
3369 type (T_NETCDF4_FILE ) :: NCFILE
3370 character (len=*) :: sDimensionName
3371 integer (c_int) :: iDimensionSize
3372 integer (c_int) :: iDimID
3374 integer (c_size_t) :: iDimSize
3376 idimsize = int(idimensionsize, c_size_t)
3379 name=trim(sdimensionname)//c_null_char, &
3390 type (T_NETCDF4_FILE ) :: NCFILE
3391 character (len=*) :: sVariableName
3392 character (len=*) :: sAttributeName
3394 integer (c_int) :: iVarID
3396 ivarid =
nf_get_varid(ncfile, svariablename//c_null_char)
3400 name=trim(sattributename)//c_null_char), &
3409 type (T_NETCDF4_FILE) :: NCFILE
3412 integer (c_int) :: iIndex
3413 type (T_NETCDF_DIMENSION),
pointer :: pNC_DIM
3415 do iindex = 0, ncfile%iNumberOfDimensions-1
3417 pnc_dim => ncfile%pNC_DIM(iindex)
3420 name=trim(pnc_dim%sDimensionName)//c_null_char, &
3421 lenv=pnc_dim%iNC_DimSize, &
3422 dimidp=pnc_dim%iNC_DimID), &
3423 __file__, __line__ )
3433 type (T_NETCDF4_FILE ) :: NCFILE
3434 integer (c_int) :: iNX
3435 integer (c_int) :: iNY
3436 logical (c_bool),
optional :: write_time_bounds
3439 integer (c_int) :: iStat
3440 logical (c_bool) :: write_time_bounds_l
3444 ncfile%iNumberOfDimensions = 3
3446 if (
present( write_time_bounds ) )
then
3448 write_time_bounds_l = write_time_bounds
3452 write_time_bounds_l =
false
3456 if ( write_time_bounds_l ) ncfile%iNumberOfDimensions = 4
3458 if (
associated(ncfile%pNC_DIM) )
deallocate(ncfile%pNC_DIM, stat=istat)
3459 call assert(istat == 0,
"Could not deallocate memory for NC_DIM member in NC_FILE defined type", &
3462 allocate(ncfile%pNC_DIM( 0 : ncfile%iNumberOfDimensions-1), stat=istat )
3463 call assert(istat == 0,
"Could not allocate memory for NC_DIM member in NC_FILE defined type", &
3467 ncfile%pNC_DIM(
nc_time)%sDimensionName =
"time"
3471 ncfile%pNC_DIM(
nc_y)%sDimensionName =
"y"
3472 ncfile%pNC_DIM(
nc_y)%iNC_DimSize = int(iny, c_size_t)
3475 ncfile%pNC_DIM(
nc_x)%sDimensionName =
"x"
3476 ncfile%pNC_DIM(
nc_x)%iNC_DimSize = int(inx, c_size_t)
3478 if ( write_time_bounds_l )
then
3480 ncfile%pNC_DIM(
nc_aux)%sDimensionName =
"nv"
3481 ncfile%pNC_DIM(
nc_aux)%iNC_DimSize = 2
3490 type (T_NETCDF4_FILE ) :: NCFILE
3491 character (len=*) :: sVarName_z
3492 logical (c_bool),
optional :: lLatLon
3493 logical (c_bool),
optional :: write_time_bounds
3496 integer (c_int) :: iStat
3497 logical (c_bool) :: lLatLon_l
3498 logical (c_bool) :: write_time_bounds_l
3500 if (
present( llatlon) )
then
3506 if (
present(write_time_bounds) )
then
3507 write_time_bounds_l = write_time_bounds
3509 write_time_bounds_l =
false
3514 ncfile%iNumberOfVariables = 5
3516 if ( llatlon_l ) ncfile%iNumberOfVariables = 7
3517 if ( write_time_bounds_l ) ncfile%iNumberOfVariables = &
3518 ncfile%iNumberOfVariables + 1
3523 if (
associated(ncfile%pNC_VAR) )
deallocate(ncfile%pNC_VAR, stat=istat)
3524 call assert(istat == 0,
"Could not deallocate memory for NC_VAR member in NC_FILE defined type", &
3527 allocate(ncfile%pNC_VAR( 0 : ncfile%iNumberOfVariables-1), stat=istat )
3528 call assert(istat == 0,
"Could not allocate memory for NC_VAR member in NC_FILE defined type", &
3531 ncfile%pNC_VAR(
nc_time)%sVariableName =
"time"
3533 ncfile%pNC_VAR(
nc_time)%iNumberOfDimensions = 1
3534 ncfile%pNC_VAR(
nc_time)%iNC_DimID(0) = ncfile%pNC_DIM(
nc_time)%iNC_DimID
3536 ncfile%pNC_VAR(
nc_y)%sVariableName =
"y"
3538 ncfile%pNC_VAR(
nc_y)%iNumberOfDimensions = 1
3539 ncfile%pNC_VAR(
nc_y)%iNC_DimID = ncfile%pNC_DIM(
nc_y)%iNC_DimID
3541 ncfile%pNC_VAR(
nc_x)%sVariableName =
"x"
3543 ncfile%pNC_VAR(
nc_x)%iNumberOfDimensions = 1
3544 ncfile%pNC_VAR(
nc_x)%iNC_DimID = ncfile%pNC_DIM(
nc_x)%iNC_DimID
3546 ncfile%pNC_VAR(
nc_crs)%sVariableName =
"crs"
3548 ncfile%pNC_VAR(
nc_crs)%iNumberOfDimensions = 0
3550 ncfile%pNC_VAR(
nc_z)%sVariableName = trim(svarname_z)
3552 ncfile%pNC_VAR(
nc_z)%iNumberOfDimensions = 3
3553 ncfile%pNC_VAR(
nc_z)%iNC_DimID = [ncfile%pNC_DIM(
nc_time)%iNC_DimID, &
3554 ncfile%pNC_DIM(
nc_y)%iNC_DimID, &
3555 ncfile%pNC_DIM(
nc_x)%iNC_DimID,0]
3557 ncfile%sVarName(
nc_z) = trim(svarname_z)
3559 if ( llatlon_l )
then
3561 ncfile%pNC_VAR(
nc_lat)%sVariableName =
"lat"
3563 ncfile%pNC_VAR(
nc_lat)%iNumberOfDimensions = 2
3564 ncfile%pNC_VAR(
nc_lat)%iNC_DimID = [ncfile%pNC_DIM(
nc_y)%iNC_DimID, &
3565 ncfile%pNC_DIM(
nc_x)%iNC_DimID,0,0]
3567 ncfile%pNC_VAR(
nc_lon)%sVariableName =
"lon"
3569 ncfile%pNC_VAR(
nc_lon)%iNumberOfDimensions = 2
3570 ncfile%pNC_VAR(
nc_lon)%iNC_DimID = [ncfile%pNC_DIM(
nc_y)%iNC_DimID, &
3571 ncfile%pNC_DIM(
nc_x)%iNC_DimID,0,0]
3574 if ( write_time_bounds_l )
then
3576 ncfile%pNC_VAR(
nc_time_bnds)%sVariableName =
"time_bnds"
3580 ncfile%pNC_DIM(
nc_aux)%iNC_DimID,0,0]
3589 history_list, sSourceFile )
3591 type (T_NETCDF4_FILE ) :: NCFILE
3592 character (len=*),
intent(in) :: sDataType
3593 character (len=*),
intent(in),
optional :: executable_name
3594 type (FSTRING_LIST_T),
intent(in),
pointer,
optional :: history_list
3595 character (len=*),
intent(in),
optional :: sSourceFile
3598 integer (c_int) :: iStat
3599 type (DATETIME_T) :: DT
3600 character (len=20) :: sDateTime
3601 character (len=:),
allocatable :: executable_name_l
3602 type (FSTRING_LIST_T),
pointer :: history_list_l
3603 integer (c_int) :: indx, jndx
3604 integer (c_int) :: records
3606 if (
present( executable_name) )
then
3607 executable_name_l = trim( executable_name )
3609 executable_name_l =
"SWB"
3612 if (
present( history_list ) )
then
3613 history_list_l => history_list
3614 ncfile%iNumberOfAttributes = 3 + history_list_l%count
3616 allocate( history_list_l )
3617 call history_list_l%append(trim(sdatetime)//
": Soil-Water-Balance model run started.")
3618 ncfile%iNumberOfAttributes = 4
3622 sdatetime = dt%prettydatetime()
3624 allocate( ncfile%pNC_ATT(0:ncfile%iNumberOfAttributes-1), stat=istat)
3625 call assert(istat == 0,
"Could not allocate memory for NC_ATT member of NC_FILE", &
3630 if (
present(ssourcefile) )
then
3632 ncfile%pNC_ATT(0)%sAttributeName =
"source"
3633 allocate(ncfile%pNC_ATT(0)%sAttValue(0:0))
3634 ncfile%pNC_ATT(0)%sAttValue(0) = trim(sdatatype)//
" data from file "//
dquote(ssourcefile)
3635 ncfile%pNC_ATT(0)%iNC_AttType =
nc_char
3636 ncfile%pNC_ATT(0)%iNC_AttSize = 1_c_size_t
3640 ncfile%pNC_ATT(0)%sAttributeName =
"source"
3641 allocate(ncfile%pNC_ATT(0)%sAttValue(0:0))
3642 ncfile%pNC_ATT(0)%sAttValue(0) = trim(sdatatype)//
" output from " &
3643 //executable_name_l//
" run " &
3644 //
"started on "//trim(sdatetime)//
"."
3645 ncfile%pNC_ATT(0)%iNC_AttType =
nc_char
3646 ncfile%pNC_ATT(0)%iNC_AttSize = 1_c_size_t
3650 ncfile%pNC_ATT(1)%sAttributeName =
"executable_version"
3651 allocate(ncfile%pNC_ATT(1)%sAttValue(0:0))
3652 ncfile%pNC_ATT(1)%sAttValue(0) =
"version "//trim(swb_version) &
3653 //
", Git branch: "//trim(git_branch_string)//
", Git commit hash string: " &
3654 //trim(git_commit_hash_string)//
", compiled on: "//trim(compile_date) &
3655 //
" "//trim(compile_time)//
"."
3656 ncfile%pNC_ATT(1)%iNC_AttType =
nc_char
3657 ncfile%pNC_ATT(1)%iNC_AttSize = 1_c_size_t
3659 ncfile%pNC_ATT(2)%sAttributeName =
"Conventions"
3660 allocate(ncfile%pNC_ATT(2)%sAttValue(0:0))
3661 ncfile%pNC_ATT(2)%sAttValue(0) =
"CF-1.6"
3662 ncfile%pNC_ATT(2)%iNC_AttType =
nc_char
3663 ncfile%pNC_ATT(2)%iNC_AttSize = 1_c_size_t
3666 records = history_list_l%count
3671 ncfile%pNC_ATT( jndx )%sAttributeName =
"history"
3672 allocate(ncfile%pNC_ATT(jndx)%sAttValue( 0:0 ) )
3673 ncfile%pNC_ATT(jndx)%iNC_AttType =
nc_char
3674 ncfile%pNC_ATT(jndx)%iNC_AttSize = int( records, c_size_t )
3675 ncfile%pNC_ATT(jndx)%sAttValue( 0 ) = trim(history_list_l%get( indx ))//c_null_char
3686 lLatLon, fValidMin, fValidMax, &
3689 type (T_NETCDF4_FILE ) :: NCFILE
3690 character (len=*) :: sOriginText
3691 character (len=*),
optional :: PROJ4_string
3692 logical (c_bool),
optional :: lLatLon
3693 real (c_float),
optional :: fValidMin
3694 real (c_float),
optional :: fValidMax
3695 logical (c_bool),
optional :: write_time_bounds
3698 integer (c_int) :: iStat
3699 integer (c_int) :: iNumAttributes
3700 type (T_NETCDF_ATTRIBUTE),
dimension(:),
pointer :: pNC_ATT
3701 logical (c_bool) :: lLatLon_l
3702 logical (c_bool) :: write_time_bounds_l
3703 type (FSTRING_LIST_T) :: attribute_name_list
3704 type (FSTRING_LIST_T) :: attribute_value_list
3705 character (len=:),
allocatable :: tempstring
3706 character (len=:),
allocatable :: value_string
3707 character (len=:),
allocatable :: value_string1
3708 character (len=:),
allocatable :: value_string2
3709 integer (c_int) :: indx
3711 if (
present( llatlon ) )
then
3717 if (
present( write_time_bounds ) )
then
3718 write_time_bounds_l = write_time_bounds
3720 write_time_bounds_l = false
3723 if (
present( proj4_string ) )
then
3724 call create_attributes_from_proj4_string( proj4_string, attribute_name_list, &
3725 attribute_value_list )
3728 inumattributes = attribute_name_list%count + 1
3730 allocate( ncfile%pNC_VAR(
nc_crs)%pNC_ATT(0:inumattributes-1), stat=istat)
3731 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3733 ncfile%pNC_VAR(
nc_crs)%iNumberOfAttributes = inumattributes
3735 pnc_att => ncfile%pNC_VAR(
nc_crs)%pNC_ATT
3739 do indx=0, inumattributes-2
3741 tempstring = attribute_name_list%get( indx + 1 )
3742 pnc_att(indx)%sAttributeName = tempstring
3744 select case ( tempstring )
3748 value_string = attribute_value_list%get( indx + 1 )
3749 ncfile%sVarUnits(
nc_x) = value_string
3750 ncfile%sVarUnits(
nc_y) = value_string
3752 allocate(pnc_att(indx)%sAttValue(0:0))
3753 pnc_att(indx)%sAttValue(0) = value_string
3754 pnc_att(indx)%iNC_AttType =
nc_char
3755 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3757 case (
"datum",
"spheroid",
"grid_mapping_name" )
3759 allocate(pnc_att(indx)%sAttValue(0:0))
3760 pnc_att(indx)%sAttValue(0) = attribute_value_list%get( indx + 1 )
3761 pnc_att(indx)%iNC_AttType =
nc_char
3762 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3764 case (
"standard_parallel" )
3766 allocate(pnc_att(indx)%dpAttValue(0:1))
3768 value_string = attribute_value_list%get( indx + 1 )
3769 value_string1 = left(value_string, substring=
",")
3770 value_string2 = right(value_string, substring=
",")
3772 call assert(len_trim(value_string1) > 0,
"standard_parallel requires valid values for '+lat_1' and '+lat_2'.", &
3773 shints=
"Are '+lat_1' or '+lat_2' missing or out of order in the control file PROJ string?")
3775 pnc_att(indx)%dpAttValue(0) = asdouble( value_string1 )
3776 pnc_att(indx)%dpAttValue(1) = asdouble( value_string2 )
3778 pnc_att(indx)%iNC_AttSize = 2_c_size_t
3782 allocate(pnc_att(indx)%iAttValue(0:0))
3783 pnc_att(indx)%iAttValue(0) = asint( attribute_value_list%get( indx + 1 ) )
3784 pnc_att(indx)%iNC_AttType =
nc_int
3785 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3789 allocate(pnc_att(indx)%dpAttValue(0:0))
3790 pnc_att(indx)%dpAttValue(0) = asdouble( attribute_value_list%get( indx + 1 ) )
3792 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3799 pnc_att(indx)%sAttributeName =
"proj4_string"
3800 allocate(pnc_att(indx)%sAttValue(0:0))
3801 pnc_att(indx)%sAttValue(0) = proj4_string
3802 pnc_att(indx)%iNC_AttType =
nc_char
3803 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3805 call attribute_name_list%clear()
3806 call attribute_value_list%clear()
3812 if ( write_time_bounds_l ) inumattributes=4
3813 allocate( ncfile%pNC_VAR(
nc_time)%pNC_ATT(0:inumattributes-1), stat=istat)
3814 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3816 ncfile%pNC_VAR(
nc_time)%iNumberOfAttributes = inumattributes
3818 pnc_att => ncfile%pNC_VAR(
nc_time)%pNC_ATT
3820 pnc_att(0)%sAttributeName =
"units"
3821 allocate(pnc_att(0)%sAttValue(0:0))
3822 pnc_att(0)%sAttValue(0) =
"days since "//trim(sorigintext)//
" 00:00:00"
3823 pnc_att(0)%iNC_AttType =
nc_char
3824 pnc_att(0)%iNC_AttSize = 1_c_size_t
3826 pnc_att(1)%sAttributeName =
"calendar"
3827 allocate(pnc_att(1)%sAttValue(0:0))
3828 pnc_att(1)%sAttValue(0) =
"standard"
3829 pnc_att(1)%iNC_AttType =
nc_char
3830 pnc_att(1)%iNC_AttSize = 1_c_size_t
3832 pnc_att(2)%sAttributeName =
"long_name"
3833 allocate(pnc_att(2)%sAttValue(0:0))
3834 pnc_att(2)%sAttValue(0) =
"time"
3835 pnc_att(2)%iNC_AttType =
nc_char
3836 pnc_att(2)%iNC_AttSize = 1_c_size_t
3838 if ( write_time_bounds_l )
then
3839 pnc_att(3)%sAttributeName =
"bounds"
3840 allocate(pnc_att(3)%sAttValue(0:0))
3841 pnc_att(3)%sAttValue(0) =
"time_bounds"
3842 pnc_att(3)%iNC_AttType =
nc_char
3843 pnc_att(3)%iNC_AttSize = 1_c_size_t
3846 if (
present( fvalidmin ) .and.
present( fvalidmax) )
then
3849 allocate( ncfile%pNC_VAR(
nc_z)%pNC_ATT(0:inumattributes-1), stat=istat)
3850 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3852 ncfile%pNC_VAR(
nc_z)%iNumberOfAttributes = inumattributes
3854 pnc_att => ncfile%pNC_VAR(
nc_z)%pNC_ATT
3856 pnc_att(0)%sAttributeName =
"units"
3857 allocate(pnc_att(0)%sAttValue(0:0))
3858 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(
nc_z)
3859 pnc_att(0)%iNC_AttType =
nc_char
3860 pnc_att(0)%iNC_AttSize = 1_c_size_t
3862 pnc_att(1)%sAttributeName =
"valid_min"
3863 allocate(pnc_att(1)%rAttValue(0:0))
3864 pnc_att(1)%rAttValue(0) = fvalidmin
3866 pnc_att(1)%iNC_AttSize = 1_c_size_t
3868 pnc_att(2)%sAttributeName =
"valid_max"
3869 allocate(pnc_att(2)%rAttValue(0:0))
3870 pnc_att(2)%rAttValue(0) = fvalidmax
3872 pnc_att(2)%iNC_AttSize = 1_c_size_t
3874 pnc_att(3)%sAttributeName =
"valid_range"
3875 allocate(pnc_att(3)%rAttValue(0:1))
3876 pnc_att(3)%rAttValue(0) = fvalidmin
3877 pnc_att(3)%rAttValue(1) = fvalidmax
3879 pnc_att(3)%iNC_AttSize = 2_c_size_t
3881 pnc_att(4)%sAttributeName =
"_FillValue"
3882 allocate(pnc_att(4)%rAttValue(0:0))
3885 pnc_att(4)%iNC_AttSize = 1_c_size_t
3887 pnc_att(5)%sAttributeName =
"coordinates"
3888 allocate(pnc_att(5)%sAttValue(0:0))
3890 pnc_att(5)%sAttValue(0) =
"crs"
3891 pnc_att(5)%iNC_AttType =
nc_char
3892 pnc_att(5)%iNC_AttSize = 1_c_size_t
3894 pnc_att(6)%sAttributeName =
"grid_mapping"
3895 allocate(pnc_att(6)%sAttValue(0:0))
3896 pnc_att(6)%sAttValue(0) =
"crs"
3897 pnc_att(6)%iNC_AttType =
nc_char
3898 pnc_att(6)%iNC_AttSize = 1_c_size_t
3903 allocate( ncfile%pNC_VAR(
nc_z)%pNC_ATT(0:inumattributes-1), stat=istat)
3904 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3906 ncfile%pNC_VAR(
nc_z)%iNumberOfAttributes = inumattributes
3908 pnc_att => ncfile%pNC_VAR(
nc_z)%pNC_ATT
3910 pnc_att(0)%sAttributeName =
"units"
3911 allocate(pnc_att(0)%sAttValue(0:0))
3912 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(
nc_z)
3913 pnc_att(0)%iNC_AttType =
nc_char
3914 pnc_att(0)%iNC_AttSize = 1_c_size_t
3916 pnc_att(1)%sAttributeName =
"coordinates"
3917 allocate(pnc_att(1)%sAttValue(0:0))
3918 pnc_att(1)%sAttValue(0) =
"lat lon"
3919 pnc_att(1)%iNC_AttType =
nc_char
3920 pnc_att(1)%iNC_AttSize = 1_c_size_t
3922 pnc_att(2)%sAttributeName =
"grid_mapping"
3923 allocate(pnc_att(2)%sAttValue(0:0))
3924 pnc_att(2)%sAttValue(0) =
"crs"
3925 pnc_att(2)%iNC_AttType =
nc_char
3926 pnc_att(2)%iNC_AttSize = 1_c_size_t
3931 allocate( ncfile%pNC_VAR(
nc_y)%pNC_ATT(0:inumattributes-1), stat=istat)
3932 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3934 ncfile%pNC_VAR(
nc_y)%iNumberOfAttributes = inumattributes
3936 pnc_att => ncfile%pNC_VAR(
nc_y)%pNC_ATT
3940 pnc_att(0)%sAttributeName =
"units"
3941 allocate(pnc_att(0)%sAttValue(0:0))
3942 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(
nc_y)
3943 pnc_att(0)%iNC_AttType =
nc_char
3944 pnc_att(0)%iNC_AttSize = 1_c_size_t
3946 pnc_att(1)%sAttributeName =
"long_name"
3947 allocate(pnc_att(1)%sAttValue(0:0))
3948 pnc_att(1)%sAttValue(0) =
"y coordinate of projection"
3949 pnc_att(1)%iNC_AttType =
nc_char
3950 pnc_att(1)%iNC_AttSize = 1_c_size_t
3952 pnc_att(2)%sAttributeName =
"standard_name"
3953 allocate(pnc_att(2)%sAttValue(0:0))
3954 pnc_att(2)%sAttValue(0) =
"projection_y_coordinate"
3955 pnc_att(2)%iNC_AttType =
nc_char
3956 pnc_att(2)%iNC_AttSize = 1_c_size_t
3962 allocate( ncfile%pNC_VAR(
nc_x)%pNC_ATT(0:inumattributes-1), stat=istat)
3963 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3965 ncfile%pNC_VAR(
nc_x)%iNumberOfAttributes = inumattributes
3967 pnc_att => ncfile%pNC_VAR(
nc_x)%pNC_ATT
3971 pnc_att(0)%sAttributeName =
"units"
3972 allocate(pnc_att(0)%sAttValue(0:0))
3973 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(
nc_x)
3974 pnc_att(0)%iNC_AttType =
nc_char
3975 pnc_att(0)%iNC_AttSize = 1_c_size_t
3977 pnc_att(1)%sAttributeName =
"long_name"
3978 allocate(pnc_att(1)%sAttValue(0:0))
3979 pnc_att(1)%sAttValue(0) =
"x coordinate of projection"
3980 pnc_att(1)%iNC_AttType =
nc_char
3981 pnc_att(1)%iNC_AttSize = 1_c_size_t
3983 pnc_att(2)%sAttributeName =
"standard_name"
3984 allocate(pnc_att(2)%sAttValue(0:0))
3985 pnc_att(2)%sAttValue(0) =
"projection_x_coordinate"
3986 pnc_att(2)%iNC_AttType =
nc_char
3987 pnc_att(2)%iNC_AttSize = 1_c_size_t
3992 if ( llatlon_l )
then
3995 allocate( ncfile%pNC_VAR(
nc_lat)%pNC_ATT(0:inumattributes-1), stat=istat)
3996 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3998 ncfile%pNC_VAR(
nc_lat)%iNumberOfAttributes = inumattributes
4000 pnc_att => ncfile%pNC_VAR(
nc_lat)%pNC_ATT
4004 pnc_att(0)%sAttributeName =
"units"
4005 allocate(pnc_att(0)%sAttValue(0:0))
4006 pnc_att(0)%sAttValue(0) =
"degrees_north"
4007 pnc_att(0)%iNC_AttType =
nc_char
4008 pnc_att(0)%iNC_AttSize = 1_c_size_t
4010 pnc_att(1)%sAttributeName =
"long_name"
4011 allocate(pnc_att(1)%sAttValue(0:0))
4012 pnc_att(1)%sAttValue(0) =
"latitude"
4013 pnc_att(1)%iNC_AttType =
nc_char
4014 pnc_att(1)%iNC_AttSize = 1_c_size_t
4016 pnc_att(2)%sAttributeName =
"standard_name"
4017 allocate(pnc_att(2)%sAttValue(0:0))
4018 pnc_att(2)%sAttValue(0) =
"latitude"
4019 pnc_att(2)%iNC_AttType =
nc_char
4020 pnc_att(2)%iNC_AttSize = 1_c_size_t
4027 allocate( ncfile%pNC_VAR(
nc_lon)%pNC_ATT(0:inumattributes-1), stat=istat)
4028 call assert(istat == 0,
"Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
4030 ncfile%pNC_VAR(
nc_lon)%iNumberOfAttributes = inumattributes
4032 pnc_att => ncfile%pNC_VAR(
nc_lon)%pNC_ATT
4036 pnc_att(0)%sAttributeName =
"units"
4037 allocate(pnc_att(0)%sAttValue(0:0))
4038 pnc_att(0)%sAttValue(0) =
"degrees_east"
4039 pnc_att(0)%iNC_AttType =
nc_char
4040 pnc_att(0)%iNC_AttSize = 1_c_size_t
4042 pnc_att(1)%sAttributeName =
"long_name"
4043 allocate(pnc_att(1)%sAttValue(0:0))
4044 pnc_att(1)%sAttValue(0) =
"longitude"
4045 pnc_att(1)%iNC_AttType =
nc_char
4046 pnc_att(1)%iNC_AttSize = 1_c_size_t
4048 pnc_att(2)%sAttributeName =
"standard_name"
4049 allocate(pnc_att(2)%sAttValue(0:0))
4050 pnc_att(2)%sAttValue(0) =
"longitude"
4051 pnc_att(2)%iNC_AttType =
nc_char
4052 pnc_att(2)%iNC_AttSize = 1_c_size_t
4065 type (T_NETCDF4_FILE) :: NCFILE
4066 real (c_double),
dimension(:) :: dpX
4067 real (c_double),
dimension(:) :: dpY
4070 integer (c_size_t) :: iLength
4072 ilength = int(
size(dpx, 1), c_size_t)
4075 ivarid=ncfile%pNC_VAR(
nc_x)%iNC_VarID, &
4076 istart=[0_c_size_t], &
4078 istride=[1_c_size_t], &
4081 ilength = int(
size(dpy, 1), c_size_t)
4084 ivarid=ncfile%pNC_VAR(
nc_y)%iNC_VarID, &
4085 istart=[0_c_size_t], &
4087 istride=[1_c_size_t], &
4096 type (T_NETCDF4_FILE) :: NCFILE
4097 real (c_double),
dimension(:,:) :: dpLat
4098 real (c_double),
dimension(:,:) :: dpLon
4101 integer (c_size_t) :: iNX, iNY
4103 inx = int(
size(dplat, 1), c_size_t)
4104 iny = int(
size(dplat, 2), c_size_t)
4107 ivarid=ncfile%pNC_VAR(
nc_lat)%iNC_VarID, &
4108 istart=[0_c_size_t, 0_c_size_t], &
4109 icount=[ iny, inx ], &
4110 istride=[1_c_size_t,1_c_size_t], &
4115 ivarid=ncfile%pNC_VAR(
nc_lon)%iNC_VarID, &
4116 istart=[0_c_size_t, 0_c_size_t], &
4117 icount=[ iny, inx ],&
4118 istride=[1_c_size_t,1_c_size_t], &
4126 iNumberOfDimensions, iDimIDs)
result(iVarID)
4129 character (len=*) :: svariablename
4130 integer (c_int) :: ivariabletype
4131 integer (c_int) :: inumberofdimensions
4132 integer (c_int),
dimension(:) :: idimids
4133 integer (c_int) :: ivarid
4135 call nf_trap( nc_def_var(ncid=ncfile%iNCID,&
4136 name=trim(fortran_to_c_string(svariablename)), &
4137 xtype=ivariabletype, &
4138 ndims=inumberofdimensions, &
4151 type (T_NETCDF4_FILE) :: NCFILE
4154 integer (c_int) :: iIndex
4155 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
4160 do iindex = 0, ncfile%iNumberOfVariables-1
4162 pnc_var => ncfile%pNC_VAR(iindex)
4164 call nf_trap( nc_def_var(ncid=ncfile%iNCID,&
4165 name=trim(fortran_to_c_string(pnc_var%sVariableName)), &
4166 xtype=pnc_var%iNC_VarType, &
4167 ndims=pnc_var%iNumberOfDimensions, &
4168 dimidsp=pnc_var%iNC_DimID, &
4169 varidp=pnc_var%iNC_VarID), &
4179 sAttributeValue, iAttributeValue, rAttributeValue, dpAttributeValue)
4182 character (len=*) :: svariablename
4183 character (len=*) :: sattributename
4184 character (len=*),
dimension(:),
optional :: sattributevalue
4185 integer (c_int),
dimension(:),
optional :: iattributevalue
4186 real (c_float),
dimension(:),
optional :: rattributevalue
4187 real (c_double),
dimension(:),
optional :: dpattributevalue
4189 integer (c_int) :: ivarid
4196 if (
present(sattributevalue)) &
4197 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, sattributevalue )
4199 if (
present(iattributevalue)) &
4200 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, iattributevalue=iattributevalue )
4202 if (
present(rattributevalue)) &
4203 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, rattributevalue=rattributevalue )
4205 if (
present(dpattributevalue)) &
4206 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, dpattributevalue=dpattributevalue )
4213 sAttributeValue, iAttributeValue, rAttributeValue, dpAttributeValue)
4215 type (T_NETCDF4_FILE ) :: NCFILE
4216 integer (c_int) :: iVarID
4217 character (len=*) :: sAttributeName
4218 character (len=*),
dimension(:),
optional :: sAttributeValue
4219 integer (c_int),
dimension(:),
optional :: iAttributeValue
4220 real (c_float),
dimension(:),
optional :: rAttributeValue
4221 real (c_double),
dimension(:),
optional :: dpAttributeValue
4224 integer (c_size_t) :: iNumberOfAttributes
4226 if (
present(sattributevalue) )
then
4228 inumberofattributes = int(
size( sattributevalue, 1), c_size_t)
4229 inumberofattributes = int(len_trim(sattributevalue(1)), c_size_t)
4231 call nf_trap( nc_put_att_text(ncid=ncfile%iNCID, &
4233 name=trim(sattributename), &
4234 nlen=inumberofattributes, &
4235 tp=trim(sattributevalue(1))), &
4238 elseif (
present(iattributevalue) )
then
4240 inumberofattributes = int(
size( iattributevalue, 1), c_size_t)
4242 call nf_trap( nc_put_att_int(ncid=ncfile%iNCID, &
4244 name=trim(sattributename), &
4246 nlen=inumberofattributes, &
4247 ip=iattributevalue), &
4250 elseif (
present(rattributevalue) )
then
4252 inumberofattributes = int(
size( rattributevalue, 1), c_size_t)
4254 call nf_trap( nc_put_att_float(ncid=ncfile%iNCID, &
4256 name=trim(sattributename), &
4258 nlen=inumberofattributes, &
4259 fp=rattributevalue), &
4262 elseif (
present(dpattributevalue) )
then
4264 inumberofattributes = int(
size( dpattributevalue, 1), c_size_t)
4266 call nf_trap( nc_put_att_double(ncid=ncfile%iNCID, &
4268 name=trim(sattributename), &
4270 nlen=inumberofattributes, &
4271 dp=dpattributevalue), &
4283 type (T_NETCDF4_FILE ) :: NCFILE
4286 type (T_NETCDF_VARIABLE),
pointer :: pNC_VAR
4287 type (T_NETCDF_ATTRIBUTE),
pointer :: pNC_ATT
4288 integer (c_int) :: iIndex
4289 integer (c_int) :: iIndex2
4290 integer (c_int) :: indx
4293 do iindex = 0, ncfile%iNumberOfVariables-1
4295 pnc_var => ncfile%pNC_VAR(iindex)
4298 do iindex2 = 0, pnc_var%iNumberOfAttributes-1
4300 pnc_att => pnc_var%pNC_ATT(iindex2)
4302 select case (pnc_att%iNC_AttType)
4306 if (.not.
allocated(pnc_att%dpAttValue) ) &
4307 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4308 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4312 ivarid=pnc_var%iNC_VarID, &
4313 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4314 dpattributevalue=pnc_att%dpAttValue)
4318 if (.not.
allocated(pnc_att%iAttValue) ) &
4319 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4320 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4324 ivarid=pnc_var%iNC_VarID, &
4325 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4326 iattributevalue=pnc_att%iAttValue)
4330 if (.not.
allocated(pnc_att%rAttValue) ) &
4331 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4332 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4336 ivarid=pnc_var%iNC_VarID, &
4337 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4338 rattributevalue=pnc_att%rAttValue)
4342 if (.not.
allocated(pnc_att%sAttValue) ) &
4343 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4344 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4347 do indx=0,ubound(pnc_att%sAttValue, 1)
4350 ivarid=pnc_var%iNC_VarID, &
4351 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4352 sattributevalue=[trim(pnc_att%sAttValue(indx))//c_null_char])
4363 do iindex2 = 0, ncfile%iNumberOfAttributes-1
4365 pnc_att => ncfile%pNC_ATT(iindex2)
4367 select case (pnc_att%iNC_AttType)
4371 if (.not.
allocated(pnc_att%sAttValue) ) &
4372 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4373 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4378 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4379 dpattributevalue=pnc_att%dpAttValue)
4383 if (.not.
allocated(pnc_att%sAttValue) ) &
4384 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4385 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4390 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4391 iattributevalue=pnc_att%iAttValue)
4395 if (.not.
allocated(pnc_att%sAttValue) ) &
4396 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4397 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4402 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4403 rattributevalue=pnc_att%rAttValue)
4407 if (.not.
allocated(pnc_att%sAttValue) ) &
4408 call die(
"INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4409 //
"attribute name: "//dquote(pnc_att%sAttributeName), &
4412 do indx=0, ubound(pnc_att%sAttValue, 1)
4416 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4417 sattributevalue=[trim(pnc_att%sAttValue(indx))//c_null_char])
4430 iValues, i2Values, rValues, dpValues)
4433 integer (c_int) :: ivarid
4434 integer (c_size_t),
dimension(:) :: istart
4435 integer (c_size_t),
dimension(:) :: icount
4436 integer (c_size_t),
dimension(:) :: istride
4437 integer (c_int),
dimension(:,:),
optional :: ivalues
4438 integer (c_short),
dimension(:,:),
optional :: i2values
4439 real (c_float),
dimension(:,:),
optional :: rvalues
4440 real (c_double),
dimension(:,:),
optional :: dpvalues
4442 if (
present(ivalues) )
then
4444 call nf_trap(nc_put_vars_int(ncid=ncfile%iNCID, &
4452 elseif (
present(i2values) )
then
4454 call nf_trap(nc_put_vars_short(ncid=ncfile%iNCID, &
4462 elseif (
present(rvalues) )
then
4464 call nf_trap(nc_put_vars_float(ncid=ncfile%iNCID, &
4472 elseif (
present(dpvalues) )
then
4476 call nf_trap(nc_put_vars_double(ncid=ncfile%iNCID, &
4489 lMask, iValues, iField, i2Values, i2Field, rValues, rField, dpValues, dpField)
4492 integer (c_int) :: ivarid
4493 integer (c_size_t),
dimension(:) :: istart
4494 integer (c_size_t),
dimension(:) :: icount
4495 integer (c_size_t),
dimension(:) :: istride
4496 logical (c_bool),
dimension(:,:) :: lmask
4497 integer (c_int),
dimension(:),
optional :: ivalues
4498 integer (c_int),
dimension(:,:),
optional :: ifield
4499 integer (c_short),
dimension(:),
optional :: i2values
4500 integer (c_short),
dimension(:,:),
optional :: i2field
4501 real (c_float),
dimension(:),
optional :: rvalues
4502 real (c_float),
dimension(:,:),
optional :: rfield
4503 real (c_double),
dimension(:),
optional :: dpvalues
4504 real (c_double),
dimension(:,:),
optional :: dpfield
4506 if (
present(ivalues) )
then
4508 call nf_trap(nc_put_vars_int(ncid=ncfile%iNCID, &
4513 vars=unpack(ivalues, lmask, ifield)), &
4516 elseif (
present(i2values) )
then
4518 call nf_trap(nc_put_vars_short(ncid=ncfile%iNCID, &
4523 vars=unpack(i2values, lmask, i2field)), &
4526 elseif (
present(rvalues) )
then
4528 call nf_trap(nc_put_vars_float(ncid=ncfile%iNCID, &
4533 vars=unpack(rvalues, lmask, rfield)), &
4536 elseif (
present(dpvalues) )
then
4538 call nf_trap(nc_put_vars_double(ncid=ncfile%iNCID, &
4543 vars=unpack(dpvalues, lmask, dpfield)), &
4552 iValues, i2Values, rValues, dpValues)
4555 integer (c_int) :: ivarid
4556 integer (c_size_t),
dimension(:) :: istart
4557 integer (c_size_t),
dimension(:) :: icount
4558 integer (c_size_t),
dimension(:) :: istride
4559 integer (c_int),
dimension(:),
optional :: ivalues
4560 integer (c_short),
dimension(:),
optional :: i2values
4561 real (c_float),
dimension(:),
optional :: rvalues
4562 real (c_double),
dimension(:),
optional :: dpvalues
4564 if (
present(ivalues) )
then
4566 call nf_trap(nc_put_vars_int(ncid=ncfile%iNCID, &
4574 elseif (
present(i2values) )
then
4576 call nf_trap(nc_put_vars_short(ncid=ncfile%iNCID, &
4584 elseif (
present(rvalues) )
then
4586 call nf_trap(nc_put_vars_float(ncid=ncfile%iNCID, &
4594 elseif (
present(dpvalues) )
then
4596 call nf_trap(nc_put_vars_double(ncid=ncfile%iNCID, &
4602 __file__, __line__, ncfile%sFilename )
This module contains physical constants and convenience functions aimed at performing unit conversion...
logical(c_bool), parameter, public true
character(len=:), allocatable, public output_prefix_name
logical(c_bool), parameter, public false
character(len=:), allocatable, public output_directory_name
elemental character(len=len(ccharacterstring) - 1) function, public c_to_fortran_string(ccharacterstring)
character(len=256) function, public char_ptr_to_fortran_string(cpcharacterptr)
integer(c_int), parameter, public ibigval
This module contains the DATETIME_T class and associated time and date-related routines,...
integer(c_int) function, public julian_day(iyear, imonth, iday, iorigin, sinputitemname)
subroutine, public warn(smessage, smodule, iline, shints, lfatal, iloglevel, lecho)
subroutine, public die(smessage, smodule, iline, shints, scalledby, icalledbyline)
Provides support for input and output of gridded ASCII data, as well as for creation and destruction ...
real(c_float), parameter nc_fill_float
integer(c_int), parameter, private row
integer(c_int), parameter, private column
integer(c_int), parameter nc_fill_int
real(c_double), parameter nc_fill_double
type(logfile_t), public logs
Provide support for use of netCDF files as input for time-varying, gridded meteorlogic data,...
integer(c_int), parameter nc_64bit_offset
subroutine, public netcdf_set_coordinate_tolerance(ncfile, tolerance)
integer(c_int), parameter nc_netcdf4
integer(c_int), parameter nc_short
integer(c_int) function nf_get_varid(ncfile, svariablename)
integer(c_int), parameter, public nc_bottom
integer(c_int), parameter, public nc_y
subroutine nf_get_variable_array_as_vector_float(ncfile, inc_varid, inc_start, inc_count, inc_stride, rnc_vars)
subroutine nf_define_dimension(ncfile, sdimensionname, idimensionsize)
integer(c_int), parameter nc_string
integer(c_int) function nf_return_index_double(rvalues, rtargetvalue, roffsetvalue)
subroutine, public netcdf_nullify_data_struct(ncfile)
integer(c_int), parameter nc_int64
subroutine nf_populate_dimension_struct(ncfile)
integer(c_int), parameter, public nc_x
integer(c_int) function nf_julian_day_to_index(ncfile, rjulianday)
We need two functions to convert from index to timeval, and timeval to JD; note that timeval refers t...
integer(c_int), parameter nc_max_attrs
integer(c_int), parameter, public nc_crs
integer(c_int), parameter nc_fill_short
subroutine, public netcdf_open_and_prepare_as_output(ncfile, svariablename, svariableunits, inx, iny, fx, fy, startdate, enddate, proj4_string, history_list, executable_name, dplat, dplon, fvalidmin, fvalidmax, write_time_bounds, filename_prefix, filename_modifier)
integer(c_int), parameter nc_max_dims
subroutine, public netcdf_dump_cdl(ncfile, ilu)
integer(c_int) function nf_return_varindex(ncfile, ivarid)
subroutine nf_get_variable_slice_double(ncfile, dpvalues)
subroutine nf_guess_z_variable_name(ncfile)
integer(c_int), parameter, public nc_top
integer(c_int), parameter nc_ushort
integer(c_int), parameter nc_shuffle_no
integer(c_int), parameter nc_char
integer(c_int), parameter, public nc_right
integer(c_int), parameter nc_format_64bit
integer(c_int), parameter nc_max_name
integer(c_int), parameter nc_first
integer(c_int), parameter nc_lock
subroutine nf_get_variable_slice_short(ncfile, i2values)
integer(c_int), parameter nc_fill_byte
character(len=6), dimension(0:6), parameter netcdf_data_type
integer(c_int), public nc_readwrite
integer(c_int), parameter nc_byte
subroutine nf_get_variable_vector_float(ncfile, inc_varid, inc_start, inc_count, inc_stride, rnc_vars)
integer(c_int), parameter year_is_360_days
subroutine nf_get_variable_id_and_type(ncfile, strict_asserts)
subroutine nf_put_x_and_y(ncfile, dpx, dpy)
integer(c_int), parameter nc_int
integer(c_int), parameter nc_fill_char
subroutine nf_get_variable_array_double(ncfile, inc_varid, inc_start, inc_count, inc_stride, dpnc_vars)
real(c_double) function nf_index_to_dayvalue(ncfile, iindex)
subroutine, public netcdf_put_packed_variable_array(ncfile, ivarid, istart, icount, istride, lmask, ivalues, ifield, i2values, i2field, rvalues, rfield, dpvalues, dpfield)
subroutine, public netcdf_get_variable_slice(ncfile, rvalues, dpvalues, ivalues)
subroutine, public netcdf_close_file(ncfile)
integer(c_int), parameter nc_deflate_yes
integer(c_size_t) function nf_return_dimsize(ncfile, idimid)
subroutine nf_define_dimensions(ncfile)
subroutine nf_set_standard_attributes(ncfile, sorigintext, proj4_string, llatlon, fvalidmin, fvalidmax, write_time_bounds)
integer(c_int), parameter nc_double
subroutine nf_get_variable_array_as_vector_short(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int), parameter nc_max_vars
subroutine, public netcdf_get_attribute_list_for_variable(ncfile, variable_name, attribute_name_list, attribute_value_list)
integer(c_int), parameter nc_sizehint_default
subroutine nf_set_iteration_bounds(ncfile)
integer(c_int), parameter, public nc_time
@TODO: implement a more flexible way of tracking variable IDs; presently the code can break if lat an...
subroutine, public netcdf_open_and_prepare_for_merging(ncfile, sfilename, guess_z_var_name)
subroutine nf_calculate_time_range(ncfile)
subroutine, public netcdf_open_file(ncfile, sfilename, ilu)
integer(c_int), parameter, public nc_lon
integer(c_int), parameter nc_share
subroutine, public netcdf_open_and_prepare_as_input(ncfile, sfilename, lfliphorizontal, lflipvertical, lallowautomaticdataflipping, rx_coord_addoffset, ry_coord_addoffset, svariableorder, svarname_x, svarname_y, svarname_z, svarname_time, rcoordinatetolerance, tgridbounds, ilu)
real(c_float), parameter, public nc_fill_float
subroutine nf_put_attribute(ncfile, ivarid, sattributename, sattributevalue, iattributevalue, rattributevalue, dpattributevalue)
subroutine nf_get_scale_and_offset(ncfile)
character(len=25), dimension(4), parameter netcdf_format_string
subroutine nf_get_time_units(ncfile)
character(len=256) function nf_return_attvalue(ncfile, ivarindex, sattname)
integer(c_int), parameter nc_long
real(c_double) function nf_dayvalue_to_julian_day(ncfile, rdayvalue)
integer(c_int), parameter nc_nowrite
integer(c_int), parameter nc_shuffle_yes
integer(c_int), parameter nc_format_netcdf4
subroutine nf_redef(ncfile)
integer(c_int) function nf_define_variable(ncfile, svariablename, ivariabletype, inumberofdimensions, idimids)
subroutine nf_trap(iresultcode, sfilename, ilinenumber, netcdf_filename)
integer(c_int), parameter nc_classic_model
subroutine nf_enddef(ncfile)
subroutine nf_get_time_vals(ncfile)
subroutine nf_set_start_count_stride(ncfile)
integer(c_int), parameter nc_uint
logical(c_bool) function, public netcdf_date_within_range(ncfile, ijulianday)
integer(c_int), parameter, public nc_aux
subroutine nf_populate_variable_struct(ncfile)
subroutine nf_set_z_variable_name(ncfile, svarname_z)
integer(c_int), parameter nc_format_classic
integer(c_int) function nf_return_dimindex(ncfile, idimid)
integer(c_int), parameter nc_nat
integer(c_int), parameter nc_ubyte
subroutine nf_get_variable_vector_double(ncfile, inc_varid, inc_start, inc_count, inc_stride, dpnc_vars)
integer(c_int), parameter nc_unlimited
subroutine nf_get_variable_slice_int(ncfile, ivalues)
subroutine nf_set_standard_variables(ncfile, svarname_z, llatlon, write_time_bounds)
real(c_double) function, dimension(0:1) nf_get_first_and_last(ncfile, ivarindex)
subroutine nf_get_variable_vector_short(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int), parameter nc_write
integer(c_int), parameter nc_deflate_no
subroutine nf_get_xyz_units(ncfile)
subroutine nf_put_attributes(ncfile)
subroutine nf_delete_attribute(ncfile, svariablename, sattributename)
subroutine nf_get_variable_slice_float(ncfile, rvalues)
subroutine nf_populate_attribute_struct(ncfile, pnc_att, inc_varid, iattnum)
integer(c_int) function nf_return_varid(ncfile, ivarindex)
integer(c_int), parameter, public nc_lat
subroutine nf_set_global_attributes(ncfile, sdatatype, executable_name, history_list, ssourcefile)
subroutine nf_define_deflate(ncfile, ivarid, ishuffle, ideflate, ideflate_level)
subroutine nf_set_standard_dimensions(ncfile, inx, iny, write_time_bounds)
integer(c_int), parameter nc_global
integer(c_int), public nc_time_bnds
subroutine nf_define_variables(ncfile)
integer(c_int), parameter nc_fill
subroutine nf_open_file(ncfile, sfilename, ilu)
integer(c_int), parameter, public nc_left
subroutine, public netcdf_put_variable_array(ncfile, ivarid, istart, icount, istride, ivalues, i2values, rvalues, dpvalues)
subroutine nf_get_variable_array_as_vector_int(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
subroutine, public netcdf_put_variable_vector(ncfile, ivarid, istart, icount, istride, ivalues, i2values, rvalues, dpvalues)
subroutine nf_get_variable_vector_int(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int) function nf_return_dimid(ncfile, idimindex)
subroutine, public netcdf_open_and_prepare_as_output_archive(ncfile, ncfile_archive, ioriginmonth, ioriginday, ioriginyear, istartyear, iendyear)
integer(c_int), public nc_readonly
subroutine nf_create(ncfile, sfilename, ilu)
integer(c_int), parameter nc_clobber
subroutine nf_get_variable_array_as_vector_double(ncfile, inc_varid, inc_start, inc_count, inc_stride, dpnc_vars)
subroutine, public netcdf_get_variable_list(ncfile, variable_list)
integer(c_int), parameter nc_noclobber
subroutine nf_get_x_and_y(ncfile)
logical(c_bool) function, public netcdf_update_time_starting_index(ncfile, ijulianday)
integer(c_size_t) function, dimension(2), public netcdf_coord_to_col_row(ncfile, rx, ry)
integer(c_int), parameter, public nc_z
integer(c_int), parameter nc_align_chunk
integer(c_int), parameter nc_last
integer(c_int), parameter, public nc_float
integer(c_int), parameter nc_format_netcdf4_classic
subroutine nf_return_native_coord_bounds(ncfile)
subroutine, public netcdf_get_variable_id_for_variable(ncfile, variable_name, variable_id)
integer(c_int), parameter nc_by
subroutine nf_get_variable_array_short(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int), parameter nc_uint64
integer(c_int), parameter nc_strict_nc3
integer(c_int), parameter noleap_year
subroutine, public netcdf_rewrite_attribute(ncfile, svariablename, sattributename, sattributevalue, iattributevalue, rattributevalue, dpattributevalue)
subroutine, public netcdf_deallocate_data_struct(ncfile)
integer(c_int), parameter leap_year
integer(c_int), parameter nc_nofill
integer(c_size_t) function nf_julian_day_to_index_adj(ncfile, rjulianday)
subroutine nf_put_lat_and_lon(ncfile, dplat, dplon)
subroutine nf_get_variable_array_float(ncfile, inc_varid, inc_start, inc_count, inc_stride, rnc_vars)
integer(c_int), parameter nc_na_int
Provides Fortran interfaces to the NetCDF C API. This approach is much more straightforward than usin...
subroutine, public create_attributes_from_proj4_string(proj4_string, attribute_name_list, attribute_value_list)