223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

consistent space (as in 'end module' etc)

This commit is contained in:
Martin Diehl 2021-12-06 07:57:31 +01:00
parent 08a709c6d9
commit 2fb368cf8c
3 changed files with 106 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
src/HDF5_utilities.f90
View File

@ -171,7 +171,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
m = mode m = mode
else else
m = 'r' m = 'r'
endif end if
call H5Pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) call H5Pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -181,7 +181,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
if (parallel) call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) if (parallel) call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
else else
call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
endif end if
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
#endif #endif
@ -196,7 +196,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
else else
error stop 'unknown access mode' error stop 'unknown access mode'
endif end if
call H5Pclose_f(plist_id, hdferr) call H5Pclose_f(plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -319,7 +319,7 @@ logical function HDF5_objectExists(loc_id,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
call H5Lexists_f(loc_id, p, HDF5_objectExists, hdferr) call H5Lexists_f(loc_id, p, HDF5_objectExists, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -327,7 +327,7 @@ logical function HDF5_objectExists(loc_id,path)
if(HDF5_objectExists) then if(HDF5_objectExists) then
call H5Oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr) call H5Oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
end function HDF5_objectExists end function HDF5_objectExists
@ -353,7 +353,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
attrValue_(1) = trim(attrValue)//C_NULL_CHAR attrValue_(1) = trim(attrValue)//C_NULL_CHAR
ptr(1) = c_loc(attrValue_(1)) ptr(1) = c_loc(attrValue_(1))
@ -366,7 +366,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if (attrExists) then if (attrExists) then
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr) call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -401,7 +401,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr) call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -411,7 +411,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
if (attrExists) then if (attrExists) then
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -446,7 +446,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr) call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -456,7 +456,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
if (attrExists) then if (attrExists) then
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -493,7 +493,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
do i=1,size(attrValue) do i=1,size(attrValue)
attrValue_(i) = attrValue(i)//C_NULL_CHAR attrValue_(i) = attrValue(i)//C_NULL_CHAR
@ -508,7 +508,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
if (attrExists) then if (attrExists) then
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr) call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -544,7 +544,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
array_size = size(attrValue,kind=HSIZE_T) array_size = size(attrValue,kind=HSIZE_T)
@ -556,7 +556,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
if (attrExists) then if (attrExists) then
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -592,7 +592,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
p = trim(path) p = trim(path)
else else
p = '.' p = '.'
endif end if
array_size = size(attrValue,kind=HSIZE_T) array_size = size(attrValue,kind=HSIZE_T)
@ -604,7 +604,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
if (attrExists) then if (attrExists) then
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -634,7 +634,7 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
if (linkExists) then if (linkExists) then
call H5Ldelete_f(loc_id,link_name, hdferr) call H5Ldelete_f(loc_id,link_name, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Lcreate_soft_f(target_name, loc_id, link_name, hdferr) call H5Lcreate_soft_f(target_name, loc_id, link_name, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -671,7 +671,7 @@ subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -711,7 +711,7 @@ subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -751,7 +751,7 @@ subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -791,7 +791,7 @@ subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -831,7 +831,7 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -871,7 +871,7 @@ subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -911,7 +911,7 @@ subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -953,7 +953,7 @@ subroutine HDF5_read_int1(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -993,7 +993,7 @@ subroutine HDF5_read_int2(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -1033,7 +1033,7 @@ subroutine HDF5_read_int3(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -1073,7 +1073,7 @@ subroutine HDF5_read_int4(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -1113,7 +1113,7 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -1153,7 +1153,7 @@ subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -1193,7 +1193,7 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
else else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif end if
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
@ -1233,13 +1233,13 @@ subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1274,13 +1274,13 @@ subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1315,13 +1315,13 @@ subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1356,13 +1356,13 @@ subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1398,13 +1398,13 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1439,13 +1439,13 @@ subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1480,13 +1480,13 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1531,7 +1531,7 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
call H5Pset_deflate_f(dcpl, 6, hdferr) call H5Pset_deflate_f(dcpl, 6, hdferr)
if (hdferr < 0) error stop 'HDF5 error' if (hdferr < 0) error stop 'HDF5 error'
endif end if
call H5Screate_simple_f(1, [1_HSIZE_T], space_id, hdferr) call H5Screate_simple_f(1, [1_HSIZE_T], space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
@ -1584,13 +1584,13 @@ subroutine HDF5_write_int1(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1625,13 +1625,13 @@ subroutine HDF5_write_int2(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1666,13 +1666,13 @@ subroutine HDF5_write_int3(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1707,13 +1707,13 @@ subroutine HDF5_write_int4(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1748,13 +1748,13 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1789,13 +1789,13 @@ subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1830,13 +1830,13 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
else else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif end if
if (product(totalShape) /= 0) then if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1879,7 +1879,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0) error stop 'MPI error' if (ierr /= 0) error stop 'MPI error'
endif end if
#endif #endif
myStart = int(0,HSIZE_T) myStart = int(0,HSIZE_T)
myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T)
@ -1968,7 +1968,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
if (parallel) then if (parallel) then
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
endif end if
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

50
src/YAML_parse.f90
View File

@ -101,9 +101,9 @@ recursive function parse_flow(YAML_flow) result(node)
node = trim(adjustl(flow_string(2:len(flow_string)-1))) node = trim(adjustl(flow_string(2:len(flow_string)-1)))
else else
node = trim(adjustl(flow_string)) node = trim(adjustl(flow_string))
endif end if
end select end select
endif end if
end function parse_flow end function parse_flow
@ -150,7 +150,7 @@ logical function quotedString(line)
if (scan(line(:1),IO_QUOTES) == 1) then if (scan(line(:1),IO_QUOTES) == 1) then
quotedString = .true. quotedString = .true.
if(line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line) if(line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line)
endif end if
end function quotedString end function quotedString
@ -209,7 +209,7 @@ logical function isListItem(line)
isListItem = scan(trim(adjustl(line)),' ') == 2 isListItem = scan(trim(adjustl(line)),' ') == 2
else else
isListItem = trim(adjustl(line)) == '-' isListItem = trim(adjustl(line)) == '-'
endif end if
end function isListItem end function isListItem
@ -224,7 +224,7 @@ logical function isKeyValue(line)
if( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then if( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then
if(index(IO_rmComment(line),': ') > 0) isKeyValue = .true. if(index(IO_rmComment(line),': ') > 0) isKeyValue = .true.
endif end if
end function isKeyValue end function isKeyValue
@ -243,7 +243,7 @@ logical function isKey(line)
isKey = index(IO_rmComment(line),':',back=.false.) == len(IO_rmComment(line)) .and. & isKey = index(IO_rmComment(line),':',back=.false.) == len(IO_rmComment(line)) .and. &
index(IO_rmComment(line),':',back=.true.) == len(IO_rmComment(line)) .and. & index(IO_rmComment(line),':',back=.true.) == len(IO_rmComment(line)) .and. &
.not. isFlow(line) .not. isFlow(line)
endif end if
end function isKey end function isKey
@ -299,8 +299,8 @@ subroutine skip_file_header(blck,s_blck)
s_blck = s_blck + index(blck(s_blck:),IO_EOL) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
else else
call IO_error(708,ext_msg = line) call IO_error(708,ext_msg = line)
endif end if
endif end if
end subroutine skip_file_header end subroutine skip_file_header
@ -419,7 +419,7 @@ recursive subroutine line_isFlow(flow,s_flow,line)
call line_isFlow(flow,s_flow,line(s+1:list_chunk-1)) call line_isFlow(flow,s_flow,line(s+1:list_chunk-1))
else else
call line_toFlow(flow,s_flow,line(s+1:list_chunk-1)) call line_toFlow(flow,s_flow,line(s+1:list_chunk-1))
endif end if
flow(s_flow:s_flow+1) = ', ' flow(s_flow:s_flow+1) = ', '
s_flow = s_flow +2 s_flow = s_flow +2
s = s + find_end(line(s+1:),']') s = s + find_end(line(s+1:),']')
@ -447,7 +447,7 @@ recursive subroutine line_isFlow(flow,s_flow,line)
s_flow = s_flow +1 s_flow = s_flow +1
else else
call line_toFlow(flow,s_flow,line) call line_toFlow(flow,s_flow,line)
endif end if
end subroutine line_isFlow end subroutine line_isFlow
@ -479,7 +479,7 @@ recursive subroutine keyValue_toFlow(flow,s_flow,line)
offset_value = indentDepth(line(col_pos+2:)) offset_value = indentDepth(line(col_pos+2:))
line_asStandard = line(:col_pos+1)//line(col_pos+2+offset_value:) line_asStandard = line(:col_pos+1)//line(col_pos+2+offset_value:)
call line_toFlow(flow,s_flow,line_asStandard) call line_toFlow(flow,s_flow,line_asStandard)
endif end if
end subroutine keyValue_toFlow end subroutine keyValue_toFlow
@ -557,10 +557,10 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line) call remove_line_break(blck,s_blck,']',flow_line)
else else
call remove_line_break(blck,s_blck,'}',flow_line) call remove_line_break(blck,s_blck,'}',flow_line)
endif end if
call line_isFlow(flow,s_flow,flow_line) call line_isFlow(flow,s_flow,flow_line)
offset = 0 offset = 0
endif end if
else ! list item in the same line else ! list item in the same line
line = line(indentDepth(line)+3:) line = line(indentDepth(line)+3:)
if(isScalar(line)) then if(isScalar(line)) then
@ -573,20 +573,20 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line) call remove_line_break(blck,s_blck,']',flow_line)
else else
call remove_line_break(blck,s_blck,'}',flow_line) call remove_line_break(blck,s_blck,'}',flow_line)
endif end if
call line_isFlow(flow,s_flow,flow_line) call line_isFlow(flow,s_flow,flow_line)
offset = 0 offset = 0
else ! non scalar list item else ! non scalar list item
offset = offset + indentDepth(blck(s_blck:))+1 ! offset in spaces to be ignored offset = offset + indentDepth(blck(s_blck:))+1 ! offset in spaces to be ignored
s_blck = s_blck + index(blck(s_blck:e_blck),'-') ! s_blck after '-' symbol s_blck = s_blck + index(blck(s_blck:e_blck),'-') ! s_blck after '-' symbol
endif end if
end if end if
end if end if
if(isScalar(line) .or. isFlow(line)) then if(isScalar(line) .or. isFlow(line)) then
flow(s_flow:s_flow+1) = ', ' flow(s_flow:s_flow+1) = ', '
s_flow = s_flow + 2 s_flow = s_flow + 2
endif end if
enddo enddo
@ -643,7 +643,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
if(previous_isKey) then if(previous_isKey) then
flow(s_flow-1:s_flow) = ', ' flow(s_flow-1:s_flow) = ', '
s_flow = s_flow + 1 s_flow = s_flow + 1
endif end if
if(isKeyValue(line)) then if(isKeyValue(line)) then
col_pos = index(line,':') col_pos = index(line,':')
@ -652,16 +652,16 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line) call remove_line_break(blck,s_blck,']',flow_line)
else else
call remove_line_break(blck,s_blck,'}',flow_line) call remove_line_break(blck,s_blck,'}',flow_line)
endif end if
call keyValue_toFlow(flow,s_flow,flow_line) call keyValue_toFlow(flow,s_flow,flow_line)
else else
call keyValue_toFlow(flow,s_flow,line) call keyValue_toFlow(flow,s_flow,line)
s_blck = e_blck + 2 s_blck = e_blck + 2
endif end if
else else
call line_toFlow(flow,s_flow,line) call line_toFlow(flow,s_flow,line)
s_blck = e_blck + 2 s_blck = e_blck + 2
endif end if
end if end if
if(isScalar(line) .or. isKeyValue(line)) then if(isScalar(line) .or. isKeyValue(line)) then
@ -670,7 +670,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
previous_isKey = .false. previous_isKey = .false.
else else
previous_isKey = .true. previous_isKey = .true.
endif end if
flow(s_flow:s_flow) = ' ' flow(s_flow:s_flow) = ' '
s_flow = s_flow + 1 s_flow = s_flow + 1
@ -722,14 +722,14 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line) call remove_line_break(blck,s_blck,']',flow_line)
else else
call remove_line_break(blck,s_blck,'}',flow_line) call remove_line_break(blck,s_blck,'}',flow_line)
endif end if
call line_isFlow(flow,s_flow,line) call line_isFlow(flow,s_flow,line)
else else
line = line(indentDepth(line)+1:) line = line(indentDepth(line)+1:)
call line_toFlow(flow,s_flow,line) call line_toFlow(flow,s_flow,line)
s_blck = e_blck +2 s_blck = e_blck +2
endif end if
endif end if
end subroutine end subroutine
@ -759,7 +759,7 @@ function to_flow(blck)
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
if(trim(line) == '---') s_blck = s_blck + index(blck(s_blck:),IO_EOL) if(trim(line) == '---') s_blck = s_blck + index(blck(s_blck:),IO_EOL)
call decide(blck,to_flow,s_blck,s_flow,offset) call decide(blck,to_flow,s_blck,s_flow,offset)
endif end if
line = IO_rmComment(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2)) line = IO_rmComment(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2))
if(trim(line)== '---') call IO_warning(709,ext_msg=line) if(trim(line)== '---') call IO_warning(709,ext_msg=line)
to_flow = trim(to_flow(:s_flow-1)) to_flow = trim(to_flow(:s_flow-1))

36
src/YAML_types.f90
View File

@ -646,7 +646,7 @@ function tNode_contains(self,k) result(exists)
if (dict%getKey(j) == k) then if (dict%getKey(j) == k) then
exists = .true. exists = .true.
return return
endif end if
enddo enddo
class is(tList) class is(tList)
list => self%asList() list => self%asList()
@ -654,7 +654,7 @@ function tNode_contains(self,k) result(exists)
if (list%get_asString(j) == k) then if (list%get_asString(j) == k) then
exists = .true. exists = .true.
return return
endif end if
enddo enddo
class default class default
call IO_error(706,ext_msg='Expected list or dict') call IO_error(706,ext_msg='Expected list or dict')
@ -694,7 +694,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
if (item%key == k) then if (item%key == k) then
found = .true. found = .true.
exit exit
endif end if
item => item%next item => item%next
j = j + 1 j = j + 1
enddo enddo
@ -703,7 +703,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
else else
if (associated(item)) node => item%node if (associated(item)) node => item%node
endif end if
end function tNode_get_byKey end function tNode_get_byKey
@ -734,7 +734,7 @@ function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat)
nodeAsFloat = defaultVal nodeAsFloat = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
end function tNode_get_byKey_asFloat end function tNode_get_byKey_asFloat
@ -765,7 +765,7 @@ function tNode_get_byKey_asInt(self,k,defaultVal) result(nodeAsInt)
nodeAsInt = defaultVal nodeAsInt = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
end function tNode_get_byKey_asInt end function tNode_get_byKey_asInt
@ -796,7 +796,7 @@ function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool)
nodeAsBool = defaultVal nodeAsBool = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
end function tNode_get_byKey_asBool end function tNode_get_byKey_asBool
@ -827,7 +827,7 @@ function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString)
nodeAsString = defaultVal nodeAsString = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
end function tNode_get_byKey_asString end function tNode_get_byKey_asString
@ -860,11 +860,11 @@ function tNode_get_byKey_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs
nodeAs1dFloat = defaultVal nodeAs1dFloat = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
if (present(requiredSize)) then if (present(requiredSize)) then
if (requiredSize /= size(nodeAs1dFloat)) call IO_error(146,ext_msg=k) if (requiredSize /= size(nodeAs1dFloat)) call IO_error(146,ext_msg=k)
endif end if
end function tNode_get_byKey_as1dFloat end function tNode_get_byKey_as1dFloat
@ -897,11 +897,11 @@ function tNode_get_byKey_as2dFloat(self,k,defaultVal,requiredShape) result(nodeA
nodeAs2dFloat = defaultVal nodeAs2dFloat = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
if (present(requiredShape)) then if (present(requiredShape)) then
if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k) if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k)
endif end if
end function tNode_get_byKey_as2dFloat end function tNode_get_byKey_as2dFloat
@ -933,11 +933,11 @@ function tNode_get_byKey_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1d
nodeAs1dInt = defaultVal nodeAs1dInt = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
if (present(requiredSize)) then if (present(requiredSize)) then
if (requiredSize /= size(nodeAs1dInt)) call IO_error(146,ext_msg=k) if (requiredSize /= size(nodeAs1dInt)) call IO_error(146,ext_msg=k)
endif end if
end function tNode_get_byKey_as1dInt end function tNode_get_byKey_as1dInt
@ -968,7 +968,7 @@ function tNode_get_byKey_as1dBool(self,k,defaultVal) result(nodeAs1dBool)
nodeAs1dBool = defaultVal nodeAs1dBool = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
end function tNode_get_byKey_as1dBool end function tNode_get_byKey_as1dBool
@ -999,7 +999,7 @@ function tNode_get_byKey_as1dString(self,k,defaultVal) result(nodeAs1dString)
nodeAs1dString = defaultVal nodeAs1dString = defaultVal
else else
call IO_error(143,ext_msg=k) call IO_error(143,ext_msg=k)
endif end if
end function tNode_get_byKey_as1dString end function tNode_get_byKey_as1dString
@ -1080,7 +1080,7 @@ recursive function tList_asFormattedString(self,indent) result(str)
indent_ = indent indent_ = indent
else else
indent_ = 0 indent_ = 0
endif end if
item => self%first item => self%first
do i = 1, self%length do i = 1, self%length
@ -1109,7 +1109,7 @@ recursive function tDict_asFormattedString(self,indent) result(str)
indent_ = indent indent_ = indent
else else
indent_ = 0 indent_ = 0
endif end if
item => self%first item => self%first
do i = 1, self%length do i = 1, self%length