34 include
'scale_file_c.inc'
49 public :: file_put_axis
50 public :: file_write_axis
52 public :: file_put_associatedcoordinate
53 public :: file_write_associatedcoordinate
54 public :: file_add_variable
56 public :: file_get_shape
58 public :: file_get_commoninfo
59 public :: file_get_datainfo
60 public :: file_get_all_datainfo
63 public :: file_get_attribute
64 public :: file_set_attribute
76 interface file_get_commoninfo
77 module procedure file_get_commoninfo_fid
78 module procedure file_get_commoninfo_fname
79 end interface file_get_commoninfo
81 interface file_get_shape
82 module procedure file_get_shape_fid
83 module procedure file_get_shape_fname
84 end interface file_get_shape
86 interface file_get_datainfo
87 module procedure file_get_datainfo_fid
88 module procedure file_get_datainfo_fname
89 end interface file_get_datainfo
91 interface file_get_all_datainfo
92 module procedure file_get_all_datainfo_fid
93 module procedure file_get_all_datainfo_fname
94 end interface file_get_all_datainfo
96 interface file_put_axis
97 module procedure file_put_axis_realsp
98 module procedure file_put_axis_realdp
99 end interface file_put_axis
100 interface file_write_axis
101 module procedure file_write_axis_realsp
102 module procedure file_write_axis_realdp
103 end interface file_write_axis
104 interface file_put_associatedcoordinate
105 module procedure file_put_associatedcoordinate_realsp_1d
106 module procedure file_put_associatedcoordinate_realdp_1d
107 module procedure file_put_associatedcoordinate_realsp_2d
108 module procedure file_put_associatedcoordinate_realdp_2d
109 module procedure file_put_associatedcoordinate_realsp_3d
110 module procedure file_put_associatedcoordinate_realdp_3d
111 module procedure file_put_associatedcoordinate_realsp_4d
112 module procedure file_put_associatedcoordinate_realdp_4d
113 end interface file_put_associatedcoordinate
114 interface file_write_associatedcoordinate
115 module procedure file_write_associatedcoordinate_realsp_1d
116 module procedure file_write_associatedcoordinate_realdp_1d
117 module procedure file_write_associatedcoordinate_realsp_2d
118 module procedure file_write_associatedcoordinate_realdp_2d
119 module procedure file_write_associatedcoordinate_realsp_3d
120 module procedure file_write_associatedcoordinate_realdp_3d
121 module procedure file_write_associatedcoordinate_realsp_4d
122 module procedure file_write_associatedcoordinate_realdp_4d
123 end interface file_write_associatedcoordinate
124 interface file_add_variable
125 module procedure file_add_variable_no_time
126 module procedure file_add_variable_with_time
127 end interface file_add_variable
129 module procedure file_read_realsp_1d
130 module procedure file_read_realdp_1d
131 module procedure file_read_realsp_2d
132 module procedure file_read_realdp_2d
133 module procedure file_read_realsp_3d
134 module procedure file_read_realdp_3d
135 module procedure file_read_realsp_4d
136 module procedure file_read_realdp_4d
137 module procedure file_read_var_realsp_1d
138 module procedure file_read_var_realdp_1d
139 module procedure file_read_var_realsp_2d
140 module procedure file_read_var_realdp_2d
141 module procedure file_read_var_realsp_3d
142 module procedure file_read_var_realdp_3d
143 module procedure file_read_var_realsp_4d
144 module procedure file_read_var_realdp_4d
145 end interface file_read
147 module procedure file_write_realsp_1d
148 module procedure file_write_realdp_1d
149 module procedure file_write_realsp_2d
150 module procedure file_write_realdp_2d
151 module procedure file_write_realsp_3d
152 module procedure file_write_realdp_3d
153 module procedure file_write_realsp_4d
154 module procedure file_write_realdp_4d
155 end interface file_write
156 interface file_get_attribute
157 module procedure file_get_attribute_text_fname
158 module procedure file_get_attribute_logical_fname
159 module procedure file_get_attribute_int_fname_ary
160 module procedure file_get_attribute_int_fname
161 module procedure file_get_attribute_float_fname_ary
162 module procedure file_get_attribute_float_fname
163 module procedure file_get_attribute_double_fname_ary
164 module procedure file_get_attribute_double_fname
165 module procedure file_get_attribute_text_fid
166 module procedure file_get_attribute_logical_fid
167 module procedure file_get_attribute_int_fid_ary
168 module procedure file_get_attribute_int_fid
169 module procedure file_get_attribute_float_fid_ary
170 module procedure file_get_attribute_float_fid
171 module procedure file_get_attribute_double_fid_ary
172 module procedure file_get_attribute_double_fid
173 end interface file_get_attribute
174 interface file_set_attribute
175 module procedure file_set_attribute_text
176 module procedure file_set_attribute_logical
177 module procedure file_set_attribute_int_ary
178 module procedure file_set_attribute_int
179 module procedure file_set_attribute_float_ary
180 module procedure file_set_attribute_float
181 module procedure file_set_attribute_double_ary
182 module procedure file_set_attribute_double
183 end interface file_set_attribute
185 #if defined(__GFORTRAN__) && __GNUC__ < 7
187 module procedure cloc_sp
188 module procedure cloc_dp
202 private :: file_get_fid
209 character(len=FILE_HLONG) :: name
214 integer(8) :: buffer_size
217 integer :: file_nfiles = 0
220 character(len=FILE_HLONG) :: name
225 integer :: file_nvars = 0
227 integer :: mpi_myrank
240 integer,
intent(in) :: myrank
242 namelist / param_file / &
254 log_info(
"FILE_setup",*)
'Not found namelist. Default used.'
255 elseif( ierr > 0 )
then
256 log_error(
"FILE_setup",*)
'Not appropriate names in namelist PARAM_FILE. Check!'
266 file_files(fid)%fid = -1
267 file_files(fid)%name =
""
290 title, source, institution, &
292 rankid, single, aggregate, &
293 time_units, calendar, &
297 character(len=*),
intent(in) :: basename
298 character(len=*),
intent(in) :: title
299 character(len=*),
intent(in) :: source
300 character(len=*),
intent(in) :: institution
302 integer,
intent(out) :: fid
303 logical,
intent(out) :: existed
305 integer,
intent(in),
optional :: rankid
306 logical,
intent(in),
optional :: single
307 logical,
intent(in),
optional :: aggregate
308 character(len=*),
intent(in),
optional :: time_units
309 character(len=*),
intent(in),
optional :: calendar
310 logical,
intent(in),
optional :: allnodes
311 logical,
intent(in),
optional :: append
313 character(len=FILE_HMID) :: time_units_
314 character(len=FILE_HSHORT) :: calendar_
323 if (
present(rankid) )
then
330 if (
present(single) )
then
334 if (
present(time_units) )
then
335 time_units_ = time_units
337 time_units_ =
'seconds'
340 if (
present(calendar) )
then
347 if (
present(append) )
then
351 if ( single_ .and. rankid_ /= 0 )
then
357 call file_get_fid( basename, mode, &
361 aggregate=aggregate )
365 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
368 call file_set_attribute( fid,
"global",
"title" , title )
369 call file_set_attribute( fid,
"global",
"source" , source )
370 call file_set_attribute( fid,
"global",
"institution", institution )
372 if ( ( .not.
present(aggregate) ) .or. .not. aggregate )
then
374 call file_set_attribute( fid,
"global",
"rankid" , (/rankid_/) )
382 log_error(
"FILE_create",*)
'failed to set time units'
386 call prof_rapend(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
392 subroutine file_get_var_num( &
397 integer,
intent(in) :: fid
398 integer,
intent(in) :: nvars_limit
399 integer,
intent(out) :: nvars
405 log_error(
"FILE_get_var_num",*)
'File is not opened. fid = ', fid
409 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
412 file_files(fid)%fid )
414 log_error(
"FILE_get_var_num",*)
'failed to get varnum. fid = ', fid
418 if ( nvars > nvars_limit )
then
419 log_error(
"FILE_get_var_num",*)
'number of variables exceeds the requested size.', nvars, nvars_limit
423 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
426 end subroutine file_get_var_num
429 subroutine file_get_var_name( &
434 integer,
intent(in) :: fid
435 integer,
intent(in) :: cvid
436 character(len=*),
intent(out) :: varname
442 log_error(
"FILE_get_var_name",*)
'File is not opened. fid = ', fid
446 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
449 file_files(fid)%fid, cvid, len(varname) )
452 log_error(
"FILE_get_var_name",*)
'failed to get varname. cvid = ', cvid
456 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
459 end subroutine file_get_var_name
463 integer,
intent(in) :: fid
464 character(len=*),
intent(in) :: vname
465 logical,
optional,
intent(out) :: existed
470 log_error(
"FILE_add_associatedVariable",*)
'File is not opened. fid = ', fid
474 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
478 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
480 if (
present(existed) )
then
489 log_error(
"FILE_add_associatedvariable",*)
'failed to add associated variable: '//trim(vname)
500 integer,
intent(in) :: fid
501 character(len=*),
intent(in) :: filetype
502 character(len=*),
intent(in) :: key
503 character(len=*),
intent(in) :: val
508 log_error(
"FILE_set_option",*)
'File is not opened. fid = ', fid
512 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
516 log_error(
"FILE_set_option",*)
'failed to set option'
520 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
537 character(len=*),
intent( in) :: basename
538 integer,
intent(out) :: fid
539 integer,
intent( in),
optional :: mode
540 logical,
intent( in),
optional :: single
541 logical,
intent( in),
optional :: allnodes
542 logical,
intent( in),
optional :: aggregate
543 integer,
intent( in),
optional :: rankid
544 character(len=*),
intent( in),
optional :: postfix
553 if (
present(mode) )
then
559 if (
present(single) ) single_ = single
560 if (
present(rankid) )
then
566 call file_get_fid( basename, mode_, rankid_, single_, &
569 aggregate=aggregate, postfix=postfix )
579 integer,
intent( in) :: fid
596 integer,
intent( in) :: fid
613 integer,
intent( in) :: fid
632 integer,
intent(in) :: fid
633 character(len=*),
intent(in) :: dimname
635 integer,
intent(out) :: len
637 logical,
intent(out),
optional :: error
639 logical(c_bool) :: suppress
644 log_error(
"FILE_get_dimLength",*)
'File is not opened. fid = ', fid
648 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
650 if (
present(error) )
then
657 file_files(fid)%fid, &
661 if (
present(error) )
then
664 log_error(
"FILE_get_dimLength",*)
'failed to get dimension length'
668 if (
present(error) ) error = .false.
671 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
679 subroutine file_put_axis_realsp( &
684 integer,
intent(in) :: fid
685 character(len=*),
intent(in) :: name
686 character(len=*),
intent(in) :: desc
687 character(len=*),
intent(in) :: units
688 character(len=*),
intent(in) :: dim_name
689 integer,
intent(in) :: dtype
690 real(
sp),
intent(in),
target,
contiguous :: val(:)
696 log_error(
"FILE_put_axis_real",*)
'File is not opened. fid = ', fid
700 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
706 cstr(dim_name), dtype, &
707 #if defined(__GFORTRAN__) && __GNUC__ < 7
708 cloc(val(1)),
size(val),
sp )
710 c_loc(val),
size(val),
sp )
713 log_error(
"FILE_put_axis_realSP",*)
'failed to put axis'
717 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
720 end subroutine file_put_axis_realsp
721 subroutine file_put_axis_realdp( &
726 integer,
intent(in) :: fid
727 character(len=*),
intent(in) :: name
728 character(len=*),
intent(in) :: desc
729 character(len=*),
intent(in) :: units
730 character(len=*),
intent(in) :: dim_name
731 integer,
intent(in) :: dtype
732 real(
dp),
intent(in),
target,
contiguous :: val(:)
738 log_error(
"FILE_put_axis_real",*)
'File is not opened. fid = ', fid
742 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
748 cstr(dim_name), dtype, &
749 #if defined(__GFORTRAN__) && __GNUC__ < 7
750 cloc(val(1)),
size(val),
dp )
752 c_loc(val),
size(val),
dp )
755 log_error(
"FILE_put_axis_realDP",*)
'failed to put axis'
759 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
762 end subroutine file_put_axis_realdp
767 dim_name, dtype, dim_size, &
769 integer,
intent(in) :: fid
770 character(len=*),
intent(in) :: name
771 character(len=*),
intent(in) :: desc
772 character(len=*),
intent(in) :: units
773 character(len=*),
intent(in) :: dim_name
774 integer,
intent(in) :: dtype
775 integer,
intent(in) :: dim_size
777 logical,
intent(in),
optional :: bounds
783 if (
present(bounds) )
then
784 if ( bounds ) bounds_ = 1
788 log_error(
"FILE_def_axis",*)
'File is not opened. fid = ', fid
792 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
796 cstr(dim_name), dtype, dim_size, bounds_ )
798 log_error(
"FILE_def_axis",*)
'failed to define axis'
802 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
810 subroutine file_write_axis_realsp( &
815 integer,
intent(in) :: fid
816 character(len=*),
intent(in) :: name
817 real(
sp),
intent(in),
target,
contiguous :: val(:)
818 integer,
intent(in),
optional :: start(:)
824 log_error(
"FILE_write_axis_realSP",*)
'File is not opened. fid = ', fid
828 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
832 if (
present(start) )
then
834 #if defined(__GFORTRAN__) && __GNUC__ < 7
835 cloc(val(1)),
sp, start-1, shape(val) )
837 c_loc(val),
sp, start-1, shape(val) )
841 #if defined(__GFORTRAN__) && __GNUC__ < 7
842 cloc(val(1)),
sp, (/0/), shape(val) )
844 c_loc(val),
sp, (/0/), shape(val) )
848 log_error(
"FILE_write_axis_realSP",*)
'failed to write axis: '//trim(name)
852 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
855 end subroutine file_write_axis_realsp
856 subroutine file_write_axis_realdp( &
861 integer,
intent(in) :: fid
862 character(len=*),
intent(in) :: name
863 real(
dp),
intent(in),
target,
contiguous :: val(:)
864 integer,
intent(in),
optional :: start(:)
870 log_error(
"FILE_write_axis_realDP",*)
'File is not opened. fid = ', fid
874 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
878 if (
present(start) )
then
880 #if defined(__GFORTRAN__) && __GNUC__ < 7
881 cloc(val(1)),
dp, start-1, shape(val) )
883 c_loc(val),
dp, start-1, shape(val) )
887 #if defined(__GFORTRAN__) && __GNUC__ < 7
888 cloc(val(1)),
dp, (/0/), shape(val) )
890 c_loc(val),
dp, (/0/), shape(val) )
894 log_error(
"FILE_write_axis_realDP",*)
'failed to write axis: '//trim(name)
898 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
901 end subroutine file_write_axis_realdp
906 subroutine file_put_associatedcoordinate_realsp_1d( &
911 integer,
intent(in) :: fid
912 character(len=*),
intent(in) :: name
913 character(len=*),
intent(in) :: desc
914 character(len=*),
intent(in) :: units
915 character(len=*),
intent(in) :: dim_names(:)
916 integer,
intent(in) :: dtype
918 real(
sp),
intent(in) :: val(:)
920 real(
sp),
intent(in),
target,
contiguous :: val(:)
923 type(c_ptr) :: dim_names_(size(dim_names))
925 character(len=H_SHORT),
allocatable,
target :: cptr(:)
932 log_error(
"FILE_put_associatedCoordinate_realSP_1D",*)
'File is not opened. fid = ', fid
936 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
939 allocate( cptr(
size(dim_names)) )
940 do i = 1,
size(dim_names)
941 cptr(
i) =
cstr(dim_names(
i))
942 dim_names_(
i) = c_loc(cptr(
i))
949 real(
sp),
allocatable,
target :: work(:)
950 allocate(work, source=val)
953 file_files(fid)%fid, &
955 dim_names_,
size(dim_names), dtype, &
956 #if defined(__GFORTRAN__) && __GNUC__ < 7
958 #elif defined(NVIDIA)
964 log_error(
"FILE_put_associatedCoordinate_realSP_1D",*)
'failed to put associated coordinate: '//trim(name)
972 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
975 end subroutine file_put_associatedcoordinate_realsp_1d
976 subroutine file_put_associatedcoordinate_realdp_1d( &
981 integer,
intent(in) :: fid
982 character(len=*),
intent(in) :: name
983 character(len=*),
intent(in) :: desc
984 character(len=*),
intent(in) :: units
985 character(len=*),
intent(in) :: dim_names(:)
986 integer,
intent(in) :: dtype
988 real(dp),
intent(in) :: val(:)
990 real(dp),
intent(in),
target,
contiguous :: val(:)
993 type(c_ptr) :: dim_names_(size(dim_names))
995 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1002 log_error(
"FILE_put_associatedCoordinate_realDP_1D",*)
'File is not opened. fid = ', fid
1006 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1009 allocate( cptr(
size(dim_names)) )
1010 do i = 1,
size(dim_names)
1011 cptr(
i) = cstr(dim_names(
i))
1012 dim_names_(
i) = c_loc(cptr(
i))
1019 real(dp),
allocatable,
target :: work(:)
1020 allocate(work, source=val)
1023 file_files(fid)%fid, &
1024 cstr(name), cstr(desc), cstr(units), &
1025 dim_names_,
size(dim_names), dtype, &
1026 #if defined(__GFORTRAN__) && __GNUC__ < 7
1028 #elif defined(NVIDIA)
1033 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1034 log_error(
"FILE_put_associatedCoordinate_realDP_1D",*)
'failed to put associated coordinate: '//trim(name)
1042 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1045 end subroutine file_put_associatedcoordinate_realdp_1d
1046 subroutine file_put_associatedcoordinate_realsp_2d( &
1048 name, desc, units, &
1051 integer,
intent(in) :: fid
1052 character(len=*),
intent(in) :: name
1053 character(len=*),
intent(in) :: desc
1054 character(len=*),
intent(in) :: units
1055 character(len=*),
intent(in) :: dim_names(:)
1056 integer,
intent(in) :: dtype
1058 real(sp),
intent(in) :: val(:,:)
1060 real(sp),
intent(in),
target,
contiguous :: val(:,:)
1063 type(c_ptr) :: dim_names_(size(dim_names))
1065 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1072 log_error(
"FILE_put_associatedCoordinate_realSP_2D",*)
'File is not opened. fid = ', fid
1076 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1079 allocate( cptr(
size(dim_names)) )
1080 do i = 1,
size(dim_names)
1081 cptr(
i) = cstr(dim_names(
i))
1082 dim_names_(
i) = c_loc(cptr(
i))
1089 real(sp),
allocatable,
target :: work(:,:)
1090 allocate(work, source=val)
1093 file_files(fid)%fid, &
1094 cstr(name), cstr(desc), cstr(units), &
1095 dim_names_,
size(dim_names), dtype, &
1096 #if defined(__GFORTRAN__) && __GNUC__ < 7
1097 cloc(val(1,1)), sp )
1098 #elif defined(NVIDIA)
1103 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1104 log_error(
"FILE_put_associatedCoordinate_realSP_2D",*)
'failed to put associated coordinate: '//trim(name)
1112 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1115 end subroutine file_put_associatedcoordinate_realsp_2d
1116 subroutine file_put_associatedcoordinate_realdp_2d( &
1118 name, desc, units, &
1121 integer,
intent(in) :: fid
1122 character(len=*),
intent(in) :: name
1123 character(len=*),
intent(in) :: desc
1124 character(len=*),
intent(in) :: units
1125 character(len=*),
intent(in) :: dim_names(:)
1126 integer,
intent(in) :: dtype
1128 real(dp),
intent(in) :: val(:,:)
1130 real(dp),
intent(in),
target,
contiguous :: val(:,:)
1133 type(c_ptr) :: dim_names_(size(dim_names))
1135 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1142 log_error(
"FILE_put_associatedCoordinate_realDP_2D",*)
'File is not opened. fid = ', fid
1146 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1149 allocate( cptr(
size(dim_names)) )
1150 do i = 1,
size(dim_names)
1151 cptr(
i) = cstr(dim_names(
i))
1152 dim_names_(
i) = c_loc(cptr(
i))
1159 real(dp),
allocatable,
target :: work(:,:)
1160 allocate(work, source=val)
1163 file_files(fid)%fid, &
1164 cstr(name), cstr(desc), cstr(units), &
1165 dim_names_,
size(dim_names), dtype, &
1166 #if defined(__GFORTRAN__) && __GNUC__ < 7
1167 cloc(val(1,1)), dp )
1168 #elif defined(NVIDIA)
1173 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1174 log_error(
"FILE_put_associatedCoordinate_realDP_2D",*)
'failed to put associated coordinate: '//trim(name)
1182 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1185 end subroutine file_put_associatedcoordinate_realdp_2d
1186 subroutine file_put_associatedcoordinate_realsp_3d( &
1188 name, desc, units, &
1191 integer,
intent(in) :: fid
1192 character(len=*),
intent(in) :: name
1193 character(len=*),
intent(in) :: desc
1194 character(len=*),
intent(in) :: units
1195 character(len=*),
intent(in) :: dim_names(:)
1196 integer,
intent(in) :: dtype
1198 real(sp),
intent(in) :: val(:,:,:)
1200 real(sp),
intent(in),
target,
contiguous :: val(:,:,:)
1203 type(c_ptr) :: dim_names_(size(dim_names))
1205 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1212 log_error(
"FILE_put_associatedCoordinate_realSP_3D",*)
'File is not opened. fid = ', fid
1216 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1219 allocate( cptr(
size(dim_names)) )
1220 do i = 1,
size(dim_names)
1221 cptr(
i) = cstr(dim_names(
i))
1222 dim_names_(
i) = c_loc(cptr(
i))
1229 real(sp),
allocatable,
target :: work(:,:,:)
1230 allocate(work, source=val)
1233 file_files(fid)%fid, &
1234 cstr(name), cstr(desc), cstr(units), &
1235 dim_names_,
size(dim_names), dtype, &
1236 #if defined(__GFORTRAN__) && __GNUC__ < 7
1237 cloc(val(1,1,1)), sp )
1238 #elif defined(NVIDIA)
1243 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1244 log_error(
"FILE_put_associatedCoordinate_realSP_3D",*)
'failed to put associated coordinate: '//trim(name)
1252 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1255 end subroutine file_put_associatedcoordinate_realsp_3d
1256 subroutine file_put_associatedcoordinate_realdp_3d( &
1258 name, desc, units, &
1261 integer,
intent(in) :: fid
1262 character(len=*),
intent(in) :: name
1263 character(len=*),
intent(in) :: desc
1264 character(len=*),
intent(in) :: units
1265 character(len=*),
intent(in) :: dim_names(:)
1266 integer,
intent(in) :: dtype
1268 real(dp),
intent(in) :: val(:,:,:)
1270 real(dp),
intent(in),
target,
contiguous :: val(:,:,:)
1273 type(c_ptr) :: dim_names_(size(dim_names))
1275 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1282 log_error(
"FILE_put_associatedCoordinate_realDP_3D",*)
'File is not opened. fid = ', fid
1286 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1289 allocate( cptr(
size(dim_names)) )
1290 do i = 1,
size(dim_names)
1291 cptr(
i) = cstr(dim_names(
i))
1292 dim_names_(
i) = c_loc(cptr(
i))
1299 real(dp),
allocatable,
target :: work(:,:,:)
1300 allocate(work, source=val)
1303 file_files(fid)%fid, &
1304 cstr(name), cstr(desc), cstr(units), &
1305 dim_names_,
size(dim_names), dtype, &
1306 #if defined(__GFORTRAN__) && __GNUC__ < 7
1307 cloc(val(1,1,1)), dp )
1308 #elif defined(NVIDIA)
1313 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1314 log_error(
"FILE_put_associatedCoordinate_realDP_3D",*)
'failed to put associated coordinate: '//trim(name)
1322 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1325 end subroutine file_put_associatedcoordinate_realdp_3d
1326 subroutine file_put_associatedcoordinate_realsp_4d( &
1328 name, desc, units, &
1331 integer,
intent(in) :: fid
1332 character(len=*),
intent(in) :: name
1333 character(len=*),
intent(in) :: desc
1334 character(len=*),
intent(in) :: units
1335 character(len=*),
intent(in) :: dim_names(:)
1336 integer,
intent(in) :: dtype
1338 real(sp),
intent(in) :: val(:,:,:,:)
1340 real(sp),
intent(in),
target,
contiguous :: val(:,:,:,:)
1343 type(c_ptr) :: dim_names_(size(dim_names))
1345 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1352 log_error(
"FILE_put_associatedCoordinate_realSP_4D",*)
'File is not opened. fid = ', fid
1356 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1359 allocate( cptr(
size(dim_names)) )
1360 do i = 1,
size(dim_names)
1361 cptr(
i) = cstr(dim_names(
i))
1362 dim_names_(
i) = c_loc(cptr(
i))
1369 real(sp),
allocatable,
target :: work(:,:,:,:)
1370 allocate(work, source=val)
1373 file_files(fid)%fid, &
1374 cstr(name), cstr(desc), cstr(units), &
1375 dim_names_,
size(dim_names), dtype, &
1376 #if defined(__GFORTRAN__) && __GNUC__ < 7
1377 cloc(val(1,1,1,1)), sp )
1378 #elif defined(NVIDIA)
1383 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1384 log_error(
"FILE_put_associatedCoordinate_realSP_4D",*)
'failed to put associated coordinate: '//trim(name)
1392 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1395 end subroutine file_put_associatedcoordinate_realsp_4d
1396 subroutine file_put_associatedcoordinate_realdp_4d( &
1398 name, desc, units, &
1401 integer,
intent(in) :: fid
1402 character(len=*),
intent(in) :: name
1403 character(len=*),
intent(in) :: desc
1404 character(len=*),
intent(in) :: units
1405 character(len=*),
intent(in) :: dim_names(:)
1406 integer,
intent(in) :: dtype
1408 real(dp),
intent(in) :: val(:,:,:,:)
1410 real(dp),
intent(in),
target,
contiguous :: val(:,:,:,:)
1413 type(c_ptr) :: dim_names_(size(dim_names))
1415 character(len=H_SHORT),
allocatable,
target :: cptr(:)
1422 log_error(
"FILE_put_associatedCoordinate_realDP_4D",*)
'File is not opened. fid = ', fid
1426 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1429 allocate( cptr(
size(dim_names)) )
1430 do i = 1,
size(dim_names)
1431 cptr(
i) = cstr(dim_names(
i))
1432 dim_names_(
i) = c_loc(cptr(
i))
1439 real(dp),
allocatable,
target :: work(:,:,:,:)
1440 allocate(work, source=val)
1443 file_files(fid)%fid, &
1444 cstr(name), cstr(desc), cstr(units), &
1445 dim_names_,
size(dim_names), dtype, &
1446 #if defined(__GFORTRAN__) && __GNUC__ < 7
1447 cloc(val(1,1,1,1)), dp )
1448 #elif defined(NVIDIA)
1453 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1454 log_error(
"FILE_put_associatedCoordinate_realDP_4D",*)
'failed to put associated coordinate: '//trim(name)
1462 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1465 end subroutine file_put_associatedcoordinate_realdp_4d
1469 name, desc, units, &
1471 integer,
intent(in) :: fid
1472 character(len=*),
intent(in) :: name
1473 character(len=*),
intent(in) :: desc
1474 character(len=*),
intent(in) :: units
1475 character(len=*),
intent(in) :: dim_names(:)
1476 integer,
intent(in) :: dtype
1478 type(c_ptr) :: dim_names_(size(dim_names))
1480 character(len=H_SHORT+1),
allocatable,
target :: cptr(:)
1487 log_error(
"FILE_def_associatedCoordinate",*)
'File is not opened. fid = ', fid
1491 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1494 allocate( cptr(
size(dim_names)) )
1495 do i = 1,
size(dim_names)
1496 cptr(
i) = cstr(dim_names(
i))
1497 dim_names_(
i) = c_loc(cptr(
i))
1501 file_files(fid)%fid, &
1502 cstr(name), cstr(desc), cstr(units), &
1503 dim_names_,
size(dim_names), dtype )
1504 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1505 log_error(
"FILE_def_associatedCoordinate",*)
'failed to define associated coordinate: '//trim(name)
1509 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1517 subroutine file_write_associatedcoordinate_realsp_1d( &
1523 integer,
intent(in) :: fid
1524 character(len=*),
intent(in) :: name
1526 real(sp),
intent(in) :: val(:)
1528 real(sp),
intent(in),
target,
contiguous :: val(:)
1530 integer,
intent(in),
optional :: start(:)
1531 integer,
intent(in),
optional :: count(:)
1532 integer,
intent(in),
optional :: ndims
1535 integer,
allocatable :: start_(:), count_(:)
1538 intrinsic shape,
size
1541 log_error(
"FILE_write_associatedCoordinate_realSP_1D",*)
'File is not opened. fid = ', fid
1545 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1547 if (
present(ndims) )
then
1552 allocate( start_(ndims_), count_(ndims_) )
1554 if (
present(ndims) )
then
1558 start_(
i) = start(ndims_-
i+1) - 1
1559 count_(
i) = count(ndims_-
i+1)
1561 else if (
present(start) )
then
1564 start_(
i) = start(1-
i+1) - 1
1565 count_(
i) =
size(val, 1-
i+1)
1571 count_(
i) =
size(val, 1-
i+1)
1579 real(sp),
allocatable,
target :: work(:)
1580 allocate(work, source=val)
1583 file_files(fid)%fid, cstr(name), &
1584 #if defined(__GFORTRAN__) && __GNUC__ < 7
1586 #elif defined(NVIDIA)
1594 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1595 log_error(
"FILE_write_associatedCoordinate_realSP_1D",*)
'failed to write associated coordinate: '//trim(name)
1603 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1606 end subroutine file_write_associatedcoordinate_realsp_1d
1607 subroutine file_write_associatedcoordinate_realdp_1d( &
1613 integer,
intent(in) :: fid
1614 character(len=*),
intent(in) :: name
1616 real(dp),
intent(in) :: val(:)
1618 real(dp),
intent(in),
target,
contiguous :: val(:)
1620 integer,
intent(in),
optional :: start(:)
1621 integer,
intent(in),
optional :: count(:)
1622 integer,
intent(in),
optional :: ndims
1625 integer,
allocatable :: start_(:), count_(:)
1628 intrinsic shape,
size
1631 log_error(
"FILE_write_associatedCoordinate_realDP_1D",*)
'File is not opened. fid = ', fid
1635 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1637 if (
present(ndims) )
then
1642 allocate( start_(ndims_), count_(ndims_) )
1644 if (
present(ndims) )
then
1648 start_(
i) = start(ndims_-
i+1) - 1
1649 count_(
i) = count(ndims_-
i+1)
1651 else if (
present(start) )
then
1654 start_(
i) = start(1-
i+1) - 1
1655 count_(
i) =
size(val, 1-
i+1)
1661 count_(
i) =
size(val, 1-
i+1)
1669 real(dp),
allocatable,
target :: work(:)
1670 allocate(work, source=val)
1673 file_files(fid)%fid, cstr(name), &
1674 #if defined(__GFORTRAN__) && __GNUC__ < 7
1676 #elif defined(NVIDIA)
1684 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1685 log_error(
"FILE_write_associatedCoordinate_realDP_1D",*)
'failed to write associated coordinate: '//trim(name)
1693 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1696 end subroutine file_write_associatedcoordinate_realdp_1d
1697 subroutine file_write_associatedcoordinate_realsp_2d( &
1703 integer,
intent(in) :: fid
1704 character(len=*),
intent(in) :: name
1706 real(sp),
intent(in) :: val(:,:)
1708 real(sp),
intent(in),
target,
contiguous :: val(:,:)
1710 integer,
intent(in),
optional :: start(:)
1711 integer,
intent(in),
optional :: count(:)
1712 integer,
intent(in),
optional :: ndims
1715 integer,
allocatable :: start_(:), count_(:)
1718 intrinsic shape,
size
1721 log_error(
"FILE_write_associatedCoordinate_realSP_2D",*)
'File is not opened. fid = ', fid
1725 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1727 if (
present(ndims) )
then
1732 allocate( start_(ndims_), count_(ndims_) )
1734 if (
present(ndims) )
then
1738 start_(
i) = start(ndims_-
i+1) - 1
1739 count_(
i) = count(ndims_-
i+1)
1741 else if (
present(start) )
then
1744 start_(
i) = start(2-
i+1) - 1
1745 count_(
i) =
size(val, 2-
i+1)
1751 count_(
i) =
size(val, 2-
i+1)
1759 real(sp),
allocatable,
target :: work(:,:)
1760 allocate(work, source=val)
1763 file_files(fid)%fid, cstr(name), &
1764 #if defined(__GFORTRAN__) && __GNUC__ < 7
1766 #elif defined(NVIDIA)
1774 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1775 log_error(
"FILE_write_associatedCoordinate_realSP_2D",*)
'failed to write associated coordinate: '//trim(name)
1783 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1786 end subroutine file_write_associatedcoordinate_realsp_2d
1787 subroutine file_write_associatedcoordinate_realdp_2d( &
1793 integer,
intent(in) :: fid
1794 character(len=*),
intent(in) :: name
1796 real(dp),
intent(in) :: val(:,:)
1798 real(dp),
intent(in),
target,
contiguous :: val(:,:)
1800 integer,
intent(in),
optional :: start(:)
1801 integer,
intent(in),
optional :: count(:)
1802 integer,
intent(in),
optional :: ndims
1805 integer,
allocatable :: start_(:), count_(:)
1808 intrinsic shape,
size
1811 log_error(
"FILE_write_associatedCoordinate_realDP_2D",*)
'File is not opened. fid = ', fid
1815 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1817 if (
present(ndims) )
then
1822 allocate( start_(ndims_), count_(ndims_) )
1824 if (
present(ndims) )
then
1828 start_(
i) = start(ndims_-
i+1) - 1
1829 count_(
i) = count(ndims_-
i+1)
1831 else if (
present(start) )
then
1834 start_(
i) = start(2-
i+1) - 1
1835 count_(
i) =
size(val, 2-
i+1)
1841 count_(
i) =
size(val, 2-
i+1)
1849 real(dp),
allocatable,
target :: work(:,:)
1850 allocate(work, source=val)
1853 file_files(fid)%fid, cstr(name), &
1854 #if defined(__GFORTRAN__) && __GNUC__ < 7
1856 #elif defined(NVIDIA)
1864 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1865 log_error(
"FILE_write_associatedCoordinate_realDP_2D",*)
'failed to write associated coordinate: '//trim(name)
1873 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1876 end subroutine file_write_associatedcoordinate_realdp_2d
1877 subroutine file_write_associatedcoordinate_realsp_3d( &
1883 integer,
intent(in) :: fid
1884 character(len=*),
intent(in) :: name
1886 real(sp),
intent(in) :: val(:,:,:)
1888 real(sp),
intent(in),
target,
contiguous :: val(:,:,:)
1890 integer,
intent(in),
optional :: start(:)
1891 integer,
intent(in),
optional :: count(:)
1892 integer,
intent(in),
optional :: ndims
1895 integer,
allocatable :: start_(:), count_(:)
1898 intrinsic shape,
size
1901 log_error(
"FILE_write_associatedCoordinate_realSP_3D",*)
'File is not opened. fid = ', fid
1905 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1907 if (
present(ndims) )
then
1912 allocate( start_(ndims_), count_(ndims_) )
1914 if (
present(ndims) )
then
1918 start_(
i) = start(ndims_-
i+1) - 1
1919 count_(
i) = count(ndims_-
i+1)
1921 else if (
present(start) )
then
1924 start_(
i) = start(3-
i+1) - 1
1925 count_(
i) =
size(val, 3-
i+1)
1931 count_(
i) =
size(val, 3-
i+1)
1939 real(sp),
allocatable,
target :: work(:,:,:)
1940 allocate(work, source=val)
1943 file_files(fid)%fid, cstr(name), &
1944 #if defined(__GFORTRAN__) && __GNUC__ < 7
1946 #elif defined(NVIDIA)
1954 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
1955 log_error(
"FILE_write_associatedCoordinate_realSP_3D",*)
'failed to write associated coordinate: '//trim(name)
1963 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1966 end subroutine file_write_associatedcoordinate_realsp_3d
1967 subroutine file_write_associatedcoordinate_realdp_3d( &
1973 integer,
intent(in) :: fid
1974 character(len=*),
intent(in) :: name
1976 real(dp),
intent(in) :: val(:,:,:)
1978 real(dp),
intent(in),
target,
contiguous :: val(:,:,:)
1980 integer,
intent(in),
optional :: start(:)
1981 integer,
intent(in),
optional :: count(:)
1982 integer,
intent(in),
optional :: ndims
1985 integer,
allocatable :: start_(:), count_(:)
1988 intrinsic shape,
size
1991 log_error(
"FILE_write_associatedCoordinate_realDP_3D",*)
'File is not opened. fid = ', fid
1995 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
1997 if (
present(ndims) )
then
2002 allocate( start_(ndims_), count_(ndims_) )
2004 if (
present(ndims) )
then
2008 start_(
i) = start(ndims_-
i+1) - 1
2009 count_(
i) = count(ndims_-
i+1)
2011 else if (
present(start) )
then
2014 start_(
i) = start(3-
i+1) - 1
2015 count_(
i) =
size(val, 3-
i+1)
2021 count_(
i) =
size(val, 3-
i+1)
2029 real(dp),
allocatable,
target :: work(:,:,:)
2030 allocate(work, source=val)
2033 file_files(fid)%fid, cstr(name), &
2034 #if defined(__GFORTRAN__) && __GNUC__ < 7
2036 #elif defined(NVIDIA)
2044 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
2045 log_error(
"FILE_write_associatedCoordinate_realDP_3D",*)
'failed to write associated coordinate: '//trim(name)
2053 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2056 end subroutine file_write_associatedcoordinate_realdp_3d
2057 subroutine file_write_associatedcoordinate_realsp_4d( &
2063 integer,
intent(in) :: fid
2064 character(len=*),
intent(in) :: name
2066 real(sp),
intent(in) :: val(:,:,:,:)
2068 real(sp),
intent(in),
target,
contiguous :: val(:,:,:,:)
2070 integer,
intent(in),
optional :: start(:)
2071 integer,
intent(in),
optional :: count(:)
2072 integer,
intent(in),
optional :: ndims
2075 integer,
allocatable :: start_(:), count_(:)
2078 intrinsic shape,
size
2081 log_error(
"FILE_write_associatedCoordinate_realSP_4D",*)
'File is not opened. fid = ', fid
2085 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2087 if (
present(ndims) )
then
2092 allocate( start_(ndims_), count_(ndims_) )
2094 if (
present(ndims) )
then
2098 start_(
i) = start(ndims_-
i+1) - 1
2099 count_(
i) = count(ndims_-
i+1)
2101 else if (
present(start) )
then
2104 start_(
i) = start(4-
i+1) - 1
2105 count_(
i) =
size(val, 4-
i+1)
2111 count_(
i) =
size(val, 4-
i+1)
2119 real(sp),
allocatable,
target :: work(:,:,:,:)
2120 allocate(work, source=val)
2123 file_files(fid)%fid, cstr(name), &
2124 #if defined(__GFORTRAN__) && __GNUC__ < 7
2125 cloc(val(1,1,1,1)), &
2126 #elif defined(NVIDIA)
2134 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
2135 log_error(
"FILE_write_associatedCoordinate_realSP_4D",*)
'failed to write associated coordinate: '//trim(name)
2143 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2146 end subroutine file_write_associatedcoordinate_realsp_4d
2147 subroutine file_write_associatedcoordinate_realdp_4d( &
2153 integer,
intent(in) :: fid
2154 character(len=*),
intent(in) :: name
2156 real(dp),
intent(in) :: val(:,:,:,:)
2158 real(dp),
intent(in),
target,
contiguous :: val(:,:,:,:)
2160 integer,
intent(in),
optional :: start(:)
2161 integer,
intent(in),
optional :: count(:)
2162 integer,
intent(in),
optional :: ndims
2165 integer,
allocatable :: start_(:), count_(:)
2168 intrinsic shape,
size
2171 log_error(
"FILE_write_associatedCoordinate_realDP_4D",*)
'File is not opened. fid = ', fid
2175 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2177 if (
present(ndims) )
then
2182 allocate( start_(ndims_), count_(ndims_) )
2184 if (
present(ndims) )
then
2188 start_(
i) = start(ndims_-
i+1) - 1
2189 count_(
i) = count(ndims_-
i+1)
2191 else if (
present(start) )
then
2194 start_(
i) = start(4-
i+1) - 1
2195 count_(
i) =
size(val, 4-
i+1)
2201 count_(
i) =
size(val, 4-
i+1)
2209 real(dp),
allocatable,
target :: work(:,:,:,:)
2210 allocate(work, source=val)
2213 file_files(fid)%fid, cstr(name), &
2214 #if defined(__GFORTRAN__) && __GNUC__ < 7
2215 cloc(val(1,1,1,1)), &
2216 #elif defined(NVIDIA)
2224 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
2225 log_error(
"FILE_write_associatedCoordinate_realDP_4D",*)
'failed to write associated coordinate: '//trim(name)
2233 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2236 end subroutine file_write_associatedcoordinate_realdp_4d
2241 subroutine file_add_variable_no_time( &
2243 varname, desc, units, &
2248 integer,
intent( in) :: fid
2249 character(len=*),
intent( in) :: varname
2250 character(len=*),
intent( in) :: desc
2251 character(len=*),
intent( in) :: units
2252 character(len=*),
intent( in) :: standard_name
2253 character(len=*),
intent( in) :: dims(:)
2254 integer,
intent( in) :: dtype
2255 integer,
intent(out) :: vid
2256 character(len=*),
intent( in),
optional :: time_stats
2259 log_error(
"FILE_add_variable_no_time",*)
'File is not opened. fid = ', fid
2263 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2265 call file_add_variable_with_time( fid, &
2266 varname, desc, units, standard_name, &
2267 dims, dtype, -1.0_dp, &
2269 time_stats = time_stats )
2271 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2274 end subroutine file_add_variable_no_time
2277 subroutine file_add_variable_with_time( &
2279 varname, desc, units, &
2286 integer,
intent(in) :: fid
2287 character(len=*),
intent(in) :: varname
2288 character(len=*),
intent(in) :: desc
2289 character(len=*),
intent(in) :: units
2290 character(len=*),
intent(in) :: standard_name
2291 character(len=*),
intent(in) :: dims(:)
2292 integer,
intent(in) :: dtype
2293 real(dp),
intent(in) :: time_int
2295 integer,
intent(out) :: vid
2297 character(len=*),
intent(in),
optional :: time_stats
2299 type(c_ptr) :: dims_(size(dims))
2301 character(len=H_SHORT),
allocatable,
target :: cptr(:)
2303 character(len=4) :: ctstats
2314 log_error(
"FILE_add_variable_with_time",*)
'File is not opened. fid = ', fid
2318 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2321 do n = 1, file_nvars
2322 if ( file_vars(n)%fid == fid .and. file_vars(n)%name == varname )
then
2323 vid = file_vars(n)%vid
2333 if (
present(time_stats) )
then
2334 ctstats = time_stats
2338 allocate( cptr(ndims) )
2340 cptr(n) = cstr(dims(n))
2341 dims_(n) = c_loc(cptr(n))
2345 file_files(fid)%fid, &
2346 cstr(varname), cstr(desc), &
2347 cstr(units), cstr(standard_name), &
2348 dims_, ndims, dtype, &
2349 time_int, cstr(ctstats) )
2351 if ( error /= file_success_code )
then
2352 log_error(
"FILE_add_variable_with_time",*)
'failed to add variable: '//trim(varname)
2356 file_nvars = file_nvars + 1
2358 file_vars(vid)%name = varname
2359 file_vars(vid)%vid = cvid
2360 file_vars(vid)%fid = fid
2362 log_info(
"FILE_add_variable_with_time",
'(1x,A,I3.3,A,I4.4,2A)') &
2363 'Variable registration : NO.', fid,
', vid = ', vid,
', name = ', trim(varname)
2366 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2369 end subroutine file_add_variable_with_time
2373 varname, desc, units, &
2378 time_int, time_stats, &
2380 integer,
intent( in) :: fid
2381 character(len=*),
intent( in) :: varname
2382 character(len=*),
intent( in) :: desc
2383 character(len=*),
intent( in) :: units
2384 character(len=*),
intent( in) :: standard_name
2385 integer,
intent( in) :: ndims
2386 character(len=*),
intent( in) :: dims(:)
2387 integer,
intent( in) :: dtype
2388 integer,
intent(out) :: vid
2389 real(dp),
intent( in),
optional :: time_int
2390 character(len=*),
intent( in),
optional :: time_stats
2391 logical,
intent(out),
optional :: existed
2393 type(c_ptr) :: dims_(size(dims))
2395 character(len=H_SHORT),
allocatable,
target :: cptr(:)
2397 character(len=4) :: ctstats
2407 log_error(
"FILE_def_variable",*)
'File is not opened. fid = ', fid
2411 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2414 do n = 1, file_nvars
2415 if ( file_vars(n)%fid == fid .and. file_vars(n)%name == varname )
then
2422 if (
present(time_int) )
then
2429 if (
present(time_stats) )
then
2430 ctstats = time_stats
2434 allocate( cptr(ndims) )
2436 cptr(n) = cstr(dims(n))
2437 dims_(n) = c_loc(cptr(n))
2441 file_files(fid)%fid, &
2442 cstr(varname), cstr(desc), &
2443 cstr(units), cstr(standard_name), &
2444 dims_, ndims, dtype, tint_, cstr(ctstats) )
2446 if ( error /= file_success_code )
then
2447 log_error(
"FILE_def_variable",*)
'failed to add variable: '//trim(varname)
2451 file_nvars = file_nvars + 1
2453 file_vars(vid)%name = varname
2454 file_vars(vid)%vid = cvid
2455 file_vars(vid)%fid = fid
2457 log_info(
"FILE_def_variable",
'(1x,A,I3.3,A,I4.4,2A)') &
2458 'Variable registration : NO.', fid,
', vid = ', vid,
', name = ', trim(varname)
2460 if (
present(existed) ) existed = .false.
2462 if (
present(existed) ) existed = .true.
2465 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
2473 subroutine file_get_attribute_text_fid( &
2478 integer,
intent(in ) :: fid
2479 character(len=*),
intent(in ) :: vname
2480 character(len=*),
intent(in ) :: key
2481 character(len=*),
intent(out) :: val
2483 logical,
intent(out),
optional :: existed
2485 logical(c_bool) :: suppress
2489 log_error(
"FILE_get_attribute_text_fid",*)
'File is not opened. fid = ', fid
2493 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2495 if (
present(existed) )
then
2501 file_files(fid)%fid, &
2502 cstr(vname), cstr(key), &
2503 suppress, len(val) )
2505 if ( error /= file_success_code )
then
2506 if (
present(existed) )
then
2509 log_error(
"FILE_get_attribute_text_fid",*)
'failed to get text attribute for '//trim(vname)//
': '//trim(key)
2513 if (
present(existed) ) existed = .true.
2516 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2519 end subroutine file_get_attribute_text_fid
2520 subroutine file_get_attribute_text_fname( &
2521 basename, vname, key, &
2523 single, aggregate, rankid, &
2527 character(len=*),
intent(in) :: basename
2528 character(len=*),
intent(in) :: vname
2529 character(len=*),
intent(in) :: key
2531 character(len=*),
intent(out) :: val
2533 logical,
intent(in),
optional :: single
2534 logical,
intent(in),
optional :: aggregate
2535 integer,
intent(in),
optional :: rankid
2537 logical,
intent(out),
optional :: existed
2543 aggregate=aggregate, &
2546 call file_get_attribute_text_fid( &
2552 end subroutine file_get_attribute_text_fname
2555 subroutine file_get_attribute_logical_fid( &
2560 integer,
intent(in ) :: fid
2561 character(len=*),
intent(in ) :: vname
2562 character(len=*),
intent(in ) :: key
2563 logical,
intent(out) :: val
2565 logical,
intent(out),
optional :: existed
2567 character(len=6) :: buf
2570 log_error(
"FILE_get_attribute_logical_fid",*)
'File is not opened. fid = ', fid
2574 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2576 call file_get_attribute_text_fid( fid, vname, key, &
2579 if (
present(existed) )
then
2580 if ( .not. existed )
return
2583 if ( buf ==
"true" )
then
2585 else if ( buf ==
"false" )
then
2588 log_error(
"FILE_get_attribute_logical_fid",*)
'value is not eigher true or false'
2592 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2595 end subroutine file_get_attribute_logical_fid
2596 subroutine file_get_attribute_logical_fname( &
2597 basename, vname, key, &
2599 single, aggregate, rankid, &
2603 character(len=*),
intent(in) :: basename
2604 character(len=*),
intent(in) :: vname
2605 character(len=*),
intent(in) :: key
2607 logical,
intent(out) :: val
2609 logical,
intent(in),
optional :: single
2610 logical,
intent(in),
optional :: aggregate
2611 integer,
intent(in),
optional :: rankid
2613 logical,
intent(out),
optional :: existed
2619 aggregate=aggregate, &
2622 call file_get_attribute_logical_fid( &
2628 end subroutine file_get_attribute_logical_fname
2631 subroutine file_get_attribute_int_fid_ary( &
2635 integer,
intent(in ) :: fid
2636 character(len=*),
intent(in ) :: vname
2637 character(len=*),
intent(in ) :: key
2638 integer,
intent(out) :: val(:)
2640 logical,
intent(out),
optional :: existed
2642 logical(c_bool) :: suppress
2648 log_error(
"FILE_get_attribute_int_fid",*)
'File is not opened. fid = ', fid
2652 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2654 if (
present(existed) )
then
2660 file_files(fid)%fid, &
2661 cstr(vname), cstr(key), &
2662 suppress,
size(val) )
2663 if ( error /= file_success_code )
then
2664 if (
present(existed) )
then
2667 log_error(
"FILE_get_attribute_int_fid",*)
'failed to get integer attribute for '//trim(vname)//
': '//trim(key)
2671 if (
present(existed) ) existed = .true.
2674 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2677 end subroutine file_get_attribute_int_fid_ary
2678 subroutine file_get_attribute_int_fid( &
2682 integer,
intent(in ) :: fid
2683 character(len=*),
intent(in ) :: vname
2684 character(len=*),
intent(in ) :: key
2685 integer,
intent(out) :: val
2686 logical,
intent(out),
optional :: existed
2689 call file_get_attribute_int_fid_ary( &
2693 if (
present(existed) )
then
2694 if ( .not. existed )
return
2699 end subroutine file_get_attribute_int_fid
2700 subroutine file_get_attribute_int_fname_ary( &
2701 basename, vname, key, &
2703 single, aggregate, rankid, &
2707 character(len=*),
intent(in) :: basename
2708 character(len=*),
intent(in) :: vname
2709 character(len=*),
intent(in) :: key
2711 integer,
intent(out) :: val(:)
2713 logical,
intent(in),
optional :: single
2714 logical,
intent(in),
optional :: aggregate
2715 integer,
intent(in),
optional :: rankid
2717 logical,
intent(out),
optional :: existed
2724 aggregate=aggregate, &
2727 call file_get_attribute_int_fid_ary( &
2733 end subroutine file_get_attribute_int_fname_ary
2734 subroutine file_get_attribute_int_fname( &
2735 basename, vname, key, &
2737 single, aggregate, rankid, &
2740 character(len=*),
intent(in) :: basename
2741 character(len=*),
intent(in) :: vname
2742 character(len=*),
intent(in) :: key
2743 integer,
intent(out) :: val
2744 logical,
intent(in),
optional :: single
2745 logical,
intent(in),
optional :: aggregate
2746 integer,
intent(in),
optional :: rankid
2747 logical,
intent(out),
optional :: existed
2750 call file_get_attribute_int_fname_ary( &
2751 basename, vname, key, &
2753 single, aggregate, rankid, &
2758 end subroutine file_get_attribute_int_fname
2761 subroutine file_get_attribute_float_fid_ary( &
2765 integer,
intent(in ) :: fid
2766 character(len=*),
intent(in ) :: vname
2767 character(len=*),
intent(in ) :: key
2768 real(sp),
intent(out) :: val(:)
2770 logical,
intent(out),
optional :: existed
2772 logical(c_bool) :: suppress
2778 log_error(
"FILE_get_attribute_float_fid",*)
'File is not opened. fid = ', fid
2782 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2784 if (
present(existed) )
then
2790 file_files(fid)%fid, &
2791 cstr(vname), cstr(key), &
2792 suppress,
size(val) )
2793 if ( error /= file_success_code )
then
2794 if (
present(existed) )
then
2797 log_error(
"FILE_get_attribute_float_fid",*)
'failed to get float attribute for '//trim(vname)//
': '//trim(key)
2801 if (
present(existed) ) existed = .true.
2804 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2807 end subroutine file_get_attribute_float_fid_ary
2808 subroutine file_get_attribute_float_fid( &
2812 integer,
intent(in ) :: fid
2813 character(len=*),
intent(in ) :: vname
2814 character(len=*),
intent(in ) :: key
2815 real(sp),
intent(out) :: val
2816 logical,
intent(out),
optional :: existed
2819 call file_get_attribute_float_fid_ary( &
2823 if (
present(existed) )
then
2824 if ( .not. existed )
return
2829 end subroutine file_get_attribute_float_fid
2830 subroutine file_get_attribute_float_fname_ary( &
2831 basename, vname, key, &
2833 single, aggregate, rankid, &
2837 character(len=*),
intent(in) :: basename
2838 character(len=*),
intent(in) :: vname
2839 character(len=*),
intent(in) :: key
2841 real(sp),
intent(out) :: val(:)
2843 logical,
intent(in),
optional :: single
2844 logical,
intent(in),
optional :: aggregate
2845 integer,
intent(in),
optional :: rankid
2847 logical,
intent(out),
optional :: existed
2854 aggregate=aggregate, &
2857 call file_get_attribute_float_fid_ary( &
2863 end subroutine file_get_attribute_float_fname_ary
2864 subroutine file_get_attribute_float_fname( &
2865 basename, vname, key, &
2867 single, aggregate, rankid, &
2870 character(len=*),
intent(in) :: basename
2871 character(len=*),
intent(in) :: vname
2872 character(len=*),
intent(in) :: key
2873 real(sp),
intent(out) :: val
2874 logical,
intent(in),
optional :: single
2875 logical,
intent(in),
optional :: aggregate
2876 integer,
intent(in),
optional :: rankid
2877 logical,
intent(out),
optional :: existed
2880 call file_get_attribute_float_fname_ary( &
2881 basename, vname, key, &
2883 single, aggregate, rankid, &
2888 end subroutine file_get_attribute_float_fname
2889 subroutine file_get_attribute_double_fid_ary( &
2893 integer,
intent(in ) :: fid
2894 character(len=*),
intent(in ) :: vname
2895 character(len=*),
intent(in ) :: key
2896 real(dp),
intent(out) :: val(:)
2898 logical,
intent(out),
optional :: existed
2900 logical(c_bool) :: suppress
2906 log_error(
"FILE_get_attribute_double_fid",*)
'File is not opened. fid = ', fid
2910 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2912 if (
present(existed) )
then
2918 file_files(fid)%fid, &
2919 cstr(vname), cstr(key), &
2920 suppress,
size(val) )
2921 if ( error /= file_success_code )
then
2922 if (
present(existed) )
then
2925 log_error(
"FILE_get_attribute_double_fid",*)
'failed to get double attribute for '//trim(vname)//
': '//trim(key)
2929 if (
present(existed) ) existed = .true.
2932 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
2935 end subroutine file_get_attribute_double_fid_ary
2936 subroutine file_get_attribute_double_fid( &
2940 integer,
intent(in ) :: fid
2941 character(len=*),
intent(in ) :: vname
2942 character(len=*),
intent(in ) :: key
2943 real(dp),
intent(out) :: val
2944 logical,
intent(out),
optional :: existed
2947 call file_get_attribute_double_fid_ary( &
2951 if (
present(existed) )
then
2952 if ( .not. existed )
return
2957 end subroutine file_get_attribute_double_fid
2958 subroutine file_get_attribute_double_fname_ary( &
2959 basename, vname, key, &
2961 single, aggregate, rankid, &
2965 character(len=*),
intent(in) :: basename
2966 character(len=*),
intent(in) :: vname
2967 character(len=*),
intent(in) :: key
2969 real(dp),
intent(out) :: val(:)
2971 logical,
intent(in),
optional :: single
2972 logical,
intent(in),
optional :: aggregate
2973 integer,
intent(in),
optional :: rankid
2975 logical,
intent(out),
optional :: existed
2982 aggregate=aggregate, &
2985 call file_get_attribute_double_fid_ary( &
2991 end subroutine file_get_attribute_double_fname_ary
2992 subroutine file_get_attribute_double_fname( &
2993 basename, vname, key, &
2995 single, aggregate, rankid, &
2998 character(len=*),
intent(in) :: basename
2999 character(len=*),
intent(in) :: vname
3000 character(len=*),
intent(in) :: key
3001 real(dp),
intent(out) :: val
3002 logical,
intent(in),
optional :: single
3003 logical,
intent(in),
optional :: aggregate
3004 integer,
intent(in),
optional :: rankid
3005 logical,
intent(out),
optional :: existed
3008 call file_get_attribute_double_fname_ary( &
3009 basename, vname, key, &
3011 single, aggregate, rankid, &
3016 end subroutine file_get_attribute_double_fname
3021 subroutine file_set_attribute_text( &
3024 integer,
intent(in) :: fid
3025 character(len=*),
intent(in) :: vname
3026 character(len=*),
intent(in) :: key
3027 character(len=*),
intent(in) :: val
3032 log_error(
"FILE_set_attribute_text",*)
'File is not opened. fid = ', fid
3036 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3039 cstr(vname), cstr(key), &
3041 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
3042 log_error(
"FILE_set_attribute_text",*)
'failed to set text attribute for '//trim(vname)//
': '//trim(key)
3046 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3049 end subroutine file_set_attribute_text
3051 subroutine file_set_attribute_logical( &
3054 integer,
intent(in) :: fid
3055 character(len=*),
intent(in) :: vname
3056 character(len=*),
intent(in) :: key
3057 logical,
intent(in) :: val
3059 character(len=5) :: buf
3062 log_error(
"FILE_set_attribute_logical",*)
'File is not opened. fid = ', fid
3072 call file_set_attribute_text( fid, vname, key, buf )
3075 end subroutine file_set_attribute_logical
3078 subroutine file_set_attribute_int_ary( &
3081 integer,
intent(in) :: fid
3082 character(len=*),
intent(in) :: vname
3083 character(len=*),
intent(in) :: key
3084 integer,
intent(in) :: val(:)
3091 log_error(
"FILE_set_attribute_int",*)
'File is not opened. fid = ', fid
3095 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3098 cstr(vname), cstr(key), &
3099 val(:),
size(val(:)) )
3100 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
3101 log_error(
"FILE_set_attribute_int",*)
'failed to set integer attribute for '//trim(vname)//
': '//trim(key)
3105 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3108 end subroutine file_set_attribute_int_ary
3110 subroutine file_set_attribute_int( &
3113 integer,
intent(in) :: fid
3114 character(len=*),
intent(in) :: vname
3115 character(len=*),
intent(in) :: key
3116 integer,
intent(in) :: val
3121 call file_set_attribute_int_ary( fid, vname, &
3125 end subroutine file_set_attribute_int
3128 subroutine file_set_attribute_float_ary( &
3131 integer,
intent(in) :: fid
3132 character(len=*),
intent(in) :: vname
3133 character(len=*),
intent(in) :: key
3134 real(sp),
intent(in) :: val(:)
3141 log_error(
"FILE_set_attributefloat",*)
'File is not opened. fid = ', fid
3145 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3148 cstr(vname), cstr(key), &
3149 val(:),
size(val(:)) )
3150 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
3151 log_error(
"FILE_set_attribute_float",*)
'failed to set float attribute for '//trim(vname)//
': '//trim(key)
3155 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3158 end subroutine file_set_attribute_float_ary
3160 subroutine file_set_attribute_float( &
3163 integer,
intent(in) :: fid
3164 character(len=*),
intent(in) :: vname
3165 character(len=*),
intent(in) :: key
3166 real(sp),
intent(in) :: val
3171 call file_set_attribute_float_ary( fid, vname, &
3175 end subroutine file_set_attribute_float
3177 subroutine file_set_attribute_double_ary( &
3180 integer,
intent(in) :: fid
3181 character(len=*),
intent(in) :: vname
3182 character(len=*),
intent(in) :: key
3183 real(dp),
intent(in) :: val(:)
3190 log_error(
"FILE_set_attributedouble",*)
'File is not opened. fid = ', fid
3194 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3197 cstr(vname), cstr(key), &
3198 val(:),
size(val(:)) )
3199 if ( error /= file_success_code .and. error /= file_already_existed_code )
then
3200 log_error(
"FILE_set_attribute_double",*)
'failed to set double attribute for '//trim(vname)//
': '//trim(key)
3204 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
3207 end subroutine file_set_attribute_double_ary
3209 subroutine file_set_attribute_double( &
3212 integer,
intent(in) :: fid
3213 character(len=*),
intent(in) :: vname
3214 character(len=*),
intent(in) :: key
3215 real(dp),
intent(in) :: val
3220 call file_set_attribute_double_ary( fid, vname, &
3224 end subroutine file_set_attribute_double
3228 subroutine file_get_shape_fname( &
3229 basename, varname, &
3236 character(len=*),
intent( in) :: basename
3237 character(len=*),
intent( in) :: varname
3238 integer,
intent(out) :: dims(:)
3239 integer,
intent( in),
optional :: rankid
3240 logical,
intent( in),
optional :: single
3241 logical,
intent(out),
optional :: has_tdim
3242 logical,
intent(out),
optional :: error
3250 rankid=rankid, single=single )
3252 call file_get_shape_fid( fid, varname, &
3254 has_tdim = has_tdim, &
3258 end subroutine file_get_shape_fname
3260 subroutine file_get_shape_fid( &
3266 integer,
intent( in) :: fid
3267 character(len=*),
intent( in) :: varname
3268 integer,
intent(out) :: dims(:)
3269 logical,
intent(out),
optional :: has_tdim
3270 logical,
intent(out),
optional :: error
3272 type(datainfo) :: dinfo
3276 logical(c_bool) :: suppress
3282 log_error(
"FILE_get_shape_id",*)
'File is not opened. fid = ', fid
3286 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3288 if (
present(error) )
then
3296 file_files(fid)%fid, &
3300 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3303 if ( ierror /= file_success_code )
then
3304 if (
present(error) )
then
3308 log_error(
"FILE_get_shape_fid",*)
'failed to get data information : ', trim(varname)
3313 if ( dinfo%rank /=
size(dims) )
then
3314 log_error(
"FILE_get_shape_fid",*)
'rank is different, ', trim(varname),
size(dims), dinfo%rank
3317 do n = 1,
size(dims)
3318 dims(n) = dinfo%dim_size(n)
3321 if (
present(has_tdim) ) has_tdim = dinfo%has_tdim
3322 if (
present(error) ) error = .false.
3325 end subroutine file_get_shape_fid
3334 integer,
intent(in) :: fid
3335 character(len=*),
intent(in) :: varname
3337 integer,
intent(out) :: len
3339 logical,
intent(out),
optional :: error
3344 log_error(
"FILE_get_stepSize",*)
'File is not opened. fid = ', fid
3348 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3351 file_files(fid)%fid, cstr(varname) )
3352 if ( ierror /= file_success_code .and. ierror /= file_already_existed_code )
then
3353 if (
present(error) )
then
3356 log_error(
"FILE_get_stepSize",*)
'failed to get number of steps'
3360 if (
present(error) ) error = .false.
3363 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3371 subroutine file_get_commoninfo_fname( &
3382 character(len=*),
intent(in) :: basename
3383 integer,
intent(in) :: rankid
3384 integer,
intent(in) :: nvars_limit
3385 character(len=FILE_HMID),
intent(out) :: title
3386 character(len=FILE_HMID),
intent(out) :: source
3387 character(len=FILE_HMID),
intent(out) :: institution
3388 integer,
intent(out) :: nvars
3389 character(len=FILE_HSHORT),
intent(out) :: varname(nvars_limit)
3398 call file_get_commoninfo_fid( fid, &
3407 end subroutine file_get_commoninfo_fname
3409 subroutine file_get_commoninfo_fid( &
3419 integer,
intent(in) :: fid
3420 integer,
intent(in) :: nvars_limit
3421 character(len=FILE_HMID),
intent(out) :: title
3422 character(len=FILE_HMID),
intent(out) :: source
3423 character(len=FILE_HMID),
intent(out) :: institution
3424 integer,
intent(out) :: nvars
3425 character(len=FILE_HSHORT),
intent(out) :: varname(nvars_limit)
3431 log_error(
"FILE_get_commonInfo_fid",*)
'File is not opened. fid = ', fid
3435 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3437 call file_get_attribute( fid,
'global',
'title', title )
3438 call file_get_attribute( fid,
'global',
'source', source )
3439 call file_get_attribute( fid,
'global',
'institution', institution )
3441 call file_get_var_num( fid, nvars_limit, nvars )
3444 call file_get_var_name( fid, v, varname(v) )
3447 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3450 end subroutine file_get_commoninfo_fid
3455 subroutine file_get_datainfo_fname( &
3456 basename, varname, &
3457 rankid, istep, single, &
3459 description, units, standard_name, &
3461 dim_rank, dim_name, dim_size, &
3462 natts, att_name, att_type, att_len, &
3464 time_start, time_end, time_units, &
3468 character(len=*),
intent(in) :: basename
3469 character(len=*),
intent(in) :: varname
3471 integer,
intent(in),
optional :: rankid
3472 integer,
intent(in),
optional :: istep
3473 logical,
intent(in),
optional :: single
3474 logical,
intent(out),
optional :: existed
3475 character(len=FILE_HMID),
intent(out),
optional :: description
3476 character(len=FILE_HSHORT),
intent(out),
optional :: units
3477 character(len=FILE_HMID),
intent(out),
optional :: standard_name
3478 integer,
intent(out),
optional :: datatype
3479 integer,
intent(out),
optional :: dim_rank
3480 character(len=FILE_HSHORT),
intent(out),
optional :: dim_name(:)
3481 integer,
intent(out),
optional :: dim_size(:)
3482 integer,
intent(out),
optional :: natts
3483 character(len=FILE_HSHORT),
intent(out),
optional :: att_name(:)
3484 integer,
intent(out),
optional :: att_type(:)
3485 integer,
intent(out),
optional :: att_len (:)
3486 logical,
intent(out),
optional :: has_tdim
3487 real(dp),
intent(out),
optional :: time_start
3488 real(dp),
intent(out),
optional :: time_end
3489 character(len=FILE_HMID),
intent(out),
optional :: time_units
3490 character(len=FILE_HSHORT),
intent(out),
optional :: calendar
3496 if (
present(single) )
then
3505 rankid=rankid, single=single_ )
3507 call file_get_datainfo_fid( fid, varname, &
3510 description, units, standard_name, &
3512 dim_rank, dim_name, dim_size, &
3513 natts, att_name, att_type, att_len, &
3515 time_start, time_end, time_units, &
3519 end subroutine file_get_datainfo_fname
3521 subroutine file_get_datainfo_fid( &
3525 description, units, standard_name, &
3527 dim_rank, dim_name, dim_size, &
3528 natts, att_name, att_type, att_len, &
3530 time_start, time_end, time_units, &
3534 integer,
intent(in) :: fid
3535 character(len=*),
intent(in) :: varname
3537 integer,
intent(in),
optional :: istep
3538 logical,
intent(out),
optional :: existed
3539 character(len=*),
intent(out),
optional :: description
3540 character(len=*),
intent(out),
optional :: units
3541 character(len=*),
intent(out),
optional :: standard_name
3542 integer,
intent(out),
optional :: datatype
3543 integer,
intent(out),
optional :: dim_rank
3544 character(len=*),
intent(out),
optional :: dim_name(:)
3545 integer,
intent(out),
optional :: dim_size(:)
3546 integer,
intent(out),
optional :: natts
3547 character(len=*),
intent(out),
optional :: att_name(:)
3548 integer,
intent(out),
optional :: att_type(:)
3549 integer,
intent(out),
optional :: att_len (:)
3550 logical,
intent(out),
optional :: has_tdim
3551 real(dp),
intent(out),
optional :: time_start
3552 real(dp),
intent(out),
optional :: time_end
3553 character(len=*),
intent(out),
optional :: time_units
3554 character(len=*),
intent(out),
optional :: calendar
3556 type(datainfo) :: dinfo
3563 logical(c_bool) :: suppress
3566 character(len=FILE_HMID) :: tu
3571 if (
present(istep) )
then
3577 if (
present(existed) )
then
3584 log_error(
"FILE_get_dataInfo_fid",*)
'File is not opened. fid = ', fid
3588 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3592 file_files(fid)%fid, &
3597 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3600 if ( error /= file_success_code )
then
3601 if (
present( existed ) )
then
3605 log_error(
"FILE_get_dataInfo_fid",*)
'data info not found'
3610 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3612 if (
present(existed) ) existed = .true.
3614 if (
present(description) )
call fstr(description, dinfo%description)
3615 if (
present(units) )
call fstr(units, dinfo%units)
3616 if (
present(standard_name) )
call fstr(standard_name, dinfo%standard_name)
3617 if (
present(datatype) ) datatype = dinfo%datatype
3618 if (
present(dim_rank) ) dim_rank = dinfo%rank
3620 if (
present(dim_name) )
then
3621 do i = 1, min( dinfo%rank,
size(dim_name) )
3622 call fstr(dim_name(
i), dinfo%dim_name(:,
i))
3626 if (
present(dim_size) )
then
3627 do i = 1, min( dinfo%rank,
size(dim_size) )
3628 dim_size(
i) = dinfo%dim_size(
i)
3632 if (
present(natts) ) natts = dinfo%natts
3633 if (
present(att_name) )
then
3634 do i = 1, min( dinfo%natts,
size(att_name) )
3635 call fstr(att_name(
i), dinfo%att_name(:,
i))
3638 if (
present(att_type) )
then
3639 do i = 1, min( dinfo%natts,
size(att_type) )
3640 att_type(
i) = dinfo%att_type(
i)
3643 if (
present(att_len) )
then
3644 do i = 1, min( dinfo%natts,
size(att_len) )
3645 att_len(
i) = dinfo%att_len(
i)
3649 call fstr(tu, dinfo%time_units)
3651 if (
present(time_units) )
then
3652 if ( tu ==
"" )
then
3653 call file_get_attribute( fid,
"global",
"time_units", time_units )
3659 if (
present(calendar) )
then
3660 if ( tu ==
"" )
then
3661 call file_get_attribute( fid,
"global",
"calendar", calendar, existed2 )
3662 if ( .not. existed2 ) calendar =
""
3664 call fstr(calendar, dinfo%calendar)
3668 if (
present(has_tdim) )
then
3669 has_tdim = dinfo%has_tdim
3672 if (
present(time_start) )
then
3673 if ( tu ==
"" )
then
3674 call file_get_attribute( fid,
"global",
"time_start", time )
3675 time_start = time(1)
3677 time_start = dinfo%time_start
3681 if (
present(time_end) )
then
3682 if ( tu ==
"" )
then
3683 call file_get_attribute( fid,
"global",
"time_start", time )
3686 time_end = dinfo%time_end
3690 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3693 end subroutine file_get_datainfo_fid
3698 subroutine file_get_all_datainfo_fname( &
3699 basename, varname, &
3701 description, units, standard_name, &
3703 dim_rank, dim_name, dim_size, &
3704 natts, att_name, att_type, att_len, &
3705 time_start, time_end, &
3706 time_units, calendar, &
3709 character(len=*),
intent(in) :: basename
3710 character(len=*),
intent(in) :: varname
3711 integer,
intent(out) :: step_nmax
3712 character(len=FILE_HMID),
intent(out) :: description
3713 character(len=FILE_HSHORT),
intent(out) :: units
3714 character(len=FILE_HMID),
intent(out) :: standard_name
3715 integer,
intent(out) :: datatype
3716 integer,
intent(out) :: dim_rank
3717 character(len=FILE_HSHORT),
intent(out) :: dim_name (:)
3718 integer,
intent(out) :: dim_size (:)
3719 integer,
intent(out) :: natts
3720 character(len=FILE_HSHORT),
intent(out) :: att_name (:)
3721 integer,
intent(out) :: att_type (:)
3722 integer,
intent(out) :: att_len (:)
3723 real(dp),
intent(out) :: time_start(:)
3724 real(dp),
intent(out) :: time_end (:)
3725 character(len=FILE_HMID),
intent(out) :: time_units
3726 character(len=FILE_HSHORT),
intent(out) :: calendar
3728 integer,
intent(in),
optional :: rankid
3729 logical,
intent(in),
optional :: single
3735 if (
present(single) )
then
3744 rankid=rankid, single=single_ )
3746 call file_get_all_datainfo_fid( fid, varname, &
3748 description, units, standard_name, &
3750 dim_rank, dim_name(:), dim_size(:), &
3751 natts, att_name(:), att_type(:), att_len(:), &
3752 time_start(:), time_end(:), &
3753 time_units, calendar )
3756 end subroutine file_get_all_datainfo_fname
3758 subroutine file_get_all_datainfo_fid( &
3761 description, units, standard_name, &
3763 dim_rank, dim_name, dim_size, &
3764 natts, att_name, att_type, att_len, &
3765 time_start, time_end, &
3766 time_units, calendar )
3769 integer,
intent(in) :: fid
3770 character(len=*),
intent(in) :: varname
3771 integer,
intent(out) :: step_nmax
3772 character(len=*),
intent(out) :: description
3773 character(len=*),
intent(out) :: units
3774 character(len=*),
intent(out) :: standard_name
3775 integer,
intent(out) :: datatype
3776 integer,
intent(out) :: dim_rank
3777 character(len=*),
intent(out) :: dim_name (:)
3778 integer,
intent(out) :: dim_size (:)
3779 integer,
intent(out) :: natts
3780 character(len=*),
intent(out) :: att_name (:)
3781 integer,
intent(out) :: att_type (:)
3782 integer,
intent(out) :: att_len (:)
3783 real(dp),
intent(out) :: time_start(:)
3784 real(dp),
intent(out) :: time_end (:)
3785 character(len=*),
intent(out) :: time_units
3786 character(len=*),
intent(out) :: calendar
3788 type(datainfo) :: dinfo
3796 integer :: istep_max
3798 logical(c_bool) :: suppress
3799 character(len=FILE_HMID) :: tu
3805 log_error(
"FILE_get_all_dataInfo_fid",*)
'File is not opened. fid = ', fid
3809 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3819 time_start(:) = file_rmiss
3820 time_end(:) = file_rmiss
3823 istep_max = min(
size(time_start),
size(time_end) )
3824 do istep = 1, istep_max
3827 file_files(fid)%fid, &
3832 if ( error /= file_success_code )
then
3833 step_nmax = istep - 1
3837 if ( istep == 1 )
then
3838 call fstr(description, dinfo%description)
3839 call fstr(units, dinfo%units)
3840 call fstr(standard_name, dinfo%standard_name)
3841 datatype = dinfo%datatype
3842 dim_rank = dinfo%rank
3845 do i = 1, min( dinfo%rank,
size(dim_name) )
3846 call fstr(dim_name(
i), dinfo%dim_name(:,
i))
3847 dim_size(
i) = dinfo%dim_size(
i)
3850 do i = 1, min( dinfo%natts,
size(att_name) )
3851 call fstr(att_name(
i), dinfo%att_name(:,
i))
3852 att_type(
i) = dinfo%att_type(
i)
3853 att_len(
i) = dinfo%att_len (
i)
3856 call fstr(tu, dinfo%time_units)
3857 if ( tu ==
"" )
then
3858 call file_get_attribute( fid,
"global",
"time_units", time_units )
3859 call file_get_attribute( fid,
"global",
"calendar", calendar, existed )
3860 if ( .not. existed ) calendar =
""
3861 call file_get_attribute( fid,
"global",
"time_start", time )
3862 time_start(1) = time(1)
3863 time_end(1) = time(1)
3868 time_start(1) = dinfo%time_start
3869 time_end(1) = dinfo%time_end
3870 call fstr(calendar, dinfo%calendar)
3873 time_start(istep) = dinfo%time_start
3874 time_end(istep) = dinfo%time_end
3878 if ( istep == istep_max + 1 )
then
3879 if ( error /= file_success_code )
then
3880 log_error(
"FILE_get_all_dataInfo_fid",*)
'size of time is not enough: ', istep_max
3883 step_nmax = istep - 1
3887 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
3890 end subroutine file_get_all_datainfo_fid
3895 subroutine file_read_realsp_1d( &
3896 basename, varname, &
3898 step, rankid, single, postfix, &
3899 allow_missing, missing_value )
3902 character(len=*),
intent( in) :: basename
3903 character(len=*),
intent( in) :: varname
3904 real(sp),
intent(out) :: var(:)
3905 integer,
intent( in),
optional :: step
3906 integer,
intent( in),
optional :: rankid
3907 logical,
intent( in),
optional :: single
3908 character(len=*),
intent( in),
optional :: postfix
3909 logical,
intent( in),
optional :: allow_missing
3910 real(sp),
intent( in),
optional :: missing_value
3920 rankid=rankid, single=single, &
3923 call file_read_var_realsp_1d( &
3927 allow_missing=allow_missing, missing_value=missing_value )
3930 end subroutine file_read_realsp_1d
3931 subroutine file_read_realdp_1d( &
3932 basename, varname, &
3934 step, rankid, single, postfix, &
3935 allow_missing, missing_value )
3938 character(len=*),
intent( in) :: basename
3939 character(len=*),
intent( in) :: varname
3940 real(dp),
intent(out) :: var(:)
3941 integer,
intent( in),
optional :: step
3942 integer,
intent( in),
optional :: rankid
3943 logical,
intent( in),
optional :: single
3944 character(len=*),
intent( in),
optional :: postfix
3945 logical,
intent( in),
optional :: allow_missing
3946 real(dp),
intent( in),
optional :: missing_value
3956 rankid=rankid, single=single, &
3959 call file_read_var_realdp_1d( &
3963 allow_missing=allow_missing, missing_value=missing_value )
3966 end subroutine file_read_realdp_1d
3967 subroutine file_read_realsp_2d( &
3968 basename, varname, &
3970 step, rankid, single, postfix, &
3971 allow_missing, missing_value )
3974 character(len=*),
intent( in) :: basename
3975 character(len=*),
intent( in) :: varname
3976 real(sp),
intent(out) :: var(:,:)
3977 integer,
intent( in),
optional :: step
3978 integer,
intent( in),
optional :: rankid
3979 logical,
intent( in),
optional :: single
3980 character(len=*),
intent( in),
optional :: postfix
3981 logical,
intent( in),
optional :: allow_missing
3982 real(sp),
intent( in),
optional :: missing_value
3992 rankid=rankid, single=single, &
3995 call file_read_var_realsp_2d( &
3999 allow_missing=allow_missing, missing_value=missing_value )
4002 end subroutine file_read_realsp_2d
4003 subroutine file_read_realdp_2d( &
4004 basename, varname, &
4006 step, rankid, single, postfix, &
4007 allow_missing, missing_value )
4010 character(len=*),
intent( in) :: basename
4011 character(len=*),
intent( in) :: varname
4012 real(dp),
intent(out) :: var(:,:)
4013 integer,
intent( in),
optional :: step
4014 integer,
intent( in),
optional :: rankid
4015 logical,
intent( in),
optional :: single
4016 character(len=*),
intent( in),
optional :: postfix
4017 logical,
intent( in),
optional :: allow_missing
4018 real(dp),
intent( in),
optional :: missing_value
4028 rankid=rankid, single=single, &
4031 call file_read_var_realdp_2d( &
4035 allow_missing=allow_missing, missing_value=missing_value )
4038 end subroutine file_read_realdp_2d
4039 subroutine file_read_realsp_3d( &
4040 basename, varname, &
4042 step, rankid, single, postfix, &
4043 allow_missing, missing_value )
4046 character(len=*),
intent( in) :: basename
4047 character(len=*),
intent( in) :: varname
4048 real(sp),
intent(out) :: var(:,:,:)
4049 integer,
intent( in),
optional :: step
4050 integer,
intent( in),
optional :: rankid
4051 logical,
intent( in),
optional :: single
4052 character(len=*),
intent( in),
optional :: postfix
4053 logical,
intent( in),
optional :: allow_missing
4054 real(sp),
intent( in),
optional :: missing_value
4064 rankid=rankid, single=single, &
4067 call file_read_var_realsp_3d( &
4071 allow_missing=allow_missing, missing_value=missing_value )
4074 end subroutine file_read_realsp_3d
4075 subroutine file_read_realdp_3d( &
4076 basename, varname, &
4078 step, rankid, single, postfix, &
4079 allow_missing, missing_value )
4082 character(len=*),
intent( in) :: basename
4083 character(len=*),
intent( in) :: varname
4084 real(dp),
intent(out) :: var(:,:,:)
4085 integer,
intent( in),
optional :: step
4086 integer,
intent( in),
optional :: rankid
4087 logical,
intent( in),
optional :: single
4088 character(len=*),
intent( in),
optional :: postfix
4089 logical,
intent( in),
optional :: allow_missing
4090 real(dp),
intent( in),
optional :: missing_value
4100 rankid=rankid, single=single, &
4103 call file_read_var_realdp_3d( &
4107 allow_missing=allow_missing, missing_value=missing_value )
4110 end subroutine file_read_realdp_3d
4111 subroutine file_read_realsp_4d( &
4112 basename, varname, &
4114 step, rankid, single, postfix, &
4115 allow_missing, missing_value )
4118 character(len=*),
intent( in) :: basename
4119 character(len=*),
intent( in) :: varname
4120 real(sp),
intent(out) :: var(:,:,:,:)
4121 integer,
intent( in),
optional :: step
4122 integer,
intent( in),
optional :: rankid
4123 logical,
intent( in),
optional :: single
4124 character(len=*),
intent( in),
optional :: postfix
4125 logical,
intent( in),
optional :: allow_missing
4126 real(sp),
intent( in),
optional :: missing_value
4136 rankid=rankid, single=single, &
4139 call file_read_var_realsp_4d( &
4143 allow_missing=allow_missing, missing_value=missing_value )
4146 end subroutine file_read_realsp_4d
4147 subroutine file_read_realdp_4d( &
4148 basename, varname, &
4150 step, rankid, single, postfix, &
4151 allow_missing, missing_value )
4154 character(len=*),
intent( in) :: basename
4155 character(len=*),
intent( in) :: varname
4156 real(dp),
intent(out) :: var(:,:,:,:)
4157 integer,
intent( in),
optional :: step
4158 integer,
intent( in),
optional :: rankid
4159 logical,
intent( in),
optional :: single
4160 character(len=*),
intent( in),
optional :: postfix
4161 logical,
intent( in),
optional :: allow_missing
4162 real(dp),
intent( in),
optional :: missing_value
4172 rankid=rankid, single=single, &
4175 call file_read_var_realdp_4d( &
4179 allow_missing=allow_missing, missing_value=missing_value )
4182 end subroutine file_read_realdp_4d
4184 subroutine file_read_var_realsp_1d( &
4194 integer,
intent( in) :: fid
4195 character(len=*),
intent( in) :: varname
4197 real(sp),
intent(out),
target :: var(:)
4199 real(sp),
intent(out),
target,
contiguous :: var(:)
4201 integer,
intent( in),
optional :: step
4202 logical,
intent( in),
optional :: allow_missing
4203 real(sp),
intent( in),
optional :: missing_value
4204 integer,
intent( in),
optional :: ntypes
4205 integer,
intent( in),
optional :: dtype
4206 integer,
intent( in),
optional :: start(:)
4207 integer,
intent( in),
optional :: count(:)
4210 logical(c_bool) :: allow_missing_
4211 real(sp) :: missing_value_
4213 type(datainfo) :: dinfo
4214 integer :: dim_size(1)
4219 intrinsic size, shape
4223 log_error(
"FILE_read_var_realSP_1D",*)
'File is not opened. fid = ', fid
4227 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4229 if (
present(step) )
then
4235 if (
present(allow_missing) )
then
4236 allow_missing_ = allow_missing
4238 allow_missing_ = .false.
4241 if (
present(missing_value) )
then
4242 missing_value_ = missing_value
4244 missing_value_ = 0.0_sp
4249 file_files(fid)%fid, &
4251 step_, allow_missing_ )
4254 if ( error /= file_success_code )
then
4255 if ( allow_missing_ )
then
4256 log_info(
"FILE_read_var_realSP_1D",*)
'[INPUT]/[FILE] data not found! : ', &
4257 'varname= ',trim(varname),
', step=',step_
4258 log_info(
"FILE_read_var_realSP_1D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
4259 var(:) = missing_value_
4262 log_error(
"FILE_read_var_realSP_1D",*)
'failed to get data information :'//trim(varname)
4267 if ( dinfo%rank /= 1 )
then
4268 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
4269 log_error(
"FILE_read_var_realSP_1D",*)
'rank of '//trim(varname)//
' is not 1', dinfo%rank
4274 if (
present(ntypes) )
then
4275 #if defined(__GFORTRAN__) && __GNUC__ < 7
4280 dinfo, sp, ntypes, dtype, start(:), count(:) )
4281 else if (
present(start) .and.
present(count) )
then
4284 real(sp),
allocatable,
target :: work(:)
4285 allocate(work, mold=var)
4288 #if defined(__GFORTRAN__) && __GNUC__ < 7
4290 #elif defined(NVIDIA)
4295 dinfo, sp, 0, 0, start(:), count(:) )
4301 dim_size(:) = shape(var)
4303 if ( dinfo%dim_size(n) /= dim_size(n) )
then
4304 log_error(
"FILE_read_var_realSP_1D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
4310 real(sp),
allocatable,
target :: work(:)
4311 allocate(work, mold=var)
4314 #if defined(__GFORTRAN__) && __GNUC__ < 7
4316 #elif defined(NVIDIA)
4321 dinfo, sp, 0, 0, (/0/), (/0/) )
4327 if ( error /= file_success_code )
then
4328 log_error(
"FILE_read_var_realSP_1D",*)
'failed to get data value: ', trim(varname)
4334 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4337 end subroutine file_read_var_realsp_1d
4338 subroutine file_read_var_realdp_1d( &
4348 integer,
intent( in) :: fid
4349 character(len=*),
intent( in) :: varname
4351 real(dp),
intent(out),
target :: var(:)
4353 real(dp),
intent(out),
target,
contiguous :: var(:)
4355 integer,
intent( in),
optional :: step
4356 logical,
intent( in),
optional :: allow_missing
4357 real(dp),
intent( in),
optional :: missing_value
4358 integer,
intent( in),
optional :: ntypes
4359 integer,
intent( in),
optional :: dtype
4360 integer,
intent( in),
optional :: start(:)
4361 integer,
intent( in),
optional :: count(:)
4364 logical(c_bool) :: allow_missing_
4365 real(dp) :: missing_value_
4367 type(datainfo) :: dinfo
4368 integer :: dim_size(1)
4373 intrinsic size, shape
4377 log_error(
"FILE_read_var_realDP_1D",*)
'File is not opened. fid = ', fid
4381 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4383 if (
present(step) )
then
4389 if (
present(allow_missing) )
then
4390 allow_missing_ = allow_missing
4392 allow_missing_ = .false.
4395 if (
present(missing_value) )
then
4396 missing_value_ = missing_value
4398 missing_value_ = 0.0_dp
4403 file_files(fid)%fid, &
4405 step_, allow_missing_ )
4408 if ( error /= file_success_code )
then
4409 if ( allow_missing_ )
then
4410 log_info(
"FILE_read_var_realDP_1D",*)
'[INPUT]/[FILE] data not found! : ', &
4411 'varname= ',trim(varname),
', step=',step_
4412 log_info(
"FILE_read_var_realDP_1D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
4413 var(:) = missing_value_
4416 log_error(
"FILE_read_var_realDP_1D",*)
'failed to get data information :'//trim(varname)
4421 if ( dinfo%rank /= 1 )
then
4422 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
4423 log_error(
"FILE_read_var_realDP_1D",*)
'rank of '//trim(varname)//
' is not 1', dinfo%rank
4428 if (
present(ntypes) )
then
4429 #if defined(__GFORTRAN__) && __GNUC__ < 7
4434 dinfo, dp, ntypes, dtype, start(:), count(:) )
4435 else if (
present(start) .and.
present(count) )
then
4438 real(dp),
allocatable,
target :: work(:)
4439 allocate(work, mold=var)
4442 #if defined(__GFORTRAN__) && __GNUC__ < 7
4444 #elif defined(NVIDIA)
4449 dinfo, dp, 0, 0, start(:), count(:) )
4455 dim_size(:) = shape(var)
4457 if ( dinfo%dim_size(n) /= dim_size(n) )
then
4458 log_error(
"FILE_read_var_realDP_1D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
4464 real(dp),
allocatable,
target :: work(:)
4465 allocate(work, mold=var)
4468 #if defined(__GFORTRAN__) && __GNUC__ < 7
4470 #elif defined(NVIDIA)
4475 dinfo, dp, 0, 0, (/0/), (/0/) )
4481 if ( error /= file_success_code )
then
4482 log_error(
"FILE_read_var_realDP_1D",*)
'failed to get data value: ', trim(varname)
4488 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4491 end subroutine file_read_var_realdp_1d
4492 subroutine file_read_var_realsp_2d( &
4502 integer,
intent( in) :: fid
4503 character(len=*),
intent( in) :: varname
4505 real(sp),
intent(out),
target :: var(:,:)
4507 real(sp),
intent(out),
target,
contiguous :: var(:,:)
4509 integer,
intent( in),
optional :: step
4510 logical,
intent( in),
optional :: allow_missing
4511 real(sp),
intent( in),
optional :: missing_value
4512 integer,
intent( in),
optional :: ntypes
4513 integer,
intent( in),
optional :: dtype
4514 integer,
intent( in),
optional :: start(:)
4515 integer,
intent( in),
optional :: count(:)
4518 logical(c_bool) :: allow_missing_
4519 real(sp) :: missing_value_
4521 type(datainfo) :: dinfo
4522 integer :: dim_size(2)
4527 intrinsic size, shape
4531 log_error(
"FILE_read_var_realSP_2D",*)
'File is not opened. fid = ', fid
4535 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4537 if (
present(step) )
then
4543 if (
present(allow_missing) )
then
4544 allow_missing_ = allow_missing
4546 allow_missing_ = .false.
4549 if (
present(missing_value) )
then
4550 missing_value_ = missing_value
4552 missing_value_ = 0.0_sp
4557 file_files(fid)%fid, &
4559 step_, allow_missing_ )
4562 if ( error /= file_success_code )
then
4563 if ( allow_missing_ )
then
4564 log_info(
"FILE_read_var_realSP_2D",*)
'[INPUT]/[FILE] data not found! : ', &
4565 'varname= ',trim(varname),
', step=',step_
4566 log_info(
"FILE_read_var_realSP_2D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
4567 var(:,:) = missing_value_
4570 log_error(
"FILE_read_var_realSP_2D",*)
'failed to get data information :'//trim(varname)
4575 if ( dinfo%rank /= 2 )
then
4576 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
4577 log_error(
"FILE_read_var_realSP_2D",*)
'rank of '//trim(varname)//
' is not 2', dinfo%rank
4582 if (
present(ntypes) )
then
4583 #if defined(__GFORTRAN__) && __GNUC__ < 7
4588 dinfo, sp, ntypes, dtype, start(:), count(:) )
4589 else if (
present(start) .and.
present(count) )
then
4592 real(sp),
allocatable,
target :: work(:,:)
4593 allocate(work, mold=var)
4596 #if defined(__GFORTRAN__) && __GNUC__ < 7
4598 #elif defined(NVIDIA)
4603 dinfo, sp, 0, 0, start(:), count(:) )
4609 dim_size(:) = shape(var)
4611 if ( dinfo%dim_size(n) /= dim_size(n) )
then
4612 log_error(
"FILE_read_var_realSP_2D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
4618 real(sp),
allocatable,
target :: work(:,:)
4619 allocate(work, mold=var)
4622 #if defined(__GFORTRAN__) && __GNUC__ < 7
4624 #elif defined(NVIDIA)
4629 dinfo, sp, 0, 0, (/0/), (/0/) )
4635 if ( error /= file_success_code )
then
4636 log_error(
"FILE_read_var_realSP_2D",*)
'failed to get data value: ', trim(varname)
4642 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4645 end subroutine file_read_var_realsp_2d
4646 subroutine file_read_var_realdp_2d( &
4656 integer,
intent( in) :: fid
4657 character(len=*),
intent( in) :: varname
4659 real(dp),
intent(out),
target :: var(:,:)
4661 real(dp),
intent(out),
target,
contiguous :: var(:,:)
4663 integer,
intent( in),
optional :: step
4664 logical,
intent( in),
optional :: allow_missing
4665 real(dp),
intent( in),
optional :: missing_value
4666 integer,
intent( in),
optional :: ntypes
4667 integer,
intent( in),
optional :: dtype
4668 integer,
intent( in),
optional :: start(:)
4669 integer,
intent( in),
optional :: count(:)
4672 logical(c_bool) :: allow_missing_
4673 real(dp) :: missing_value_
4675 type(datainfo) :: dinfo
4676 integer :: dim_size(2)
4681 intrinsic size, shape
4685 log_error(
"FILE_read_var_realDP_2D",*)
'File is not opened. fid = ', fid
4689 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4691 if (
present(step) )
then
4697 if (
present(allow_missing) )
then
4698 allow_missing_ = allow_missing
4700 allow_missing_ = .false.
4703 if (
present(missing_value) )
then
4704 missing_value_ = missing_value
4706 missing_value_ = 0.0_dp
4711 file_files(fid)%fid, &
4713 step_, allow_missing_ )
4716 if ( error /= file_success_code )
then
4717 if ( allow_missing_ )
then
4718 log_info(
"FILE_read_var_realDP_2D",*)
'[INPUT]/[FILE] data not found! : ', &
4719 'varname= ',trim(varname),
', step=',step_
4720 log_info(
"FILE_read_var_realDP_2D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
4721 var(:,:) = missing_value_
4724 log_error(
"FILE_read_var_realDP_2D",*)
'failed to get data information :'//trim(varname)
4729 if ( dinfo%rank /= 2 )
then
4730 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
4731 log_error(
"FILE_read_var_realDP_2D",*)
'rank of '//trim(varname)//
' is not 2', dinfo%rank
4736 if (
present(ntypes) )
then
4737 #if defined(__GFORTRAN__) && __GNUC__ < 7
4742 dinfo, dp, ntypes, dtype, start(:), count(:) )
4743 else if (
present(start) .and.
present(count) )
then
4746 real(dp),
allocatable,
target :: work(:,:)
4747 allocate(work, mold=var)
4750 #if defined(__GFORTRAN__) && __GNUC__ < 7
4752 #elif defined(NVIDIA)
4757 dinfo, dp, 0, 0, start(:), count(:) )
4763 dim_size(:) = shape(var)
4765 if ( dinfo%dim_size(n) /= dim_size(n) )
then
4766 log_error(
"FILE_read_var_realDP_2D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
4772 real(dp),
allocatable,
target :: work(:,:)
4773 allocate(work, mold=var)
4776 #if defined(__GFORTRAN__) && __GNUC__ < 7
4778 #elif defined(NVIDIA)
4783 dinfo, dp, 0, 0, (/0/), (/0/) )
4789 if ( error /= file_success_code )
then
4790 log_error(
"FILE_read_var_realDP_2D",*)
'failed to get data value: ', trim(varname)
4796 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4799 end subroutine file_read_var_realdp_2d
4800 subroutine file_read_var_realsp_3d( &
4810 integer,
intent( in) :: fid
4811 character(len=*),
intent( in) :: varname
4813 real(sp),
intent(out),
target :: var(:,:,:)
4815 real(sp),
intent(out),
target,
contiguous :: var(:,:,:)
4817 integer,
intent( in),
optional :: step
4818 logical,
intent( in),
optional :: allow_missing
4819 real(sp),
intent( in),
optional :: missing_value
4820 integer,
intent( in),
optional :: ntypes
4821 integer,
intent( in),
optional :: dtype
4822 integer,
intent( in),
optional :: start(:)
4823 integer,
intent( in),
optional :: count(:)
4826 logical(c_bool) :: allow_missing_
4827 real(sp) :: missing_value_
4829 type(datainfo) :: dinfo
4830 integer :: dim_size(3)
4835 intrinsic size, shape
4839 log_error(
"FILE_read_var_realSP_3D",*)
'File is not opened. fid = ', fid
4843 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4845 if (
present(step) )
then
4851 if (
present(allow_missing) )
then
4852 allow_missing_ = allow_missing
4854 allow_missing_ = .false.
4857 if (
present(missing_value) )
then
4858 missing_value_ = missing_value
4860 missing_value_ = 0.0_sp
4865 file_files(fid)%fid, &
4867 step_, allow_missing_ )
4870 if ( error /= file_success_code )
then
4871 if ( allow_missing_ )
then
4872 log_info(
"FILE_read_var_realSP_3D",*)
'[INPUT]/[FILE] data not found! : ', &
4873 'varname= ',trim(varname),
', step=',step_
4874 log_info(
"FILE_read_var_realSP_3D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
4875 var(:,:,:) = missing_value_
4878 log_error(
"FILE_read_var_realSP_3D",*)
'failed to get data information :'//trim(varname)
4883 if ( dinfo%rank /= 3 )
then
4884 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
4885 log_error(
"FILE_read_var_realSP_3D",*)
'rank of '//trim(varname)//
' is not 3', dinfo%rank
4890 if (
present(ntypes) )
then
4891 #if defined(__GFORTRAN__) && __GNUC__ < 7
4896 dinfo, sp, ntypes, dtype, start(:), count(:) )
4897 else if (
present(start) .and.
present(count) )
then
4900 real(sp),
allocatable,
target :: work(:,:,:)
4901 allocate(work, mold=var)
4904 #if defined(__GFORTRAN__) && __GNUC__ < 7
4906 #elif defined(NVIDIA)
4911 dinfo, sp, 0, 0, start(:), count(:) )
4917 dim_size(:) = shape(var)
4919 if ( dinfo%dim_size(n) /= dim_size(n) )
then
4920 log_error(
"FILE_read_var_realSP_3D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
4926 real(sp),
allocatable,
target :: work(:,:,:)
4927 allocate(work, mold=var)
4930 #if defined(__GFORTRAN__) && __GNUC__ < 7
4932 #elif defined(NVIDIA)
4937 dinfo, sp, 0, 0, (/0/), (/0/) )
4943 if ( error /= file_success_code )
then
4944 log_error(
"FILE_read_var_realSP_3D",*)
'failed to get data value: ', trim(varname)
4950 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4953 end subroutine file_read_var_realsp_3d
4954 subroutine file_read_var_realdp_3d( &
4964 integer,
intent( in) :: fid
4965 character(len=*),
intent( in) :: varname
4967 real(dp),
intent(out),
target :: var(:,:,:)
4969 real(dp),
intent(out),
target,
contiguous :: var(:,:,:)
4971 integer,
intent( in),
optional :: step
4972 logical,
intent( in),
optional :: allow_missing
4973 real(dp),
intent( in),
optional :: missing_value
4974 integer,
intent( in),
optional :: ntypes
4975 integer,
intent( in),
optional :: dtype
4976 integer,
intent( in),
optional :: start(:)
4977 integer,
intent( in),
optional :: count(:)
4980 logical(c_bool) :: allow_missing_
4981 real(dp) :: missing_value_
4983 type(datainfo) :: dinfo
4984 integer :: dim_size(3)
4989 intrinsic size, shape
4993 log_error(
"FILE_read_var_realDP_3D",*)
'File is not opened. fid = ', fid
4997 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
4999 if (
present(step) )
then
5005 if (
present(allow_missing) )
then
5006 allow_missing_ = allow_missing
5008 allow_missing_ = .false.
5011 if (
present(missing_value) )
then
5012 missing_value_ = missing_value
5014 missing_value_ = 0.0_dp
5019 file_files(fid)%fid, &
5021 step_, allow_missing_ )
5024 if ( error /= file_success_code )
then
5025 if ( allow_missing_ )
then
5026 log_info(
"FILE_read_var_realDP_3D",*)
'[INPUT]/[FILE] data not found! : ', &
5027 'varname= ',trim(varname),
', step=',step_
5028 log_info(
"FILE_read_var_realDP_3D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
5029 var(:,:,:) = missing_value_
5032 log_error(
"FILE_read_var_realDP_3D",*)
'failed to get data information :'//trim(varname)
5037 if ( dinfo%rank /= 3 )
then
5038 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
5039 log_error(
"FILE_read_var_realDP_3D",*)
'rank of '//trim(varname)//
' is not 3', dinfo%rank
5044 if (
present(ntypes) )
then
5045 #if defined(__GFORTRAN__) && __GNUC__ < 7
5050 dinfo, dp, ntypes, dtype, start(:), count(:) )
5051 else if (
present(start) .and.
present(count) )
then
5054 real(dp),
allocatable,
target :: work(:,:,:)
5055 allocate(work, mold=var)
5058 #if defined(__GFORTRAN__) && __GNUC__ < 7
5060 #elif defined(NVIDIA)
5065 dinfo, dp, 0, 0, start(:), count(:) )
5071 dim_size(:) = shape(var)
5073 if ( dinfo%dim_size(n) /= dim_size(n) )
then
5074 log_error(
"FILE_read_var_realDP_3D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
5080 real(dp),
allocatable,
target :: work(:,:,:)
5081 allocate(work, mold=var)
5084 #if defined(__GFORTRAN__) && __GNUC__ < 7
5086 #elif defined(NVIDIA)
5091 dinfo, dp, 0, 0, (/0/), (/0/) )
5097 if ( error /= file_success_code )
then
5098 log_error(
"FILE_read_var_realDP_3D",*)
'failed to get data value: ', trim(varname)
5104 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
5107 end subroutine file_read_var_realdp_3d
5108 subroutine file_read_var_realsp_4d( &
5118 integer,
intent( in) :: fid
5119 character(len=*),
intent( in) :: varname
5121 real(sp),
intent(out),
target :: var(:,:,:,:)
5123 real(sp),
intent(out),
target,
contiguous :: var(:,:,:,:)
5125 integer,
intent( in),
optional :: step
5126 logical,
intent( in),
optional :: allow_missing
5127 real(sp),
intent( in),
optional :: missing_value
5128 integer,
intent( in),
optional :: ntypes
5129 integer,
intent( in),
optional :: dtype
5130 integer,
intent( in),
optional :: start(:)
5131 integer,
intent( in),
optional :: count(:)
5134 logical(c_bool) :: allow_missing_
5135 real(sp) :: missing_value_
5137 type(datainfo) :: dinfo
5138 integer :: dim_size(4)
5143 intrinsic size, shape
5147 log_error(
"FILE_read_var_realSP_4D",*)
'File is not opened. fid = ', fid
5151 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
5153 if (
present(step) )
then
5159 if (
present(allow_missing) )
then
5160 allow_missing_ = allow_missing
5162 allow_missing_ = .false.
5165 if (
present(missing_value) )
then
5166 missing_value_ = missing_value
5168 missing_value_ = 0.0_sp
5173 file_files(fid)%fid, &
5175 step_, allow_missing_ )
5178 if ( error /= file_success_code )
then
5179 if ( allow_missing_ )
then
5180 log_info(
"FILE_read_var_realSP_4D",*)
'[INPUT]/[FILE] data not found! : ', &
5181 'varname= ',trim(varname),
', step=',step_
5182 log_info(
"FILE_read_var_realSP_4D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
5183 var(:,:,:,:) = missing_value_
5186 log_error(
"FILE_read_var_realSP_4D",*)
'failed to get data information :'//trim(varname)
5191 if ( dinfo%rank /= 4 )
then
5192 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
5193 log_error(
"FILE_read_var_realSP_4D",*)
'rank of '//trim(varname)//
' is not 4', dinfo%rank
5198 if (
present(ntypes) )
then
5199 #if defined(__GFORTRAN__) && __GNUC__ < 7
5204 dinfo, sp, ntypes, dtype, start(:), count(:) )
5205 else if (
present(start) .and.
present(count) )
then
5208 real(sp),
allocatable,
target :: work(:,:,:,:)
5209 allocate(work, mold=var)
5212 #if defined(__GFORTRAN__) && __GNUC__ < 7
5213 cloc(var(1,1,1,1)), &
5214 #elif defined(NVIDIA)
5219 dinfo, sp, 0, 0, start(:), count(:) )
5225 dim_size(:) = shape(var)
5227 if ( dinfo%dim_size(n) /= dim_size(n) )
then
5228 log_error(
"FILE_read_var_realSP_4D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
5234 real(sp),
allocatable,
target :: work(:,:,:,:)
5235 allocate(work, mold=var)
5238 #if defined(__GFORTRAN__) && __GNUC__ < 7
5239 cloc(var(1,1,1,1)), &
5240 #elif defined(NVIDIA)
5245 dinfo, sp, 0, 0, (/0/), (/0/) )
5251 if ( error /= file_success_code )
then
5252 log_error(
"FILE_read_var_realSP_4D",*)
'failed to get data value: ', trim(varname)
5258 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
5261 end subroutine file_read_var_realsp_4d
5262 subroutine file_read_var_realdp_4d( &
5272 integer,
intent( in) :: fid
5273 character(len=*),
intent( in) :: varname
5275 real(dp),
intent(out),
target :: var(:,:,:,:)
5277 real(dp),
intent(out),
target,
contiguous :: var(:,:,:,:)
5279 integer,
intent( in),
optional :: step
5280 logical,
intent( in),
optional :: allow_missing
5281 real(dp),
intent( in),
optional :: missing_value
5282 integer,
intent( in),
optional :: ntypes
5283 integer,
intent( in),
optional :: dtype
5284 integer,
intent( in),
optional :: start(:)
5285 integer,
intent( in),
optional :: count(:)
5288 logical(c_bool) :: allow_missing_
5289 real(dp) :: missing_value_
5291 type(datainfo) :: dinfo
5292 integer :: dim_size(4)
5297 intrinsic size, shape
5301 log_error(
"FILE_read_var_realDP_4D",*)
'File is not opened. fid = ', fid
5305 call prof_rapstart(
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
5307 if (
present(step) )
then
5313 if (
present(allow_missing) )
then
5314 allow_missing_ = allow_missing
5316 allow_missing_ = .false.
5319 if (
present(missing_value) )
then
5320 missing_value_ = missing_value
5322 missing_value_ = 0.0_dp
5327 file_files(fid)%fid, &
5329 step_, allow_missing_ )
5332 if ( error /= file_success_code )
then
5333 if ( allow_missing_ )
then
5334 log_info(
"FILE_read_var_realDP_4D",*)
'[INPUT]/[FILE] data not found! : ', &
5335 'varname= ',trim(varname),
', step=',step_
5336 log_info(
"FILE_read_var_realDP_4D",*)
'[INPUT]/[FILE] Value is set to ', missing_value_
5337 var(:,:,:,:) = missing_value_
5340 log_error(
"FILE_read_var_realDP_4D",*)
'failed to get data information :'//trim(varname)
5345 if ( dinfo%rank /= 4 )
then
5346 if ( (.not.
present(start)) .and. (.not.
present(count)) )
then
5347 log_error(
"FILE_read_var_realDP_4D",*)
'rank of '//trim(varname)//
' is not 4', dinfo%rank
5352 if (
present(ntypes) )
then
5353 #if defined(__GFORTRAN__) && __GNUC__ < 7
5358 dinfo, dp, ntypes, dtype, start(:), count(:) )
5359 else if (
present(start) .and.
present(count) )
then
5362 real(dp),
allocatable,
target :: work(:,:,:,:)
5363 allocate(work, mold=var)
5366 #if defined(__GFORTRAN__) && __GNUC__ < 7
5367 cloc(var(1,1,1,1)), &
5368 #elif defined(NVIDIA)
5373 dinfo, dp, 0, 0, start(:), count(:) )
5379 dim_size(:) = shape(var)
5381 if ( dinfo%dim_size(n) /= dim_size(n) )
then
5382 log_error(
"FILE_read_var_realDP_4D",*)
'shape is different: ', trim(varname), n, dinfo%dim_size(n), dim_size(n)
5388 real(dp),
allocatable,
target :: work(:,:,:,:)
5389 allocate(work, mold=var)
5392 #if defined(__GFORTRAN__) && __GNUC__ < 7
5393 cloc(var(1,1,1,1)), &
5394 #elif defined(NVIDIA)
5399 dinfo, dp, 0, 0, (/0/), (/0/) )
5405 if ( error /= file_success_code )
then
5406 log_error(
"FILE_read_var_realDP_4D",*)
'failed to get data value: ', trim(varname)
5412 call prof_rapend (
'FILE_Read', 2, disable_barrier = .not. file_files(fid)%allnodes )
5415 end subroutine file_read_var_realdp_4d
5420 subroutine file_write_realsp_1d( &
5428 integer,
intent(in) :: vid
5430 real(sp),
intent(in) :: var(:)
5432 real(sp),
intent(in),
target,
contiguous :: var(:)
5434 real(dp),
intent(in) :: t_start
5435 real(dp),
intent(in) :: t_end
5436 integer,
intent(in),
optional :: ndims
5437 integer,
intent(in),
optional :: count(:)
5438 integer,
intent(in),
optional :: start(:)
5441 integer :: start_(1)
5452 fid = file_vars(vid)%fid
5455 log_error(
"FILE_write_realSP_1D",*)
'File is not opened. fid = ', fid
5459 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5461 if (
present(ndims) )
then
5465 if ( .not.
present(start) )
then
5466 log_error(
"FILE_write_realSP_1D",*)
'start argument is neccessary when ndims is specified'
5469 if ( .not.
present(count) )
then
5470 log_error(
"FILE_write_realSP_1D",*)
'count argument is neccessary when ndims is specified'
5475 #if defined(__GFORTRAN__) && __GNUC__ < 7
5476 cloc(var(1)), ts, te, ndims, sp, &
5478 c_loc(var), ts, te, ndims, sp, &
5483 if (
present(start) )
then
5484 start_(:) = start(:)
5493 real(sp),
allocatable,
target :: work(:)
5494 allocate(work, source=var)
5497 #if defined(__GFORTRAN__) && __GNUC__ < 7
5499 #elif defined(NVIDIA)
5505 start_, shape(var) )
5510 if ( error /= file_success_code )
then
5511 log_error(
"FILE_write_realSP_1D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5515 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5518 end subroutine file_write_realsp_1d
5519 subroutine file_write_realdp_1d( &
5527 integer,
intent(in) :: vid
5529 real(dp),
intent(in) :: var(:)
5531 real(dp),
intent(in),
target,
contiguous :: var(:)
5533 real(dp),
intent(in) :: t_start
5534 real(dp),
intent(in) :: t_end
5535 integer,
intent(in),
optional :: ndims
5536 integer,
intent(in),
optional :: count(:)
5537 integer,
intent(in),
optional :: start(:)
5540 integer :: start_(1)
5551 fid = file_vars(vid)%fid
5554 log_error(
"FILE_write_realDP_1D",*)
'File is not opened. fid = ', fid
5558 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5560 if (
present(ndims) )
then
5564 if ( .not.
present(start) )
then
5565 log_error(
"FILE_write_realDP_1D",*)
'start argument is neccessary when ndims is specified'
5568 if ( .not.
present(count) )
then
5569 log_error(
"FILE_write_realDP_1D",*)
'count argument is neccessary when ndims is specified'
5574 #if defined(__GFORTRAN__) && __GNUC__ < 7
5575 cloc(var(1)), ts, te, ndims, dp, &
5577 c_loc(var), ts, te, ndims, dp, &
5582 if (
present(start) )
then
5583 start_(:) = start(:)
5592 real(dp),
allocatable,
target :: work(:)
5593 allocate(work, source=var)
5596 #if defined(__GFORTRAN__) && __GNUC__ < 7
5598 #elif defined(NVIDIA)
5604 start_, shape(var) )
5609 if ( error /= file_success_code )
then
5610 log_error(
"FILE_write_realDP_1D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5614 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5617 end subroutine file_write_realdp_1d
5618 subroutine file_write_realsp_2d( &
5624 integer,
intent(in) :: vid
5626 real(sp),
intent(in) :: var(:,:)
5628 real(sp),
intent(in),
target,
contiguous :: var(:,:)
5630 real(dp),
intent(in) :: t_start
5631 real(dp),
intent(in) :: t_end
5632 integer,
intent(in),
optional :: start(:)
5635 integer :: start_(2)
5646 fid = file_vars(vid)%fid
5649 log_error(
"FILE_write_realSP_2D",*)
'File is not opened. fid = ', fid
5653 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5656 if (
present(start) )
then
5657 start_(:) = start(:)
5666 real(sp),
allocatable,
target :: work(:,:)
5667 allocate(work, source=var)
5670 #if defined(__GFORTRAN__) && __GNUC__ < 7
5672 #elif defined(NVIDIA)
5678 start_, shape(var) )
5682 if ( error /= file_success_code )
then
5683 log_error(
"FILE_write_realSP_2D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5687 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5690 end subroutine file_write_realsp_2d
5691 subroutine file_write_realdp_2d( &
5697 integer,
intent(in) :: vid
5699 real(dp),
intent(in) :: var(:,:)
5701 real(dp),
intent(in),
target,
contiguous :: var(:,:)
5703 real(dp),
intent(in) :: t_start
5704 real(dp),
intent(in) :: t_end
5705 integer,
intent(in),
optional :: start(:)
5708 integer :: start_(2)
5719 fid = file_vars(vid)%fid
5722 log_error(
"FILE_write_realDP_2D",*)
'File is not opened. fid = ', fid
5726 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5729 if (
present(start) )
then
5730 start_(:) = start(:)
5739 real(dp),
allocatable,
target :: work(:,:)
5740 allocate(work, source=var)
5743 #if defined(__GFORTRAN__) && __GNUC__ < 7
5745 #elif defined(NVIDIA)
5751 start_, shape(var) )
5755 if ( error /= file_success_code )
then
5756 log_error(
"FILE_write_realDP_2D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5760 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5763 end subroutine file_write_realdp_2d
5764 subroutine file_write_realsp_3d( &
5770 integer,
intent(in) :: vid
5772 real(sp),
intent(in) :: var(:,:,:)
5774 real(sp),
intent(in),
target,
contiguous :: var(:,:,:)
5776 real(dp),
intent(in) :: t_start
5777 real(dp),
intent(in) :: t_end
5778 integer,
intent(in),
optional :: start(:)
5781 integer :: start_(3)
5792 fid = file_vars(vid)%fid
5795 log_error(
"FILE_write_realSP_3D",*)
'File is not opened. fid = ', fid
5799 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5802 if (
present(start) )
then
5803 start_(:) = start(:)
5812 real(sp),
allocatable,
target :: work(:,:,:)
5813 allocate(work, source=var)
5816 #if defined(__GFORTRAN__) && __GNUC__ < 7
5818 #elif defined(NVIDIA)
5824 start_, shape(var) )
5828 if ( error /= file_success_code )
then
5829 log_error(
"FILE_write_realSP_3D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5833 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5836 end subroutine file_write_realsp_3d
5837 subroutine file_write_realdp_3d( &
5843 integer,
intent(in) :: vid
5845 real(dp),
intent(in) :: var(:,:,:)
5847 real(dp),
intent(in),
target,
contiguous :: var(:,:,:)
5849 real(dp),
intent(in) :: t_start
5850 real(dp),
intent(in) :: t_end
5851 integer,
intent(in),
optional :: start(:)
5854 integer :: start_(3)
5865 fid = file_vars(vid)%fid
5868 log_error(
"FILE_write_realDP_3D",*)
'File is not opened. fid = ', fid
5872 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5875 if (
present(start) )
then
5876 start_(:) = start(:)
5885 real(dp),
allocatable,
target :: work(:,:,:)
5886 allocate(work, source=var)
5889 #if defined(__GFORTRAN__) && __GNUC__ < 7
5891 #elif defined(NVIDIA)
5897 start_, shape(var) )
5901 if ( error /= file_success_code )
then
5902 log_error(
"FILE_write_realDP_3D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5906 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5909 end subroutine file_write_realdp_3d
5910 subroutine file_write_realsp_4d( &
5916 integer,
intent(in) :: vid
5918 real(sp),
intent(in) :: var(:,:,:,:)
5920 real(sp),
intent(in),
target,
contiguous :: var(:,:,:,:)
5922 real(dp),
intent(in) :: t_start
5923 real(dp),
intent(in) :: t_end
5924 integer,
intent(in),
optional :: start(:)
5927 integer :: start_(4)
5938 fid = file_vars(vid)%fid
5941 log_error(
"FILE_write_realSP_4D",*)
'File is not opened. fid = ', fid
5945 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5948 if (
present(start) )
then
5949 start_(:) = start(:)
5958 real(sp),
allocatable,
target :: work(:,:,:,:)
5959 allocate(work, source=var)
5962 #if defined(__GFORTRAN__) && __GNUC__ < 7
5963 cloc(var(1,1,1,1)), &
5964 #elif defined(NVIDIA)
5970 start_, shape(var) )
5974 if ( error /= file_success_code )
then
5975 log_error(
"FILE_write_realSP_4D",*)
'failed to write data: ', trim(file_vars(vid)%name)
5979 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
5982 end subroutine file_write_realsp_4d
5983 subroutine file_write_realdp_4d( &
5989 integer,
intent(in) :: vid
5991 real(dp),
intent(in) :: var(:,:,:,:)
5993 real(dp),
intent(in),
target,
contiguous :: var(:,:,:,:)
5995 real(dp),
intent(in) :: t_start
5996 real(dp),
intent(in) :: t_end
5997 integer,
intent(in),
optional :: start(:)
6000 integer :: start_(4)
6011 fid = file_vars(vid)%fid
6014 log_error(
"FILE_write_realDP_4D",*)
'File is not opened. fid = ', fid
6018 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6021 if (
present(start) )
then
6022 start_(:) = start(:)
6031 real(dp),
allocatable,
target :: work(:,:,:,:)
6032 allocate(work, source=var)
6035 #if defined(__GFORTRAN__) && __GNUC__ < 7
6036 cloc(var(1,1,1,1)), &
6037 #elif defined(NVIDIA)
6043 start_, shape(var) )
6047 if ( error /= file_success_code )
then
6048 log_error(
"FILE_write_realDP_4D",*)
'failed to write data: ', trim(file_vars(vid)%name)
6052 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6055 end subroutine file_write_realdp_4d
6062 integer,
intent(in) :: fid
6069 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6073 if ( error == file_success_code )
then
6076 log_info(
"FILE_enddef",
'(1x,A,I3.3,2A)') &
6077 'End define mode : No.', fid,
', name = ', trim(file_files(fid)%name)
6080 log_error(
"FILE_enddef",*)
'failed to exit define mode'
6084 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6094 integer,
intent(in) :: fid
6101 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6105 if ( error == file_success_code )
then
6108 log_info(
"FILE_redef",
'(1x,A,I3.3,2A)') &
6109 'Enter to define mode : No.', fid,
', name = ', trim(file_files(fid)%name)
6112 log_error(
"FILE_redef",*)
'failed to enter to define mode'
6116 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6128 integer,
intent(in) :: fid
6129 integer(8),
intent(in) :: buf_amount
6136 if ( file_files(fid)%buffer_size > 0 )
then
6140 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6144 if ( error /= file_success_code )
then
6145 log_error(
"FILE_attach_buffer",*)
'failed to attach buffer in PnetCDF'
6150 log_info(
"FILE_attach_buffer",
'(1x,A,I3.3,3A,I10)') &
6151 'Attach buffer : No.', fid,
', name = ', trim(file_files(fid)%name), &
6152 ', size = ', buf_amount
6154 file_files(fid)%buffer_size = buf_amount
6156 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6166 integer,
intent(in) :: fid
6173 if ( file_files(fid)%fid < 0 )
return
6175 if ( file_files(fid)%buffer_size < 0 )
return
6177 call prof_rapstart(
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6181 if ( error /= file_success_code )
then
6182 log_error(
"FILE_detach_buffer",*)
'failed to detach buffer in PnetCDF'
6187 log_info(
"FILE_detach_buffer",
'(1x,A,I3.3,2A)') &
6188 'Detach buffer : No.', fid,
', name = ', trim(file_files(fid)%name)
6190 file_files(fid)%buffer_size = -1
6192 call prof_rapend (
'FILE_Write', 2, disable_barrier = .not. file_files(fid)%allnodes )
6202 integer,
intent(in) :: fid
6209 if ( file_files(fid)%fid < 0 )
return
6211 call prof_rapstart(
'FILE', 2, disable_barrier = .not. file_files(fid)%allnodes )
6215 if ( error == file_success_code )
then
6222 log_error(
"FILE_flush",*)
'failed to flush data to netcdf file'
6226 call prof_rapend (
'FILE', 2, disable_barrier = .not. file_files(fid)%allnodes )
6234 integer,
intent(in) :: fid
6235 logical,
intent(in),
optional :: abort
6237 logical(c_bool) :: abort_
6244 if ( file_files(fid)%fid < 0 )
return
6246 call prof_rapstart(
'FILE', 2, disable_barrier = .not. file_files(fid)%allnodes )
6248 if (
present(abort) )
then
6256 if ( error == file_success_code )
then
6259 log_info(
"FILE_close",
'(1x,A,I3.3,2A)') &
6260 'Close : No.', fid,
', name = ', trim(file_files(fid)%name)
6262 elseif( error /= file_already_closed_code )
then
6263 log_error(
"FILE_close",*)
'failed to close file: ', trim(file_files(fid)%name)
6264 if ( .not. abort_ )
call prc_abort
6267 file_files(fid)%fid = -1
6268 file_files(fid)%name =
''
6269 file_files(fid)%aggregate = .false.
6270 file_files(fid)%buffer_size = -1
6272 do n = 1, file_nvars
6273 if ( file_vars(n)%fid == fid )
then
6274 file_vars(n)%vid = -1
6275 file_vars(n)%name =
''
6279 call prof_rapend (
'FILE', 2, disable_barrier = .not. file_files(fid)%allnodes )
6287 logical,
intent(in),
optional :: skip_abort
6292 do fid = 1, file_nfiles
6305 integer,
intent(in) :: date(6)
6306 character(len=*),
intent(out) :: tunits
6309 write(tunits,
'(a,i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)')
'seconds since ', date
6315 integer,
intent(in) :: fid
6332 subroutine file_get_fid( &
6347 character(len=*),
intent( in) :: basename
6348 integer,
intent( in) :: mode
6349 integer,
intent( in) :: rankid
6350 logical,
intent( in) :: single
6352 integer,
intent(out) :: fid
6353 logical,
intent(out) :: existed
6355 logical,
intent( in),
optional :: allnodes
6356 logical,
intent( in),
optional :: aggregate
6357 character(len=*),
intent( in),
optional :: postfix
6359 character(len=FILE_HSHORT) :: rwname(0:2)
6360 data rwname /
'READ',
'WRITE',
'APPEND' /
6362 character(len=FILE_HLONG) :: fname
6365 logical :: allnodes_
6366 logical :: aggregate_
6374 if (
present(allnodes) )
then
6375 allnodes_ = allnodes
6381 if (
present(aggregate) )
then
6382 aggregate_ = aggregate
6387 if ( aggregate_ )
then
6393 if (
present(postfix) )
then
6394 call io_get_fname(fname, trim(basename)//trim(postfix))
6395 elseif ( aggregate_ )
then
6396 call io_get_fname(fname, basename)
6397 elseif ( single )
then
6398 call io_get_fname(fname, basename, rank=-1)
6400 call io_get_fname(fname, basename, rank=rankid)
6405 do n = 1, file_nfiles
6406 if ( fname == file_files(n)%name )
then
6417 call prof_rapstart(
'FILE', 2, disable_barrier = ( .not. allnodes_ ) .or. single )
6420 cstr(fname), mode, mpi_comm )
6422 if ( error /= file_success_code )
then
6423 log_error(
"FILE_get_fid",*)
'failed to open file :'//trim(fname)//
'.nc'
6427 file_nfiles = file_nfiles + 1
6430 file_files(fid)%name = fname
6431 file_files(fid)%fid = cfid
6432 file_files(fid)%aggregate = aggregate_
6433 file_files(fid)%single = single
6434 file_files(fid)%allnodes = allnodes_ .and. (.not. single)
6435 file_files(fid)%buffer_size = -1
6438 log_info(
"FILE_get_fid",
'(1x,A,A6,A,I3.3,2A)') &
6439 'Registration (', trim(rwname(mode)),
') : No.', fid,
', name = ', trim(fname)
6443 call prof_rapend (
'FILE', 2, disable_barrier = .not. file_files(fid)%allnodes )
6446 end subroutine file_get_fid
6448 #if defined(__GFORTRAN__) && __GNUC__ < 7
6449 function cloc_sp( x )
6452 real(sp),
target,
intent(in) :: x
6453 type(c_ptr) :: cloc_sp
6456 end function cloc_sp
6457 function cloc_dp( x )
6460 real(dp),
target,
intent(in) :: x
6461 type(c_ptr) :: cloc_dp
6464 end function cloc_dp