Merge branch 'fortran-style-adjustments' into 'development'
Fortran style adjustments See merge request damask/DAMASK!682
This commit is contained in:
Martin Diehl
commit
a4e2702afb
|
|
@ -209,7 +209,7 @@ subroutine setWorkingDirectory(workingDirectoryArg)
|
|||
|
||||
workingDirectory = trim(rectifyPath(workingDirectory))
|
||||
error = setCWD(trim(workingDirectory))
|
||||
if(error) then
|
||||
if (error) then
|
||||
print*, 'ERROR: Invalid Working directory: '//trim(workingDirectory)
|
||||
call quit(1)
|
||||
end if
|
||||
|
|
@ -324,7 +324,7 @@ function rectifyPath(path)
|
|||
end if
|
||||
i = j+index(rectifyPath(j+1:l),'../')
|
||||
end do
|
||||
if(len_trim(rectifyPath) == 0) rectifyPath = '/'
|
||||
if (len_trim(rectifyPath) == 0) rectifyPath = '/'
|
||||
|
||||
rectifyPath = trim(rectifyPath)
|
||||
|
||||
|
|
|
|||
|
|
@ -183,7 +183,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
|
|||
end if
|
||||
|
||||
call H5Pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
#ifdef PETSC
|
||||
if (present(parallel)) then
|
||||
|
|
@ -197,24 +197,24 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
|
|||
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
|
||||
|
||||
if (m == 'w') then
|
||||
call H5Fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
elseif(m == 'a') then
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
elseif (m == 'a') then
|
||||
call H5Fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
elseif(m == 'r') then
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
elseif (m == 'r') then
|
||||
call H5Fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
else
|
||||
error stop 'unknown access mode'
|
||||
end if
|
||||
|
||||
call H5Pclose_f(plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end function HDF5_openFile
|
||||
|
||||
|
|
@ -229,7 +229,7 @@ subroutine HDF5_closeFile(fileHandle)
|
|||
integer :: hdferr
|
||||
|
||||
call H5Fclose_f(fileHandle,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_closeFile
|
||||
|
||||
|
|
@ -248,19 +248,19 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for data access properties
|
||||
call H5Pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! setting I/O mode to collective
|
||||
#ifdef PETSC
|
||||
call H5Pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
#endif
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! Create group
|
||||
call H5Gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Pclose_f(aplist_id,hdferr)
|
||||
|
||||
|
|
@ -284,19 +284,19 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for data access properties
|
||||
call H5Pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! setting I/O mode to collective
|
||||
#ifdef PETSC
|
||||
call H5Pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
#endif
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! opening the group
|
||||
call H5Gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Pclose_f(aplist_id,hdferr)
|
||||
|
||||
|
|
@ -313,7 +313,7 @@ subroutine HDF5_closeGroup(group_id)
|
|||
integer :: hdferr
|
||||
|
||||
call H5Gclose_f(group_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_closeGroup
|
||||
|
||||
|
|
@ -337,11 +337,11 @@ logical function HDF5_objectExists(loc_id,path)
|
|||
end if
|
||||
|
||||
call H5Lexists_f(loc_id, p, HDF5_objectExists, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
if(HDF5_objectExists) then
|
||||
if (HDF5_objectExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
end function HDF5_objectExists
|
||||
|
|
@ -374,24 +374,24 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
|
|||
ptr(1) = c_loc(attrValue_(1))
|
||||
|
||||
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (attrExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
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'
|
||||
call H5Awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aclose_f(attr_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_addAttribute_str
|
||||
|
||||
|
|
@ -419,24 +419,24 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
|
|||
end if
|
||||
|
||||
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (attrExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
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'
|
||||
call H5Awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aclose_f(attr_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_addAttribute_int
|
||||
|
||||
|
|
@ -464,24 +464,24 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
|
|||
end if
|
||||
|
||||
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (attrExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
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'
|
||||
call H5Awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aclose_f(attr_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_addAttribute_real
|
||||
|
||||
|
|
@ -516,24 +516,24 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
|
|||
end do
|
||||
|
||||
call H5Screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id,hdferr,shape(attrValue_,kind=HSIZE_T))
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (attrExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
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'
|
||||
call H5Awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aclose_f(attr_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_addAttribute_str_array
|
||||
|
||||
|
|
@ -564,24 +564,24 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
|
|||
array_size = size(attrValue,kind=HSIZE_T)
|
||||
|
||||
call H5Screate_simple_f(1, array_size, space_id, hdferr, array_size)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (attrExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
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'
|
||||
call H5Awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aclose_f(attr_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_addAttribute_int_array
|
||||
|
||||
|
|
@ -612,24 +612,24 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
|
|||
array_size = size(attrValue,kind=HSIZE_T)
|
||||
|
||||
call H5Screate_simple_f(1, array_size, space_id, hdferr, array_size)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (attrExists) then
|
||||
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'
|
||||
end if
|
||||
|
||||
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'
|
||||
call H5Awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Aclose_f(attr_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_addAttribute_real_array
|
||||
|
||||
|
|
@ -645,13 +645,13 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
|
|||
logical :: linkExists
|
||||
|
||||
call H5Lexists_f(loc_id, link_name,linkExists, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
if (linkExists) then
|
||||
call H5Ldelete_f(loc_id,link_name, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
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'
|
||||
|
||||
end subroutine HDF5_setLink
|
||||
|
||||
|
|
@ -687,7 +687,7 @@ subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -724,7 +724,7 @@ subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -761,7 +761,7 @@ subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -799,7 +799,7 @@ subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -837,7 +837,7 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -875,7 +875,7 @@ subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -913,7 +913,7 @@ subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -951,7 +951,7 @@ subroutine HDF5_read_int1(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -989,7 +989,7 @@ subroutine HDF5_read_int2(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1026,7 +1026,7 @@ subroutine HDF5_read_int3(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1063,7 +1063,7 @@ subroutine HDF5_read_int4(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1100,7 +1100,7 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1138,7 +1138,7 @@ subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1176,7 +1176,7 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
|
|||
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1218,7 +1218,7 @@ subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1259,7 +1259,7 @@ subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1300,7 +1300,7 @@ subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1341,7 +1341,7 @@ subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1383,7 +1383,7 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1424,7 +1424,7 @@ subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1465,7 +1465,7 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1529,7 +1529,7 @@ subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel)
|
|||
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)
|
||||
end select
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1556,14 +1556,14 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
|
|||
dataset_ = trim(dataset)
|
||||
|
||||
call H5Tcopy_f(H5T_C_S1, filetype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tset_size_f(filetype_id, int(len(dataset_)+1,HSIZE_T), hdferr) ! +1 for NULL
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tset_size_f(memtype_id, int(len(dataset_),HSIZE_T), hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
|
@ -1579,23 +1579,23 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
|
|||
end if
|
||||
|
||||
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'
|
||||
CALL H5Dcreate_f(loc_id, datasetName, filetype_id, space_id, dataset_id, hdferr, dcpl)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Dwrite_f(dataset_id, memtype_id, c_loc(dataset_(1:1)), hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Pclose_f(dcpl, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Dclose_f(dataset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(space_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(memtype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(filetype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine HDF5_write_str
|
||||
|
||||
|
|
@ -1635,7 +1635,7 @@ subroutine HDF5_write_int1(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1676,7 +1676,7 @@ subroutine HDF5_write_int2(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1717,7 +1717,7 @@ subroutine HDF5_write_int3(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1758,7 +1758,7 @@ subroutine HDF5_write_int4(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1799,7 +1799,7 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1840,7 +1840,7 @@ subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1881,7 +1881,7 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
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)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1945,7 +1945,7 @@ subroutine HDF5_write_int(dataset,loc_id,datasetName,parallel)
|
|||
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)
|
||||
end select
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
end if
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1978,7 +1978,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for transfer properties (is collective for MPI)
|
||||
call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
readSize = 0_MPI_INTEGER_KIND
|
||||
|
|
@ -1986,7 +1986,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
|
|||
#ifdef PETSC
|
||||
if (parallel) then
|
||||
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'
|
||||
call MPI_Allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get total output size over each process
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
end if
|
||||
|
|
@ -1997,35 +1997,35 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
|
|||
|
||||
if (any(globalShape == 0)) then
|
||||
call H5Pclose_f(plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
return
|
||||
end if
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataspace in memory (local shape)
|
||||
call H5Screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! creating a property list for IO and set it to collective
|
||||
call H5Pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
#ifdef PETSC
|
||||
call H5Pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! open the dataset in the file and get the space ID
|
||||
call H5Dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Dget_space_f(dset_id, filespace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! select a hyperslab (the portion of the current process) in the file
|
||||
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine initialize_read
|
||||
|
||||
|
|
@ -2039,15 +2039,15 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id
|
|||
integer :: hdferr
|
||||
|
||||
call H5Pclose_f(plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Pclose_f(aplist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Dclose_f(dset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(filespace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(memspace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine finalize_read
|
||||
|
||||
|
|
@ -2080,11 +2080,11 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for transfer properties (is collective when writing in parallel)
|
||||
call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
#ifdef PETSC
|
||||
if (parallel) then
|
||||
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'
|
||||
end if
|
||||
#endif
|
||||
|
||||
|
|
@ -2129,19 +2129,19 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataspace in memory (local shape) and in file (global shape)
|
||||
call H5Screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataset in the file and select a hyperslab from it (the portion of the current process)
|
||||
call H5Dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Pclose_f(dcpl , hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
contains
|
||||
!------------------------------------------------------------------------------------------------
|
||||
|
|
@ -2170,13 +2170,13 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
|||
integer :: hdferr
|
||||
|
||||
call H5Pclose_f(plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Dclose_f(dset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(filespace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(memspace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
end subroutine finalize_write
|
||||
|
||||
|
|
|
|||
|
|
@ -105,7 +105,7 @@ logical function solverIsSymmetric()
|
|||
status='old', position='rewind', action='read',iostat=myStat)
|
||||
do
|
||||
read (fileUnit,'(A)',END=100) line
|
||||
if(index(trim(lc(line)),'solver') == 1) then
|
||||
if (index(trim(lc(line)),'solver') == 1) then
|
||||
read (fileUnit,'(A)',END=100) line ! next line
|
||||
s = verify(line, ' ') ! start of first chunk
|
||||
s = s + verify(line(s+1:),' ') ! start of second chunk
|
||||
|
|
@ -286,7 +286,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|||
type(tList), pointer :: &
|
||||
debug_Marc ! pointer to Marc debug options
|
||||
|
||||
if(debug_basic) then
|
||||
if (debug_basic) then
|
||||
print'(a,/,i8,i8,i2)', ' MSC.Marc information on shape of element(2), IP:', m, nn
|
||||
print'(a,2(i1))', ' Jacobian: ', ngens,ngens
|
||||
print'(a,i1)', ' Direct stress: ', ndi
|
||||
|
|
@ -369,7 +369,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|||
d = ddsdde(1:ngens,1:ngens)
|
||||
s = stress(1:ndi+nshear)
|
||||
g = 0.0_pReal
|
||||
if(symmetricSolver) d = 0.5_pReal*(d+transpose(d))
|
||||
if (symmetricSolver) d = 0.5_pReal*(d+transpose(d))
|
||||
|
||||
call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
|
||||
|
||||
|
|
@ -428,7 +428,7 @@ subroutine uedinc(inc,incsub)
|
|||
do n = lbound(discretization_Marc_FEM2DAMASK_node,1), ubound(discretization_Marc_FEM2DAMASK_node,1)
|
||||
if (discretization_Marc_FEM2DAMASK_node(n) /= -1) then
|
||||
call nodvar(1,n,d_n(1:3,discretization_Marc_FEM2DAMASK_node(n)),nqncomp,nqdatatype)
|
||||
if(nqncomp == 2) d_n(3,discretization_Marc_FEM2DAMASK_node(n)) = 0.0_pReal
|
||||
if (nqncomp == 2) d_n(3,discretization_Marc_FEM2DAMASK_node(n)) = 0.0_pReal
|
||||
end if
|
||||
end do
|
||||
|
||||
|
|
|
|||
|
|
@ -271,8 +271,8 @@ subroutine inputRead_fileFormat(fileFormat,fileContent)
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 2) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'version') then
|
||||
if (chunkPos(1) < 2) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'version') then
|
||||
fileFormat = IO_intValue(fileContent(l),chunkPos,2)
|
||||
exit
|
||||
end if
|
||||
|
|
@ -297,8 +297,8 @@ subroutine inputRead_tableStyles(initialcond,hypoelastic,fileContent)
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 6) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'table') then
|
||||
if (chunkPos(1) < 6) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'table') then
|
||||
initialcond = IO_intValue(fileContent(l),chunkPos,4)
|
||||
hypoelastic = IO_intValue(fileContent(l),chunkPos,5)
|
||||
exit
|
||||
|
|
@ -324,8 +324,8 @@ subroutine inputRead_matNumber(matNumber, &
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'hypoelastic') then
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'hypoelastic') then
|
||||
if (len_trim(fileContent(l+1))/=0) then
|
||||
chunkPos = IO_stringPos(fileContent(l+1))
|
||||
data_blocks = IO_intValue(fileContent(l+1),chunkPos,1)
|
||||
|
|
@ -362,10 +362,10 @@ subroutine inputRead_NnodesAndElements(nNodes,nElems,&
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'sizing') then
|
||||
nElems = IO_IntValue (fileContent(l),chunkPos,3)
|
||||
elseif(IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
|
||||
elseif (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
|
||||
chunkPos = IO_stringPos(fileContent(l+1))
|
||||
nNodes = IO_IntValue (fileContent(l+1),chunkPos,2)
|
||||
end if
|
||||
|
|
@ -392,13 +392,13 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 2) cycle
|
||||
if(IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
|
||||
if (chunkPos(1) < 2) cycle
|
||||
if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
|
||||
IO_lc(IO_StringValue(fileContent(l),chunkPos,2)) == 'element') then
|
||||
nElemSets = nElemSets + 1
|
||||
|
||||
chunkPos = IO_stringPos(fileContent(l+1))
|
||||
if(containsRange(fileContent(l+1),chunkPos)) then
|
||||
if (containsRange(fileContent(l+1),chunkPos)) then
|
||||
elemInCurrentSet = 1 + abs( IO_intValue(fileContent(l+1),chunkPos,3) &
|
||||
-IO_intValue(fileContent(l+1),chunkPos,1))
|
||||
else
|
||||
|
|
@ -408,7 +408,7 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
|
|||
i = i + 1
|
||||
chunkPos = IO_stringPos(fileContent(l+i))
|
||||
elemInCurrentSet = elemInCurrentSet + chunkPos(1) - 1 ! add line's count when assuming 'c'
|
||||
if(IO_lc(IO_stringValue(fileContent(l+i),chunkPos,chunkPos(1))) /= 'c') then ! line finished, read last value
|
||||
if (IO_lc(IO_stringValue(fileContent(l+i),chunkPos,chunkPos(1))) /= 'c') then ! line finished, read last value
|
||||
elemInCurrentSet = elemInCurrentSet + 1 ! data ended
|
||||
exit
|
||||
end if
|
||||
|
|
@ -442,8 +442,8 @@ subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 2) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
|
||||
if (chunkPos(1) < 2) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
|
||||
IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'element') then
|
||||
elemSet = elemSet+1
|
||||
nameElemSet(elemSet) = trim(IO_stringValue(fileContent(l),chunkPos,4))
|
||||
|
|
@ -473,8 +473,8 @@ subroutine inputRead_mapElems(FEM2DAMASK, &
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
|
||||
j = 0
|
||||
do i = 1,nElems
|
||||
chunkPos = IO_stringPos(fileContent(l+1+i+j))
|
||||
|
|
@ -517,8 +517,8 @@ subroutine inputRead_mapNodes(FEM2DAMASK, &
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
|
||||
chunkPos = [1,1,10]
|
||||
do i = 1,nNodes
|
||||
map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i),chunkPos,1),i]
|
||||
|
|
@ -554,8 +554,8 @@ subroutine inputRead_elemNodes(nodes, &
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
|
||||
chunkPos = [4,1,10,11,30,31,50,51,70]
|
||||
do i=1,nNode
|
||||
m = discretization_Marc_FEM2DAMASK_node(IO_intValue(fileContent(l+1+i),chunkPos,1))
|
||||
|
|
@ -585,8 +585,8 @@ subroutine inputRead_elemType(elem, &
|
|||
t = -1
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
|
||||
j = 0
|
||||
do i=1,nElem ! read all elements
|
||||
chunkPos = IO_stringPos(fileContent(l+1+i+j))
|
||||
|
|
@ -676,8 +676,8 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 1) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
|
||||
if (chunkPos(1) < 1) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
|
||||
j = 0
|
||||
do i = 1,nElem
|
||||
chunkPos = IO_stringPos(fileContent(l+1+i+j))
|
||||
|
|
@ -733,8 +733,8 @@ subroutine inputRead_material(materialAt,&
|
|||
|
||||
do l = 1, size(fileContent)
|
||||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if(chunkPos(1) < 2) cycle
|
||||
if(IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
|
||||
if (chunkPos(1) < 2) cycle
|
||||
if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
|
||||
IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'state') then
|
||||
k = merge(2,1,initialcondTableStyle == 2)
|
||||
chunkPos = IO_stringPos(fileContent(l+k))
|
||||
|
|
@ -756,7 +756,7 @@ subroutine inputRead_material(materialAt,&
|
|||
end if
|
||||
end do
|
||||
|
||||
if(any(materialAt < 1)) call IO_error(180)
|
||||
if (any(materialAt < 1)) call IO_error(180)
|
||||
|
||||
end subroutine inputRead_material
|
||||
|
||||
|
|
@ -1122,8 +1122,8 @@ function IPneighborhood(elem)
|
|||
e = 1
|
||||
do while (e < size(face,2))
|
||||
e = e + 1
|
||||
if(any(face(:c,s) /= face(:c,e))) then
|
||||
if(e-1/=s) call math_sort(face(:,s:e-1),sortDim=c)
|
||||
if (any(face(:c,s) /= face(:c,e))) then
|
||||
if (e-1/=s) call math_sort(face(:,s:e-1),sortDim=c)
|
||||
s = e
|
||||
end if
|
||||
end do
|
||||
|
|
@ -1131,7 +1131,7 @@ function IPneighborhood(elem)
|
|||
|
||||
IPneighborhood = 0
|
||||
do c=1, size(face,2) - 1
|
||||
if(all(face(:n-1,c) == face(:n-1,c+1))) then
|
||||
if (all(face(:n-1,c) == face(:n-1,c+1))) then
|
||||
IPneighborhood(:,face(n+2,c+1),face(n+1,c+1),face(n+0,c+1)) = face(n:n+3,c+0)
|
||||
IPneighborhood(:,face(n+2,c+0),face(n+1,c+0),face(n+0,c+0)) = face(n:n+3,c+1)
|
||||
end if
|
||||
|
|
@ -1174,7 +1174,7 @@ function continuousIntValues(fileContent,maxN,lookupName,lookupMap,lookupMaxN)
|
|||
end if
|
||||
end do
|
||||
exit
|
||||
elseif(containsRange(fileContent(l),chunkPos)) then
|
||||
elseif (containsRange(fileContent(l),chunkPos)) then
|
||||
first = IO_intValue(fileContent(l),chunkPos,1)
|
||||
last = IO_intValue(fileContent(l),chunkPos,3)
|
||||
do i = first, last, sign(1,last-first)
|
||||
|
|
@ -1208,8 +1208,8 @@ logical function containsRange(str,chunkPos)
|
|||
|
||||
|
||||
containsRange = .False.
|
||||
if(chunkPos(1) == 3) then
|
||||
if(IO_lc(IO_stringValue(str,chunkPos,2)) == 'to') containsRange = .True.
|
||||
if (chunkPos(1) == 3) then
|
||||
if (IO_lc(IO_stringValue(str,chunkPos,2)) == 'to') containsRange = .True.
|
||||
end if
|
||||
|
||||
end function containsRange
|
||||
|
|
|
|||
|
|
@ -72,26 +72,26 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Initialize all modules.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine materialpoint_initAll
|
||||
subroutine materialpoint_initAll()
|
||||
|
||||
call DAMASK_interface_init
|
||||
call prec_init
|
||||
call IO_init
|
||||
call YAML_types_init
|
||||
call YAML_parse_init
|
||||
call HDF5_utilities_init
|
||||
call DAMASK_interface_init()
|
||||
call prec_init()
|
||||
call IO_init()
|
||||
call YAML_types_init()
|
||||
call YAML_parse_init()
|
||||
call HDF5_utilities_init()
|
||||
call results_init(.false.)
|
||||
call config_init
|
||||
call math_init
|
||||
call rotations_init
|
||||
call polynomials_init
|
||||
call lattice_init
|
||||
call discretization_Marc_init
|
||||
call config_init()
|
||||
call math_init()
|
||||
call rotations_init()
|
||||
call polynomials_init()
|
||||
call lattice_init()
|
||||
call discretization_Marc_init()
|
||||
call material_init(.false.)
|
||||
call phase_init
|
||||
call homogenization_init
|
||||
call materialpoint_init
|
||||
call config_deallocate
|
||||
call phase_init()
|
||||
call homogenization_init()
|
||||
call materialpoint_init()
|
||||
call config_deallocate()
|
||||
|
||||
end subroutine materialpoint_initAll
|
||||
|
||||
|
|
@ -99,7 +99,7 @@ end subroutine materialpoint_initAll
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief allocate the arrays defined in module materialpoint and initialize them
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine materialpoint_init
|
||||
subroutine materialpoint_init()
|
||||
|
||||
type(tList), pointer :: &
|
||||
debug_materialpoint
|
||||
|
|
@ -121,7 +121,7 @@ subroutine materialpoint_init
|
|||
debugmaterialpoint%element = config_debug%get_asInt('element',defaultVal = 1)
|
||||
debugmaterialpoint%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1)
|
||||
|
||||
if(debugmaterialpoint%basic) then
|
||||
if (debugmaterialpoint%basic) then
|
||||
print'(a32,1x,6(i8,1x))', 'materialpoint_cs: ', shape(materialpoint_cs)
|
||||
print'(a32,1x,6(i8,1x))', 'materialpoint_dcsdE: ', shape(materialpoint_dcsdE)
|
||||
print'(a32,1x,6(i8,1x),/)', 'materialpoint_dcsdE_knownGood: ', shape(materialpoint_dcsdE_knownGood)
|
||||
|
|
|
|||
|
|
@ -118,7 +118,7 @@ recursive function parse_flow(YAML_flow) result(node)
|
|||
d = s + scan(flow_string(s+1:),':')
|
||||
e = d + find_end(flow_string(d+1:),'}')
|
||||
key = trim(adjustl(flow_string(s+1:d-1)))
|
||||
if(quotedString(key)) key = key(2:len(key)-1)
|
||||
if (quotedString(key)) key = key(2:len(key)-1)
|
||||
myVal => parse_flow(flow_string(d+1:e-1)) ! parse items (recursively)
|
||||
|
||||
select type (node)
|
||||
|
|
@ -143,7 +143,7 @@ recursive function parse_flow(YAML_flow) result(node)
|
|||
allocate(tScalar::node)
|
||||
select type (node)
|
||||
class is (tScalar)
|
||||
if(quotedString(flow_string)) then
|
||||
if (quotedString(flow_string)) then
|
||||
node = trim(adjustl(flow_string(2:len(flow_string)-1)))
|
||||
else
|
||||
node = trim(adjustl(flow_string))
|
||||
|
|
@ -198,7 +198,7 @@ logical function quotedString(line)
|
|||
|
||||
if (scan(line(:1),IO_QUOTES) == 1) then
|
||||
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)
|
||||
end if
|
||||
|
||||
end function quotedString
|
||||
|
|
@ -245,7 +245,7 @@ integer function indentDepth(line,offset)
|
|||
integer, optional,intent(in) :: offset
|
||||
|
||||
indentDepth = verify(line,IO_WHITESPACE) -1
|
||||
if(present(offset)) indentDepth = indentDepth + offset
|
||||
if (present(offset)) indentDepth = indentDepth + offset
|
||||
|
||||
end function indentDepth
|
||||
|
||||
|
|
@ -285,7 +285,7 @@ logical function isListItem(line)
|
|||
character(len=*), intent(in) :: line
|
||||
|
||||
isListItem = .false.
|
||||
if(len_trim(adjustl(line))> 2 .and. index(trim(adjustl(line)), '-') == 1) then
|
||||
if (len_trim(adjustl(line))> 2 .and. index(trim(adjustl(line)), '-') == 1) then
|
||||
isListItem = scan(trim(adjustl(line)),' ') == 2
|
||||
else
|
||||
isListItem = trim(adjustl(line)) == '-'
|
||||
|
|
@ -302,8 +302,8 @@ logical function isKeyValue(line)
|
|||
character(len=*), intent(in) :: line
|
||||
isKeyValue = .false.
|
||||
|
||||
if( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then
|
||||
if(index(IO_rmComment(line),': ') > 0) isKeyValue = .true.
|
||||
if ( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then
|
||||
if (index(IO_rmComment(line),': ') > 0) isKeyValue = .true.
|
||||
end if
|
||||
|
||||
end function isKeyValue
|
||||
|
|
@ -317,7 +317,7 @@ logical function isKey(line)
|
|||
|
||||
character(len=*), intent(in) :: line
|
||||
|
||||
if(len(IO_rmComment(line)) == 0) then
|
||||
if (len(IO_rmComment(line)) == 0) then
|
||||
isKey = .false.
|
||||
else
|
||||
isKey = index(IO_rmComment(line),':',back=.false.) == len(IO_rmComment(line)) .and. &
|
||||
|
|
@ -354,7 +354,7 @@ subroutine skip_empty_lines(blck,s_blck)
|
|||
empty = .true.
|
||||
do while(empty .and. len_trim(blck(s_blck:)) /= 0)
|
||||
empty = len_trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0
|
||||
if(empty) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
|
||||
if (empty) s_blck = s_blck + index(blck(s_blck:),IO_EOL)
|
||||
end do
|
||||
|
||||
end subroutine skip_empty_lines
|
||||
|
|
@ -372,10 +372,10 @@ subroutine skip_file_header(blck,s_blck)
|
|||
character(len=:), allocatable :: line
|
||||
|
||||
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
|
||||
if(index(adjustl(line),'%YAML') == 1) then
|
||||
if (index(adjustl(line),'%YAML') == 1) then
|
||||
s_blck = s_blck + index(blck(s_blck:),IO_EOL)
|
||||
call skip_empty_lines(blck,s_blck)
|
||||
if(trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then
|
||||
if (trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then
|
||||
s_blck = s_blck + index(blck(s_blck:),IO_EOL)
|
||||
else
|
||||
call IO_error(708,ext_msg = line)
|
||||
|
|
@ -400,8 +400,8 @@ logical function flow_is_closed(str,e_char)
|
|||
flow_is_closed = .false.
|
||||
N_sq = 0
|
||||
N_cu = 0
|
||||
if(e_char == ']') line = str(index(str(:),'[')+1:)
|
||||
if(e_char == '}') line = str(index(str(:),'{')+1:)
|
||||
if (e_char == ']') line = str(index(str(:),'[')+1:)
|
||||
if (e_char == '}') line = str(index(str(:),'{')+1:)
|
||||
|
||||
do i = 1, len_trim(line)
|
||||
flow_is_closed = (N_sq==0 .and. N_cu==0 .and. scan(line(i:i),e_char) == 1)
|
||||
|
|
@ -463,7 +463,7 @@ subroutine list_item_inline(blck,s_blck,inline,offset)
|
|||
indent_next = indentDepth(blck(s_blck:))
|
||||
end do
|
||||
|
||||
if(scan(inline,",") > 0) inline = '"'//inline//'"'
|
||||
if (scan(inline,",") > 0) inline = '"'//inline//'"'
|
||||
|
||||
end subroutine list_item_inline
|
||||
|
||||
|
|
@ -483,19 +483,19 @@ recursive subroutine line_isFlow(flow,s_flow,line)
|
|||
list_chunk, &
|
||||
dict_chunk
|
||||
|
||||
if(index(adjustl(line),'[') == 1) then
|
||||
if (index(adjustl(line),'[') == 1) then
|
||||
s = index(line,'[')
|
||||
flow(s_flow:s_flow) = '['
|
||||
s_flow = s_flow +1
|
||||
do while(s < len_trim(line))
|
||||
list_chunk = s + find_end(line(s+1:),']')
|
||||
if(iskeyValue(line(s+1:list_chunk-1))) then
|
||||
if (iskeyValue(line(s+1:list_chunk-1))) then
|
||||
flow(s_flow:s_flow) = '{'
|
||||
s_flow = s_flow +1
|
||||
call keyValue_toFlow(flow,s_flow,line(s+1:list_chunk-1))
|
||||
flow(s_flow:s_flow) = '}'
|
||||
s_flow = s_flow +1
|
||||
elseif(isFlow(line(s+1:list_chunk-1))) then
|
||||
elseif (isFlow(line(s+1:list_chunk-1))) then
|
||||
call line_isFlow(flow,s_flow,line(s+1:list_chunk-1))
|
||||
else
|
||||
call line_toFlow(flow,s_flow,line(s+1:list_chunk-1))
|
||||
|
|
@ -509,20 +509,20 @@ recursive subroutine line_isFlow(flow,s_flow,line)
|
|||
flow(s_flow:s_flow) = ']'
|
||||
s_flow = s_flow+1
|
||||
|
||||
elseif(index(adjustl(line),'{') == 1) then
|
||||
elseif (index(adjustl(line),'{') == 1) then
|
||||
s = index(line,'{')
|
||||
flow(s_flow:s_flow) = '{'
|
||||
s_flow = s_flow +1
|
||||
do while(s < len_trim(line))
|
||||
dict_chunk = s + find_end(line(s+1:),'}')
|
||||
if( .not. iskeyValue(line(s+1:dict_chunk-1))) call IO_error(705,ext_msg=line)
|
||||
if ( .not. iskeyValue(line(s+1:dict_chunk-1))) call IO_error(705,ext_msg=line)
|
||||
call keyValue_toFlow(flow,s_flow,line(s+1:dict_chunk-1))
|
||||
flow(s_flow:s_flow+1) = ', '
|
||||
s_flow = s_flow +2
|
||||
s = s + find_end(line(s+1:),'}')
|
||||
end do
|
||||
s_flow = s_flow -1
|
||||
if(flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow -1
|
||||
if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow -1
|
||||
flow(s_flow:s_flow) = '}'
|
||||
s_flow = s_flow +1
|
||||
else
|
||||
|
|
@ -549,8 +549,8 @@ recursive subroutine keyValue_toFlow(flow,s_flow,line)
|
|||
offset_value
|
||||
|
||||
col_pos = index(line,':')
|
||||
if(line(col_pos+1:col_pos+1) /= ' ') call IO_error(704,ext_msg=line)
|
||||
if(isFlow(line(col_pos+1:))) then
|
||||
if (line(col_pos+1:col_pos+1) /= ' ') call IO_error(704,ext_msg=line)
|
||||
if (isFlow(line(col_pos+1:))) then
|
||||
d_flow = len_trim(adjustl(line(:col_pos)))
|
||||
flow(s_flow:s_flow+d_flow+1) = trim(adjustl(line(:col_pos)))//' '
|
||||
s_flow = s_flow + d_flow+1
|
||||
|
|
@ -605,35 +605,35 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
|
|||
do while (s_blck <= len_trim(blck))
|
||||
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
|
||||
line = IO_rmComment(blck(s_blck:e_blck))
|
||||
if(trim(line) == '---' .or. trim(line) == '...') then
|
||||
if (trim(line) == '---' .or. trim(line) == '...') then
|
||||
exit
|
||||
elseif (len_trim(line) == 0) then
|
||||
s_blck = e_blck + 2 ! forward to next line
|
||||
cycle
|
||||
elseif(indentDepth(line,offset) > indent) then
|
||||
elseif (indentDepth(line,offset) > indent) then
|
||||
call decide(blck,flow,s_blck,s_flow,offset)
|
||||
offset = 0
|
||||
flow(s_flow:s_flow+1) = ', '
|
||||
s_flow = s_flow + 2
|
||||
elseif(indentDepth(line,offset) < indent .or. .not. isListItem(line)) then
|
||||
elseif (indentDepth(line,offset) < indent .or. .not. isListItem(line)) then
|
||||
offset = 0
|
||||
exit ! job done (lower level)
|
||||
else
|
||||
if(trim(adjustl(line)) == '-') then ! list item in next line
|
||||
if (trim(adjustl(line)) == '-') then ! list item in next line
|
||||
s_blck = e_blck + 2
|
||||
call skip_empty_lines(blck,s_blck)
|
||||
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
|
||||
line = IO_rmComment(blck(s_blck:e_blck))
|
||||
if(trim(line) == '---') call IO_error(707,ext_msg=line)
|
||||
if(indentDepth(line) < indent .or. indentDepth(line) == indent) &
|
||||
if (trim(line) == '---') call IO_error(707,ext_msg=line)
|
||||
if (indentDepth(line) < indent .or. indentDepth(line) == indent) &
|
||||
call IO_error(701,ext_msg=line)
|
||||
|
||||
if(isScalar(line)) then
|
||||
if (isScalar(line)) then
|
||||
call line_toFlow(flow,s_flow,line)
|
||||
s_blck = e_blck +2
|
||||
offset = 0
|
||||
elseif(isFlow(line)) then
|
||||
if(isFlowList(line)) then
|
||||
elseif (isFlow(line)) then
|
||||
if (isFlowList(line)) then
|
||||
call remove_line_break(blck,s_blck,']',flow_line)
|
||||
else
|
||||
call remove_line_break(blck,s_blck,'}',flow_line)
|
||||
|
|
@ -643,13 +643,13 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
|
|||
end if
|
||||
else ! list item in the same line
|
||||
line = line(indentDepth(line)+3:)
|
||||
if(isScalar(line)) then
|
||||
if (isScalar(line)) then
|
||||
call list_item_inline(blck,s_blck,inline,offset)
|
||||
offset = 0
|
||||
call line_toFlow(flow,s_flow,inline)
|
||||
elseif(isFlow(line)) then
|
||||
elseif (isFlow(line)) then
|
||||
s_blck = s_blck + index(blck(s_blck:),'-')
|
||||
if(isFlowList(line)) then
|
||||
if (isFlowList(line)) then
|
||||
call remove_line_break(blck,s_blck,']',flow_line)
|
||||
else
|
||||
call remove_line_break(blck,s_blck,'}',flow_line)
|
||||
|
|
@ -663,7 +663,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
|
|||
end if
|
||||
end if
|
||||
|
||||
if(isScalar(line) .or. isFlow(line)) then
|
||||
if (isScalar(line) .or. isFlow(line)) then
|
||||
flow(s_flow:s_flow+1) = ', '
|
||||
s_flow = s_flow + 2
|
||||
end if
|
||||
|
|
@ -702,33 +702,33 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
|
|||
do while (s_blck <= len_trim(blck))
|
||||
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
|
||||
line = IO_rmComment(blck(s_blck:e_blck))
|
||||
if(trim(line) == '---' .or. trim(line) == '...') then
|
||||
if (trim(line) == '---' .or. trim(line) == '...') then
|
||||
exit
|
||||
elseif (len_trim(line) == 0) then
|
||||
s_blck = e_blck + 2 ! forward to next line
|
||||
cycle
|
||||
elseif(indentDepth(line,offset) < indent) then
|
||||
if(isScalar(line) .or. isFlow(line) .and. previous_isKey) &
|
||||
elseif (indentDepth(line,offset) < indent) then
|
||||
if (isScalar(line) .or. isFlow(line) .and. previous_isKey) &
|
||||
call IO_error(701,ext_msg=line)
|
||||
offset = 0
|
||||
exit ! job done (lower level)
|
||||
elseif(indentDepth(line,offset) > indent .or. isListItem(line)) then
|
||||
elseif (indentDepth(line,offset) > indent .or. isListItem(line)) then
|
||||
offset = 0
|
||||
call decide(blck,flow,s_blck,s_flow,offset)
|
||||
else
|
||||
if(isScalar(line)) call IO_error(701,ext_msg=line)
|
||||
if(isFlow(line)) call IO_error(702,ext_msg=line)
|
||||
if (isScalar(line)) call IO_error(701,ext_msg=line)
|
||||
if (isFlow(line)) call IO_error(702,ext_msg=line)
|
||||
|
||||
line = line(indentDepth(line)+1:)
|
||||
if(previous_isKey) then
|
||||
if (previous_isKey) then
|
||||
flow(s_flow-1:s_flow) = ', '
|
||||
s_flow = s_flow + 1
|
||||
end if
|
||||
|
||||
if(isKeyValue(line)) then
|
||||
if (isKeyValue(line)) then
|
||||
col_pos = index(line,':')
|
||||
if(isFlow(line(col_pos+1:))) then
|
||||
if(isFlowList(line(col_pos+1:))) then
|
||||
if (isFlow(line(col_pos+1:))) then
|
||||
if (isFlowList(line(col_pos+1:))) then
|
||||
call remove_line_break(blck,s_blck,']',flow_line)
|
||||
else
|
||||
call remove_line_break(blck,s_blck,'}',flow_line)
|
||||
|
|
@ -744,7 +744,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
|
|||
end if
|
||||
end if
|
||||
|
||||
if(isScalar(line) .or. isKeyValue(line)) then
|
||||
if (isScalar(line) .or. isKeyValue(line)) then
|
||||
flow(s_flow:s_flow) = ','
|
||||
s_flow = s_flow + 1
|
||||
previous_isKey = .false.
|
||||
|
|
@ -776,13 +776,13 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
|
|||
integer :: e_blck
|
||||
character(len=:), allocatable :: line,flow_line
|
||||
|
||||
if(s_blck <= len(blck)) then
|
||||
if (s_blck <= len(blck)) then
|
||||
call skip_empty_lines(blck,s_blck)
|
||||
e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2
|
||||
line = IO_rmComment(blck(s_blck:e_blck))
|
||||
if(trim(line) == '---' .or. trim(line) == '...') then
|
||||
if (trim(line) == '---' .or. trim(line) == '...') then
|
||||
continue ! end parsing at this point but not stop the simulation
|
||||
elseif(len_trim(line) == 0) then
|
||||
elseif (len_trim(line) == 0) then
|
||||
s_blck = e_blck +2
|
||||
call decide(blck,flow,s_blck,s_flow,offset)
|
||||
elseif (isListItem(line)) then
|
||||
|
|
@ -791,14 +791,14 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
|
|||
call lst(blck,flow,s_blck,s_flow,offset)
|
||||
flow(s_flow:s_flow) = ']'
|
||||
s_flow = s_flow + 1
|
||||
elseif(isKey(line) .or. isKeyValue(line)) then
|
||||
elseif (isKey(line) .or. isKeyValue(line)) then
|
||||
flow(s_flow:s_flow) = '{'
|
||||
s_flow = s_flow + 1
|
||||
call dct(blck,flow,s_blck,s_flow,offset)
|
||||
flow(s_flow:s_flow) = '}'
|
||||
s_flow = s_flow + 1
|
||||
elseif(isFlow(line)) then
|
||||
if(isFlowList(line)) then
|
||||
elseif (isFlow(line)) then
|
||||
if (isFlowList(line)) then
|
||||
call remove_line_break(blck,s_blck,']',flow_line)
|
||||
else
|
||||
call remove_line_break(blck,s_blck,'}',flow_line)
|
||||
|
|
@ -833,18 +833,18 @@ function to_flow(blck)
|
|||
s_blck = 1
|
||||
offset = 0
|
||||
|
||||
if(len_trim(blck) /= 0) then
|
||||
if (len_trim(blck) /= 0) then
|
||||
call skip_empty_lines(blck,s_blck)
|
||||
call skip_file_header(blck,s_blck)
|
||||
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)
|
||||
end if
|
||||
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))
|
||||
end_line = index(to_flow,IO_EOL)
|
||||
if(end_line > 0) to_flow = to_flow(:end_line-1)
|
||||
if (end_line > 0) to_flow = to_flow(:end_line-1)
|
||||
|
||||
end function to_flow
|
||||
|
||||
|
|
@ -852,7 +852,7 @@ end function to_flow
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Check correctness of some YAML functions.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine selfTest
|
||||
subroutine selfTest()
|
||||
|
||||
if (indentDepth(' a') /= 1) error stop 'indentDepth'
|
||||
if (indentDepth('a') /= 0) error stop 'indentDepth'
|
||||
|
|
@ -880,122 +880,122 @@ subroutine selfTest
|
|||
if (.not. isKey(' a:')) error stop 'isKey'
|
||||
if (.not. isKey(' a: #')) error stop 'isKey'
|
||||
|
||||
if( isScalar('a: ')) error stop 'isScalar'
|
||||
if( isScalar('a: b')) error stop 'isScalar'
|
||||
if( isScalar('{a:b}')) error stop 'isScalar'
|
||||
if( isScalar('- a:')) error stop 'isScalar'
|
||||
if(.not. isScalar(' a')) error stop 'isScalar'
|
||||
if ( isScalar('a: ')) error stop 'isScalar'
|
||||
if ( isScalar('a: b')) error stop 'isScalar'
|
||||
if ( isScalar('{a:b}')) error stop 'isScalar'
|
||||
if ( isScalar('- a:')) error stop 'isScalar'
|
||||
if (.not. isScalar(' a')) error stop 'isScalar'
|
||||
|
||||
basic_list: block
|
||||
character(len=*), parameter :: block_list = &
|
||||
" - Casablanca"//IO_EOL//&
|
||||
" - North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: block_list_newline = &
|
||||
" -"//IO_EOL//&
|
||||
" Casablanca"//IO_EOL//&
|
||||
" -"//IO_EOL//&
|
||||
" North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: flow_list = &
|
||||
"[Casablanca, North by Northwest]"
|
||||
character(len=*), parameter :: block_list = &
|
||||
" - Casablanca"//IO_EOL//&
|
||||
" - North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: block_list_newline = &
|
||||
" -"//IO_EOL//&
|
||||
" Casablanca"//IO_EOL//&
|
||||
" -"//IO_EOL//&
|
||||
" North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: flow_list = &
|
||||
"[Casablanca, North by Northwest]"
|
||||
|
||||
if (.not. to_flow(block_list) == flow_list) error stop 'to_flow'
|
||||
if (.not. to_flow(block_list_newline) == flow_list) error stop 'to_flow'
|
||||
if (.not. to_flow(block_list) == flow_list) error stop 'to_flow'
|
||||
if (.not. to_flow(block_list_newline) == flow_list) error stop 'to_flow'
|
||||
end block basic_list
|
||||
|
||||
basic_dict: block
|
||||
character(len=*), parameter :: block_dict = &
|
||||
" aa: Casablanca"//IO_EOL//&
|
||||
" bb: North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: block_dict_newline = &
|
||||
" aa:"//IO_EOL//&
|
||||
" Casablanca"//IO_EOL//&
|
||||
" bb:"//IO_EOL//&
|
||||
" North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: flow_dict = &
|
||||
"{aa: Casablanca, bb: North by Northwest}"
|
||||
character(len=*), parameter :: block_dict = &
|
||||
" aa: Casablanca"//IO_EOL//&
|
||||
" bb: North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: block_dict_newline = &
|
||||
" aa:"//IO_EOL//&
|
||||
" Casablanca"//IO_EOL//&
|
||||
" bb:"//IO_EOL//&
|
||||
" North by Northwest"//IO_EOL
|
||||
character(len=*), parameter :: flow_dict = &
|
||||
"{aa: Casablanca, bb: North by Northwest}"
|
||||
|
||||
if (.not. to_flow(block_dict) == flow_dict) error stop 'to_flow'
|
||||
if (.not. to_flow(block_dict_newline) == flow_dict) error stop 'to_flow'
|
||||
if (.not. to_flow(block_dict) == flow_dict) error stop 'to_flow'
|
||||
if (.not. to_flow(block_dict_newline) == flow_dict) error stop 'to_flow'
|
||||
end block basic_dict
|
||||
|
||||
only_flow: block
|
||||
character(len=*), parameter :: flow_dict = &
|
||||
" {a: [b,c: {d: e}, f: g, e]}"//IO_EOL
|
||||
character(len=*), parameter :: flow_list = &
|
||||
" [a,b: c, d,e: {f: g}]"//IO_EOL
|
||||
character(len=*), parameter :: flow_1 = &
|
||||
"{a: [b, {c: {d: e}}, {f: g}, e]}"
|
||||
character(len=*), parameter :: flow_2 = &
|
||||
"[a, {b: c}, d, {e: {f: g}}]"
|
||||
character(len=*), parameter :: flow_dict = &
|
||||
" {a: [b,c: {d: e}, f: g, e]}"//IO_EOL
|
||||
character(len=*), parameter :: flow_list = &
|
||||
" [a,b: c, d,e: {f: g}]"//IO_EOL
|
||||
character(len=*), parameter :: flow_1 = &
|
||||
"{a: [b, {c: {d: e}}, {f: g}, e]}"
|
||||
character(len=*), parameter :: flow_2 = &
|
||||
"[a, {b: c}, d, {e: {f: g}}]"
|
||||
|
||||
if (.not. to_flow(flow_dict) == flow_1) error stop 'to_flow'
|
||||
if (.not. to_flow(flow_list) == flow_2) error stop 'to_flow'
|
||||
if (.not. to_flow(flow_dict) == flow_1) error stop 'to_flow'
|
||||
if (.not. to_flow(flow_list) == flow_2) error stop 'to_flow'
|
||||
end block only_flow
|
||||
|
||||
basic_flow: block
|
||||
character(len=*), parameter :: flow_braces = &
|
||||
" source: [{param: 1}, {param: 2}, {param: 3}, {param: 4}]"//IO_EOL
|
||||
character(len=*), parameter :: flow_mixed_braces = &
|
||||
" source: [param: 1, {param: 2}, param: 3, {param: 4}]"//IO_EOL
|
||||
character(len=*), parameter :: flow = &
|
||||
"{source: [{param: 1}, {param: 2}, {param: 3}, {param: 4}]}"
|
||||
character(len=*), parameter :: flow_braces = &
|
||||
" source: [{param: 1}, {param: 2}, {param: 3}, {param: 4}]"//IO_EOL
|
||||
character(len=*), parameter :: flow_mixed_braces = &
|
||||
" source: [param: 1, {param: 2}, param: 3, {param: 4}]"//IO_EOL
|
||||
character(len=*), parameter :: flow = &
|
||||
"{source: [{param: 1}, {param: 2}, {param: 3}, {param: 4}]}"
|
||||
|
||||
if (.not. to_flow(flow_braces) == flow) error stop 'to_flow'
|
||||
if (.not. to_flow(flow_mixed_braces) == flow) error stop 'to_flow'
|
||||
if (.not. to_flow(flow_braces) == flow) error stop 'to_flow'
|
||||
if (.not. to_flow(flow_mixed_braces) == flow) error stop 'to_flow'
|
||||
end block basic_flow
|
||||
|
||||
multi_line_flow1: block
|
||||
character(len=*), parameter :: flow_multi = &
|
||||
'%YAML 1.1'//IO_EOL//&
|
||||
'---'//IO_EOL//&
|
||||
'a: ["b",'//IO_EOL//&
|
||||
'c: '//IO_EOL//&
|
||||
'"d", "e"]'//IO_EOL
|
||||
character(len=*), parameter :: flow_multi = &
|
||||
'%YAML 1.1'//IO_EOL//&
|
||||
'---'//IO_EOL//&
|
||||
'a: ["b",'//IO_EOL//&
|
||||
'c: '//IO_EOL//&
|
||||
'"d", "e"]'//IO_EOL
|
||||
|
||||
character(len=*), parameter :: flow = &
|
||||
'{a: ["b", {c: "d"}, "e"]}'
|
||||
character(len=*), parameter :: flow = &
|
||||
'{a: ["b", {c: "d"}, "e"]}'
|
||||
|
||||
if( .not. to_flow(flow_multi) == flow) error stop 'to_flow'
|
||||
if ( .not. to_flow(flow_multi) == flow) error stop 'to_flow'
|
||||
end block multi_line_flow1
|
||||
|
||||
multi_line_flow2: block
|
||||
character(len=*), parameter :: flow_multi = &
|
||||
"%YAML 1.1"//IO_EOL//&
|
||||
"---"//IO_EOL//&
|
||||
"-"//IO_EOL//&
|
||||
" a: {b:"//IO_EOL//&
|
||||
"[c,"//IO_EOL//&
|
||||
"d"//IO_EOL//&
|
||||
"e, f]}"//IO_EOL
|
||||
character(len=*), parameter :: flow_multi = &
|
||||
"%YAML 1.1"//IO_EOL//&
|
||||
"---"//IO_EOL//&
|
||||
"-"//IO_EOL//&
|
||||
" a: {b:"//IO_EOL//&
|
||||
"[c,"//IO_EOL//&
|
||||
"d"//IO_EOL//&
|
||||
"e, f]}"//IO_EOL
|
||||
|
||||
character(len=*), parameter :: flow = &
|
||||
"[{a: {b: [c, d e, f]}}]"
|
||||
character(len=*), parameter :: flow = &
|
||||
"[{a: {b: [c, d e, f]}}]"
|
||||
|
||||
if( .not. to_flow(flow_multi) == flow) error stop 'to_flow'
|
||||
if ( .not. to_flow(flow_multi) == flow) error stop 'to_flow'
|
||||
end block multi_line_flow2
|
||||
|
||||
basic_mixed: block
|
||||
character(len=*), parameter :: block_flow = &
|
||||
"%YAML 1.1"//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
"---"//IO_EOL//&
|
||||
" aa:"//IO_EOL//&
|
||||
" - "//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" param_1: [a: b, c, {d: {e: [f: g, h]}}]"//IO_EOL//&
|
||||
" - c:d"//IO_EOL//&
|
||||
" e.f,"//IO_EOL//&
|
||||
" bb:"//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" - "//IO_EOL//&
|
||||
" {param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}"//IO_EOL//&
|
||||
"..."//IO_EOL
|
||||
character(len=*), parameter :: mixed_flow = &
|
||||
'{aa: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}, "c:d e.f,"], bb: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}]}'
|
||||
character(len=*), parameter :: block_flow = &
|
||||
"%YAML 1.1"//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
"---"//IO_EOL//&
|
||||
" aa:"//IO_EOL//&
|
||||
" - "//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" param_1: [a: b, c, {d: {e: [f: g, h]}}]"//IO_EOL//&
|
||||
" - c:d"//IO_EOL//&
|
||||
" e.f,"//IO_EOL//&
|
||||
" bb:"//IO_EOL//&
|
||||
" "//IO_EOL//&
|
||||
" - "//IO_EOL//&
|
||||
" {param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}"//IO_EOL//&
|
||||
"..."//IO_EOL
|
||||
character(len=*), parameter :: mixed_flow = &
|
||||
'{aa: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}, "c:d e.f,"], bb: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}]}'
|
||||
|
||||
if(.not. to_flow(block_flow) == mixed_flow) error stop 'to_flow'
|
||||
if (.not. to_flow(block_flow) == mixed_flow) error stop 'to_flow'
|
||||
end block basic_mixed
|
||||
|
||||
end subroutine selfTest
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ subroutine discretization_init(materialAt,&
|
|||
discretization_NodeCoords0 = NodeCoords0
|
||||
discretization_NodeCoords = NodeCoords0
|
||||
|
||||
if(present(sharedNodesBegin)) then
|
||||
if (present(sharedNodesBegin)) then
|
||||
discretization_sharedNodesBegin = sharedNodesBegin
|
||||
else
|
||||
discretization_sharedNodesBegin = size(discretization_NodeCoords0,2)
|
||||
|
|
|
|||
|
|
@ -92,16 +92,16 @@ end subroutine geometry_plastic_nonlocal_setIPareaNormal
|
|||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine geometry_plastic_nonlocal_disable
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IPneighborhood)) &
|
||||
if (allocated(geometry_plastic_nonlocal_IPneighborhood)) &
|
||||
deallocate(geometry_plastic_nonlocal_IPneighborhood)
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IPvolume0)) &
|
||||
if (allocated(geometry_plastic_nonlocal_IPvolume0)) &
|
||||
deallocate(geometry_plastic_nonlocal_IPvolume0)
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IParea0)) &
|
||||
if (allocated(geometry_plastic_nonlocal_IParea0)) &
|
||||
deallocate(geometry_plastic_nonlocal_IParea0)
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IPareaNormal0)) &
|
||||
if (allocated(geometry_plastic_nonlocal_IPareaNormal0)) &
|
||||
deallocate(geometry_plastic_nonlocal_IPareaNormal0)
|
||||
|
||||
end subroutine geometry_plastic_nonlocal_disable
|
||||
|
|
|
|||
|
|
@ -73,10 +73,10 @@ function base64_to_bytes(base64_str,s,e) result(bytes)
|
|||
integer(pI64) :: s_bytes, e_bytes, s_str, e_str
|
||||
integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes
|
||||
|
||||
if(.not. validBase64(base64_str)) call IO_error(114,ext_msg='invalid character')
|
||||
if (.not. validBase64(base64_str)) call IO_error(114,ext_msg='invalid character')
|
||||
|
||||
if(present(s)) then
|
||||
if(s<1_pI64) call IO_error(114, ext_msg='s out of range')
|
||||
if (present(s)) then
|
||||
if (s<1_pI64) call IO_error(114, ext_msg='s out of range')
|
||||
s_str = ((s-1_pI64)/3_pI64)*4_pI64 + 1_pI64
|
||||
s_bytes = mod(s-1_pI64,3_pI64) + 1_pI64
|
||||
else
|
||||
|
|
@ -84,15 +84,15 @@ function base64_to_bytes(base64_str,s,e) result(bytes)
|
|||
s_bytes = 1_pI64
|
||||
end if
|
||||
|
||||
if(present(e)) then
|
||||
if(e>base64_nByte(len(base64_str,kind=pI64))) call IO_error(114, ext_msg='e out of range')
|
||||
if (present(e)) then
|
||||
if (e>base64_nByte(len(base64_str,kind=pI64))) call IO_error(114, ext_msg='e out of range')
|
||||
e_str = ((e-1_pI64)/3_pI64)*4_pI64 + 4_pI64
|
||||
e_bytes = e - base64_nByte(s_str)
|
||||
else
|
||||
e_str = len(base64_str,kind=pI64)
|
||||
e_bytes = base64_nByte(len(base64_str,kind=pI64)) - base64_nByte(s_str)
|
||||
if(base64_str(e_str-0_pI64:e_str-0_pI64) == '=') e_bytes = e_bytes - 1_pI64
|
||||
if(base64_str(e_str-1_pI64:e_str-1_pI64) == '=') e_bytes = e_bytes - 1_pI64
|
||||
if (base64_str(e_str-0_pI64:e_str-0_pI64) == '=') e_bytes = e_bytes - 1_pI64
|
||||
if (base64_str(e_str-1_pI64:e_str-1_pI64) == '=') e_bytes = e_bytes - 1_pI64
|
||||
end if
|
||||
|
||||
bytes = decodeBase64(base64_str(s_str:e_str))
|
||||
|
|
@ -118,7 +118,7 @@ pure function decodeBase64(base64_str) result(bytes)
|
|||
|
||||
do while(c < len(base64_str,kind=pI64))
|
||||
do p=0_pI64,3_pI64
|
||||
if(c+p<=len(base64_str,kind=pI64)) then
|
||||
if (c+p<=len(base64_str,kind=pI64)) then
|
||||
charPos(p) = int(index(base64_encoding,base64_str(c+p:c+p))-1,C_SIGNED_CHAR)
|
||||
else
|
||||
charPos(p) = 0_C_SIGNED_CHAR
|
||||
|
|
@ -151,9 +151,9 @@ pure logical function validBase64(base64_str)
|
|||
l = len(base64_str,pI64)
|
||||
validBase64 = .true.
|
||||
|
||||
if(mod(l,4_pI64)/=0_pI64 .or. l < 4_pI64) validBase64 = .false.
|
||||
if(verify(base64_str(:l-2_pI64),base64_encoding, kind=pI64) /= 0_pI64) validBase64 = .false.
|
||||
if(verify(base64_str(l-1_pI64:),base64_encoding//'=',kind=pI64) /= 0_pI64) validBase64 = .false.
|
||||
if (mod(l,4_pI64)/=0_pI64 .or. l < 4_pI64) validBase64 = .false.
|
||||
if (verify(base64_str(:l-2_pI64),base64_encoding, kind=pI64) /= 0_pI64) validBase64 = .false.
|
||||
if (verify(base64_str(l-1_pI64:),base64_encoding//'=',kind=pI64) /= 0_pI64) validBase64 = .false.
|
||||
|
||||
end function validBase64
|
||||
|
||||
|
|
@ -167,59 +167,59 @@ subroutine selfTest
|
|||
character(len=*), parameter :: zero_to_three = 'AAECAw=='
|
||||
|
||||
! https://en.wikipedia.org/wiki/Base64#Output_padding
|
||||
if(base64_nChar(20_pI64) /= 28_pI64) error stop 'base64_nChar/20/28'
|
||||
if(base64_nChar(19_pI64) /= 28_pI64) error stop 'base64_nChar/19/28'
|
||||
if(base64_nChar(18_pI64) /= 24_pI64) error stop 'base64_nChar/18/24'
|
||||
if(base64_nChar(17_pI64) /= 24_pI64) error stop 'base64_nChar/17/24'
|
||||
if(base64_nChar(16_pI64) /= 24_pI64) error stop 'base64_nChar/16/24'
|
||||
if (base64_nChar(20_pI64) /= 28_pI64) error stop 'base64_nChar/20/28'
|
||||
if (base64_nChar(19_pI64) /= 28_pI64) error stop 'base64_nChar/19/28'
|
||||
if (base64_nChar(18_pI64) /= 24_pI64) error stop 'base64_nChar/18/24'
|
||||
if (base64_nChar(17_pI64) /= 24_pI64) error stop 'base64_nChar/17/24'
|
||||
if (base64_nChar(16_pI64) /= 24_pI64) error stop 'base64_nChar/16/24'
|
||||
|
||||
if(base64_nByte(4_pI64) /= 3_pI64) error stop 'base64_nByte/4/3'
|
||||
if(base64_nByte(8_pI64) /= 6_pI64) error stop 'base64_nByte/8/6'
|
||||
if (base64_nByte(4_pI64) /= 3_pI64) error stop 'base64_nByte/4/3'
|
||||
if (base64_nByte(8_pI64) /= 6_pI64) error stop 'base64_nByte/8/6'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three)
|
||||
if(any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes//'
|
||||
if (any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes//'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three,e=1_pI64)
|
||||
if(any(bytes /= int([0],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes//1'
|
||||
if (any(bytes /= int([0],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes//1'
|
||||
bytes = base64_to_bytes(zero_to_three,e=2_pI64)
|
||||
if(any(bytes /= int([0,1],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes//2'
|
||||
if (any(bytes /= int([0,1],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes//2'
|
||||
bytes = base64_to_bytes(zero_to_three,e=3_pI64)
|
||||
if(any(bytes /= int([0,1,2],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes//3'
|
||||
if (any(bytes /= int([0,1,2],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes//3'
|
||||
bytes = base64_to_bytes(zero_to_three,e=4_pI64)
|
||||
if(any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes//4'
|
||||
if (any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes//4'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three,s=1_pI64)
|
||||
if(any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes/1/'
|
||||
if (any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes/1/'
|
||||
bytes = base64_to_bytes(zero_to_three,s=2_pI64)
|
||||
if(any(bytes /= int([1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes/2/'
|
||||
if (any(bytes /= int([1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes/2/'
|
||||
bytes = base64_to_bytes(zero_to_three,s=3_pI64)
|
||||
if(any(bytes /= int([2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/3/'
|
||||
if (any(bytes /= int([2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/3/'
|
||||
bytes = base64_to_bytes(zero_to_three,s=4_pI64)
|
||||
if(any(bytes /= int([3],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/4/'
|
||||
if (any(bytes /= int([3],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/4/'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three,s=1_pI64,e=1_pI64)
|
||||
if(any(bytes /= int([0],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/1/1'
|
||||
if (any(bytes /= int([0],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/1/1'
|
||||
bytes = base64_to_bytes(zero_to_three,s=2_pI64,e=2_pI64)
|
||||
if(any(bytes /= int([1],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/2/2'
|
||||
if (any(bytes /= int([1],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/2/2'
|
||||
bytes = base64_to_bytes(zero_to_three,s=3_pI64,e=3_pI64)
|
||||
if(any(bytes /= int([2],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/3/3'
|
||||
if (any(bytes /= int([2],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/3/3'
|
||||
bytes = base64_to_bytes(zero_to_three,s=4_pI64,e=4_pI64)
|
||||
if(any(bytes /= int([3],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/4/4'
|
||||
if (any(bytes /= int([3],C_SIGNED_CHAR)) .or. size(bytes) /= 1) error stop 'base64_to_bytes/4/4'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three,s=1_pI64,e=2_pI64)
|
||||
if(any(bytes /= int([0,1],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/1/2'
|
||||
if (any(bytes /= int([0,1],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/1/2'
|
||||
bytes = base64_to_bytes(zero_to_three,s=2_pI64,e=3_pI64)
|
||||
if(any(bytes /= int([1,2],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/2/3'
|
||||
if (any(bytes /= int([1,2],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/2/3'
|
||||
bytes = base64_to_bytes(zero_to_three,s=3_pI64,e=4_pI64)
|
||||
if(any(bytes /= int([2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/3/4'
|
||||
if (any(bytes /= int([2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 2) error stop 'base64_to_bytes/3/4'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three,s=1_pI64,e=3_pI64)
|
||||
if(any(bytes /= int([0,1,2],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes/1/3'
|
||||
if (any(bytes /= int([0,1,2],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes/1/3'
|
||||
bytes = base64_to_bytes(zero_to_three,s=2_pI64,e=4_pI64)
|
||||
if(any(bytes /= int([1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes/2/4'
|
||||
if (any(bytes /= int([1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 3) error stop 'base64_to_bytes/2/4'
|
||||
|
||||
bytes = base64_to_bytes(zero_to_three,s=1_pI64,e=4_pI64)
|
||||
if(any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes/1/4'
|
||||
if (any(bytes /= int([0,1,2,3],C_SIGNED_CHAR)) .or. size(bytes) /= 4) error stop 'base64_to_bytes/1/4'
|
||||
|
||||
end subroutine selfTest
|
||||
|
||||
|
|
|
|||
|
|
@ -179,7 +179,7 @@ subroutine grid_mechanical_FEM_init
|
|||
localK = 0_pPetscInt
|
||||
localK(worldrank) = int(cells3,pPetscInt)
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
call DMDACreate3d(PETSC_COMM_WORLD, &
|
||||
DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, &
|
||||
DMDA_STENCIL_BOX, &
|
||||
|
|
@ -252,16 +252,16 @@ subroutine grid_mechanical_FEM_init
|
|||
|
||||
call HDF5_read(P_aim,groupHandle,'P_aim',.false.)
|
||||
call MPI_Bcast(P_aim,9_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
call HDF5_read(F_aim,groupHandle,'F_aim',.false.)
|
||||
call MPI_Bcast(F_aim,9_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
call HDF5_read(F_aim_lastInc,groupHandle,'F_aim_lastInc',.false.)
|
||||
call MPI_Bcast(F_aim_lastInc,9_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
call HDF5_read(F_aimDot,groupHandle,'F_aimDot',.false.)
|
||||
call MPI_Bcast(F_aimDot,9_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
call HDF5_read(temp33n,groupHandle,'F')
|
||||
F = reshape(temp33n,[3,3,cells(1),cells(2),cells3])
|
||||
call HDF5_read(temp33n,groupHandle,'F_lastInc')
|
||||
|
|
@ -290,10 +290,10 @@ subroutine grid_mechanical_FEM_init
|
|||
print'(1x,a,i0,a)', 'reading more restart data of increment ', CLI_restartInc, ' from file'
|
||||
call HDF5_read(C_volAvg,groupHandle,'C_volAvg',.false.)
|
||||
call MPI_Bcast(C_volAvg,81_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
call HDF5_read(C_volAvgLastInc,groupHandle,'C_volAvgLastInc',.false.)
|
||||
call MPI_Bcast(C_volAvgLastInc,81_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
|
||||
call HDF5_closeGroup(groupHandle)
|
||||
call HDF5_closeFile(fileHandle)
|
||||
|
|
@ -590,7 +590,7 @@ subroutine formResidual(da_local,x_local, &
|
|||
P_av,C_volAvg,devNull, &
|
||||
F,params%Delta_t,params%rotation_BC)
|
||||
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! stress BC handling
|
||||
|
|
|
|||
|
|
@ -245,8 +245,8 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
|
|||
|
||||
call phase_restore(ce,.false.) ! wrong name (is more a forward function)
|
||||
|
||||
if(homogState(ho)%sizeState > 0) homogState(ho)%state(:,en) = homogState(ho)%state0(:,en)
|
||||
if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%state(:,en) = damageState_h(ho)%state0(:,en)
|
||||
if (homogState(ho)%sizeState > 0) homogState(ho)%state(:,en) = homogState(ho)%state0(:,en)
|
||||
if (damageState_h(ho)%sizeState > 0) damageState_h(ho)%state(:,en) = damageState_h(ho)%state0(:,en)
|
||||
call damage_partition(ce)
|
||||
|
||||
doneAndHappy = [.false.,.true.]
|
||||
|
|
@ -381,7 +381,7 @@ subroutine homogenization_forward
|
|||
|
||||
do ho = 1, size(material_name_homogenization)
|
||||
homogState (ho)%state0 = homogState (ho)%state
|
||||
if(damageState_h(ho)%sizeState > 0) &
|
||||
if (damageState_h(ho)%sizeState > 0) &
|
||||
damageState_h(ho)%state0 = damageState_h(ho)%state
|
||||
end do
|
||||
|
||||
|
|
@ -406,7 +406,7 @@ subroutine homogenization_restartWrite(fileHandle)
|
|||
|
||||
call HDF5_write(homogState(ho)%state,groupHandle(2),'omega_mechanical') ! ToDo: should be done by mech
|
||||
|
||||
if(damageState_h(ho)%sizeState > 0) &
|
||||
if (damageState_h(ho)%sizeState > 0) &
|
||||
call HDF5_write(damageState_h(ho)%state,groupHandle(2),'omega_damage') ! ToDo: should be done by mech
|
||||
|
||||
call HDF5_closeGroup(groupHandle(2))
|
||||
|
|
@ -436,7 +436,7 @@ subroutine homogenization_restartRead(fileHandle)
|
|||
|
||||
call HDF5_read(homogState(ho)%state0,groupHandle(2),'omega_mechanical') ! ToDo: should be done by mech
|
||||
|
||||
if(damageState_h(ho)%sizeState > 0) &
|
||||
if (damageState_h(ho)%sizeState > 0) &
|
||||
call HDF5_read(damageState_h(ho)%state0,groupHandle(2),'omega_damage') ! ToDo: should be done by mech
|
||||
|
||||
call HDF5_closeGroup(groupHandle(2))
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ module subroutine damage_partition(ce)
|
|||
integer :: co
|
||||
|
||||
|
||||
if(damageState_h(material_homogenizationID(ce))%sizeState < 1) return
|
||||
if (damageState_h(material_homogenizationID(ce))%sizeState < 1) return
|
||||
phi = damagestate_h(material_homogenizationID(ce))%state(1,material_homogenizationEntry(ce))
|
||||
do co = 1, homogenization_Nconstituents(material_homogenizationID(ce))
|
||||
call phase_set_phi(phi,co,ce)
|
||||
|
|
|
|||
|
|
@ -40,37 +40,37 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Initialize all modules.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine materialpoint_initAll
|
||||
subroutine materialpoint_initAll()
|
||||
|
||||
call parallelization_init
|
||||
call CLI_init ! Spectral and FEM interface to commandline
|
||||
call signals_init
|
||||
call prec_init
|
||||
call IO_init
|
||||
call parallelization_init()
|
||||
call CLI_init() ! grid and mesh commandline interface
|
||||
call signals_init()
|
||||
call prec_init()
|
||||
call IO_init()
|
||||
#if defined(MESH)
|
||||
call FEM_quadrature_init
|
||||
call FEM_quadrature_init()
|
||||
#elif defined(GRID)
|
||||
call base64_init
|
||||
call base64_init()
|
||||
#endif
|
||||
call YAML_types_init
|
||||
call YAML_parse_init
|
||||
call HDF5_utilities_init
|
||||
call YAML_types_init()
|
||||
call YAML_parse_init()
|
||||
call HDF5_utilities_init()
|
||||
call results_init(restart=CLI_restartInc>0)
|
||||
call config_init
|
||||
call math_init
|
||||
call rotations_init
|
||||
call polynomials_init
|
||||
call lattice_init
|
||||
call config_init()
|
||||
call math_init()
|
||||
call rotations_init()
|
||||
call polynomials_init()
|
||||
call lattice_init()
|
||||
#if defined(MESH)
|
||||
call discretization_mesh_init(restart=CLI_restartInc>0)
|
||||
#elif defined(GRID)
|
||||
call discretization_grid_init(restart=CLI_restartInc>0)
|
||||
#endif
|
||||
call material_init(restart=CLI_restartInc>0)
|
||||
call phase_init
|
||||
call homogenization_init
|
||||
call materialpoint_init
|
||||
call config_deallocate
|
||||
call phase_init()
|
||||
call homogenization_init()
|
||||
call materialpoint_init()
|
||||
call config_deallocate()
|
||||
|
||||
end subroutine materialpoint_initAll
|
||||
|
||||
|
|
@ -78,7 +78,7 @@ end subroutine materialpoint_initAll
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Read restart information if needed.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine materialpoint_init
|
||||
subroutine materialpoint_init()
|
||||
|
||||
integer(HID_T) :: fileHandle
|
||||
|
||||
|
|
@ -103,7 +103,7 @@ end subroutine materialpoint_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Write restart information.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine materialpoint_restartWrite
|
||||
subroutine materialpoint_restartWrite()
|
||||
|
||||
integer(HID_T) :: fileHandle
|
||||
|
||||
|
|
@ -123,10 +123,10 @@ end subroutine materialpoint_restartWrite
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Forward data for new time increment.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine materialpoint_forward
|
||||
subroutine materialpoint_forward()
|
||||
|
||||
call homogenization_forward
|
||||
call phase_forward
|
||||
call homogenization_forward()
|
||||
call phase_forward()
|
||||
|
||||
end subroutine materialpoint_forward
|
||||
|
||||
|
|
@ -139,13 +139,13 @@ subroutine materialpoint_results(inc,time)
|
|||
integer, intent(in) :: inc
|
||||
real(pReal), intent(in) :: time
|
||||
|
||||
call results_openJobFile
|
||||
call results_openJobFile()
|
||||
call results_addIncrement(inc,time)
|
||||
call phase_results
|
||||
call homogenization_results
|
||||
call discretization_results
|
||||
call results_finalizeIncrement
|
||||
call results_closeJobFile
|
||||
call phase_results()
|
||||
call homogenization_results()
|
||||
call discretization_results()
|
||||
call results_finalizeIncrement()
|
||||
call results_closeJobFile()
|
||||
|
||||
end subroutine materialpoint_results
|
||||
|
||||
|
|
|
|||
|
|
@ -120,14 +120,14 @@ subroutine FEM_utilities_init
|
|||
debug_mesh => config_debug%get_dict('mesh',defaultVal=emptyDict)
|
||||
debugPETSc = debug_mesh%contains('PETSc')
|
||||
|
||||
if(debugPETSc) print'(3(/,1x,a),/)', &
|
||||
if (debugPETSc) print'(3(/,1x,a),/)', &
|
||||
'Initializing PETSc with debug options: ', &
|
||||
trim(PETScDebug), &
|
||||
'add more using the "PETSc_options" keyword in numerics.yaml'
|
||||
flush(IO_STDOUT)
|
||||
call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
|
||||
CHKERRQ(err_PETSc)
|
||||
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),err_PETSc)
|
||||
if (debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),err_PETSc)
|
||||
CHKERRQ(err_PETSc)
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type newtonls &
|
||||
&-mechanical_snes_linesearch_type cp -mechanical_snes_ksp_ew &
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Initialize shared memory (openMP) and distributed memory (MPI) parallelization.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine parallelization_init
|
||||
subroutine parallelization_init()
|
||||
|
||||
integer(MPI_INTEGER_KIND) :: err_MPI, typeSize, version, subversion, devNull
|
||||
character(len=4) :: rank_str
|
||||
|
|
@ -136,7 +136,7 @@ subroutine parallelization_init
|
|||
error stop 'Mismatch between MPI_DOUBLE and DAMASK pReal'
|
||||
|
||||
!$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
|
||||
!$ if(got_env /= 0) then
|
||||
!$ if (got_env /= 0) then
|
||||
!$ print'(1x,a)', 'Could not get $OMP_NUM_THREADS, using default'
|
||||
!$ OMP_NUM_THREADS = 4_pI32
|
||||
!$ else
|
||||
|
|
|
|||
|
|
@ -596,7 +596,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
|
|||
dotState_last(1:sizeDotState,1) = dotState
|
||||
|
||||
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
|
||||
if(broken) exit iteration
|
||||
if (broken) exit iteration
|
||||
|
||||
dotState = plastic_dotState(Delta_t,ph,en)
|
||||
if (any(IEEE_is_NaN(dotState))) exit iteration
|
||||
|
|
@ -677,7 +677,7 @@ function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result
|
|||
#endif
|
||||
|
||||
broken = plastic_deltaState(ph,en)
|
||||
if(broken) return
|
||||
if (broken) return
|
||||
|
||||
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
|
||||
|
||||
|
|
@ -720,10 +720,10 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
|
|||
#endif
|
||||
|
||||
broken = plastic_deltaState(ph,en)
|
||||
if(broken) return
|
||||
if (broken) return
|
||||
|
||||
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
|
||||
if(broken) return
|
||||
if (broken) return
|
||||
|
||||
dotState = plastic_dotState(Delta_t,ph,en)
|
||||
if (any(IEEE_is_NaN(dotState))) return
|
||||
|
|
@ -852,13 +852,13 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
|
|||
#endif
|
||||
|
||||
broken = integrateStress(F_0+(F-F_0)*Delta_t*C(stage),subFp0,subFi0,Delta_t*C(stage), ph,en)
|
||||
if(broken) exit
|
||||
if (broken) exit
|
||||
|
||||
dotState = plastic_dotState(Delta_t*C(stage), ph,en)
|
||||
if (any(IEEE_is_NaN(dotState))) exit
|
||||
|
||||
end do
|
||||
if(broken) return
|
||||
if (broken) return
|
||||
|
||||
|
||||
plastic_RKdotState(1:sizeDotState,size(B)) = dotState
|
||||
|
|
@ -869,15 +869,15 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
|
|||
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
|
||||
#endif
|
||||
|
||||
if(present(DB)) &
|
||||
if (present(DB)) &
|
||||
broken = .not. converged(matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) * Delta_t, &
|
||||
plasticState(ph)%state(1:sizeDotState,en), &
|
||||
plasticState(ph)%atol(1:sizeDotState))
|
||||
|
||||
if(broken) return
|
||||
if (broken) return
|
||||
|
||||
broken = plastic_deltaState(ph,en)
|
||||
if(broken) return
|
||||
if (broken) return
|
||||
|
||||
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
|
||||
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ module function damage_anisobrittle_init() result(myKinematics)
|
|||
|
||||
|
||||
myKinematics = kinematics_active2('anisobrittle')
|
||||
if(count(myKinematics) == 0) return
|
||||
if (count(myKinematics) == 0) return
|
||||
|
||||
print'(/,1x,a)', '<<<+- phase:mechanical:eigen:cleavageopening init -+>>>'
|
||||
print'(/,a,i2)', ' # phases: ',count(myKinematics); flush(IO_STDOUT)
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ module function plastic_isotropic_init() result(myPlasticity)
|
|||
|
||||
|
||||
myPlasticity = plastic_active('isotropic')
|
||||
if(count(myPlasticity) == 0) return
|
||||
if (count(myPlasticity) == 0) return
|
||||
|
||||
print'(/,1x,a)', '<<<+- phase:mechanical:plastic:isotropic init -+>>>'
|
||||
print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
|
||||
|
|
@ -77,7 +77,7 @@ module function plastic_isotropic_init() result(myPlasticity)
|
|||
allocate(state(phases%length))
|
||||
|
||||
do ph = 1, phases%length
|
||||
if(.not. myPlasticity(ph)) cycle
|
||||
if (.not. myPlasticity(ph)) cycle
|
||||
|
||||
associate(prm => param(ph), stt => state(ph))
|
||||
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
|
|||
pl
|
||||
|
||||
myPlasticity = plastic_active('kinehardening')
|
||||
if(count(myPlasticity) == 0) return
|
||||
if (count(myPlasticity) == 0) return
|
||||
|
||||
print'(/,1x,a)', '<<<+- phase:mechanical:plastic:kinehardening init -+>>>'
|
||||
print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
|
||||
|
|
@ -127,7 +127,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
|
|||
|
||||
if (phase_lattice(ph) == 'cI') then
|
||||
a = pl%get_as1dFloat('a_nonSchmid',defaultVal = emptyRealArray)
|
||||
if(size(a) > 0) prm%nonSchmidActive = .true.
|
||||
if (size(a) > 0) prm%nonSchmidActive = .true.
|
||||
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1)
|
||||
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1)
|
||||
else
|
||||
|
|
@ -189,7 +189,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
|
|||
stt%xi => plasticState(ph)%state(startIndex:endIndex,:)
|
||||
stt%xi = spread(xi_0, 2, Nmembers)
|
||||
plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
|
||||
if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
|
||||
if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
|
||||
|
||||
startIndex = endIndex + 1
|
||||
endIndex = endIndex + prm%sum_N_sl
|
||||
|
|
@ -202,7 +202,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
|
|||
idx_dot%gamma = [startIndex,endIndex]
|
||||
stt%gamma => plasticState(ph)%state(startIndex:endIndex,:)
|
||||
plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
|
||||
if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
|
||||
if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
|
||||
|
||||
o = plasticState(ph)%offsetDeltaState
|
||||
startIndex = endIndex + 1
|
||||
|
|
|
|||
|
|
@ -251,7 +251,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
|
|||
|
||||
if (phase_lattice(ph) == 'cI') then
|
||||
a = pl%get_as1dFloat('a_nonSchmid',defaultVal = emptyRealArray)
|
||||
if(size(a) > 0) prm%nonSchmidActive = .true.
|
||||
if (size(a) > 0) prm%nonSchmidActive = .true.
|
||||
prm%P_nS_pos = lattice_nonSchmidMatrix(ini%N_sl,a,+1)
|
||||
prm%P_nS_neg = lattice_nonSchmidMatrix(ini%N_sl,a,-1)
|
||||
else
|
||||
|
|
@ -416,7 +416,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
|
|||
allocate(geom(ph)%IPcoordinates(3,Nmembers))
|
||||
call storeGeometry(ph)
|
||||
|
||||
if(plasticState(ph)%nonlocal .and. .not. allocated(IPneighborhood)) &
|
||||
if (plasticState(ph)%nonlocal .and. .not. allocated(IPneighborhood)) &
|
||||
call IO_error(212,ext_msg='IPneighborhood does not exist')
|
||||
|
||||
st0%rho => plasticState(ph)%state0 (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:)
|
||||
|
|
@ -485,7 +485,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
|
|||
dot%gamma => plasticState(ph)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers)
|
||||
del%gamma => plasticState(ph)%deltaState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers)
|
||||
plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = pl%get_asFloat('atol_gamma', defaultVal = 1.0e-6_pReal)
|
||||
if(any(plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pReal)) &
|
||||
if (any(plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pReal)) &
|
||||
extmsg = trim(extmsg)//' atol_gamma'
|
||||
|
||||
stt%rho_forest => plasticState(ph)%state (11*prm%sum_N_sl + 1:12*prm%sum_N_sl,1:Nmembers)
|
||||
|
|
@ -518,7 +518,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
|
|||
|
||||
do ph = 1, phases%length
|
||||
|
||||
if(.not. myPlasticity(ph)) cycle
|
||||
if (.not. myPlasticity(ph)) cycle
|
||||
|
||||
phase => phases%get_dict(ph)
|
||||
Nmembers = count(material_phaseID == ph)
|
||||
|
|
|
|||
|
|
@ -100,7 +100,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
|
|||
|
||||
|
||||
myPlasticity = plastic_active('phenopowerlaw')
|
||||
if(count(myPlasticity) == 0) return
|
||||
if (count(myPlasticity) == 0) return
|
||||
|
||||
print'(/,1x,a)', '<<<+- phase:mechanical:plastic:phenopowerlaw init -+>>>'
|
||||
print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
|
||||
|
|
@ -131,7 +131,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
|
|||
|
||||
if (phase_lattice(ph) == 'cI') then
|
||||
a = pl%get_as1dFloat('a_nonSchmid',defaultVal=emptyRealArray)
|
||||
if(size(a) > 0) prm%nonSchmidActive = .true.
|
||||
if (size(a) > 0) prm%nonSchmidActive = .true.
|
||||
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1)
|
||||
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1)
|
||||
else
|
||||
|
|
@ -243,7 +243,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
|
|||
stt%xi_sl => plasticState(ph)%state(startIndex:endIndex,:)
|
||||
stt%xi_sl = spread(xi_0_sl, 2, Nmembers)
|
||||
plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
|
||||
if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
|
||||
if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
|
||||
|
||||
startIndex = endIndex + 1
|
||||
endIndex = endIndex + prm%sum_N_tw
|
||||
|
|
@ -257,7 +257,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
|
|||
idx_dot%gamma_sl = [startIndex,endIndex]
|
||||
stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:)
|
||||
plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
|
||||
if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
|
||||
if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
|
||||
|
||||
startIndex = endIndex + 1
|
||||
endIndex = endIndex + prm%sum_N_tw
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ module function dissipation_init(source_length) result(mySources)
|
|||
|
||||
|
||||
mySources = thermal_active('dissipation',source_length)
|
||||
if(count(mySources) == 0) return
|
||||
if (count(mySources) == 0) return
|
||||
print'(/,1x,a)', '<<<+- phase:thermal:dissipation init -+>>>'
|
||||
print'(/,a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT)
|
||||
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ module function externalheat_init(source_length) result(mySources)
|
|||
|
||||
|
||||
mySources = thermal_active('externalheat',source_length)
|
||||
if(count(mySources) == 0) return
|
||||
if (count(mySources) == 0) return
|
||||
print'(/,1x,a)', '<<<+- phase:thermal:externalheat init -+>>>'
|
||||
print'(/,a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Martin Diehl, KU Leuven
|
||||
!> @brief Polynomial representation for variable data
|
||||
!> @brief Polynomial representation for variable data.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module polynomials
|
||||
use prec
|
||||
|
|
@ -19,8 +19,8 @@ module polynomials
|
|||
end type tPolynomial
|
||||
|
||||
interface polynomial
|
||||
module procedure polynomial_from_dict
|
||||
module procedure polynomial_from_coef
|
||||
module procedure polynomial_from_dict
|
||||
end interface polynomial
|
||||
|
||||
public :: &
|
||||
|
|
@ -43,7 +43,7 @@ end subroutine polynomials_init
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Initialize a Polynomial from Coefficients.
|
||||
!> @brief Initialize a polynomial from coefficients.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function polynomial_from_coef(coef,x_ref) result(p)
|
||||
|
||||
|
|
@ -59,7 +59,7 @@ end function polynomial_from_coef
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Initialize a Polynomial from a Dictionary with Coefficients.
|
||||
!> @brief Initialize a polynomial from a dictionary with coefficients.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function polynomial_from_dict(dict,y,x) result(p)
|
||||
|
||||
|
|
@ -93,7 +93,7 @@ end function polynomial_from_dict
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Evaluate a Polynomial.
|
||||
!> @brief Evaluate a polynomial.
|
||||
!> @details https://nvlpubs.nist.gov/nistpubs/jres/71b/jresv71bn1p11_a1b.pdf (eq. 1.2)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function eval(self,x) result(y)
|
||||
|
|
|
|||
124
src/results.f90
124
src/results.f90
|
|
@ -421,15 +421,15 @@ subroutine results_writeTensorDataset_real(dataset,group,label,description,SIuni
|
|||
real(pReal), dimension(:,:,:), allocatable :: dataset_transposed
|
||||
|
||||
|
||||
if(present(transposed)) then
|
||||
if (present(transposed)) then
|
||||
transposed_ = transposed
|
||||
else
|
||||
transposed_ = .true.
|
||||
end if
|
||||
|
||||
groupHandle = results_openGroup(group)
|
||||
if(transposed_) then
|
||||
if(size(dataset,1) /= size(dataset,2)) error stop 'transpose non-symmetric tensor'
|
||||
if (transposed_) then
|
||||
if (size(dataset,1) /= size(dataset,2)) error stop 'transpose non-symmetric tensor'
|
||||
allocate(dataset_transposed,mold=dataset)
|
||||
do i=1,size(dataset_transposed,3)
|
||||
dataset_transposed(:,:,i) = transpose(dataset(:,:,i))
|
||||
|
|
@ -527,7 +527,7 @@ subroutine results_mapping_phase(ID,entry,label)
|
|||
writeSize(worldrank) = size(entry(1,:)) ! total number of entries of this process
|
||||
|
||||
call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
#ifndef PETSC
|
||||
entryGlobal = int(entry -1,pI64) ! 0-based
|
||||
|
|
@ -535,10 +535,10 @@ subroutine results_mapping_phase(ID,entry,label)
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! MPI settings and communication
|
||||
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'
|
||||
|
||||
call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
|
||||
entryOffset = 0_pI64
|
||||
do co = 1, size(ID,1)
|
||||
|
|
@ -547,7 +547,7 @@ subroutine results_mapping_phase(ID,entry,label)
|
|||
end do
|
||||
end do
|
||||
call MPI_Allreduce(MPI_IN_PLACE,entryOffset,size(entryOffset),MPI_INTEGER8,MPI_SUM,MPI_COMM_WORLD,err_MPI)! get offset at each process
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
entryOffset(:,worldrank) = sum(entryOffset(:,0:worldrank-1),2)
|
||||
do co = 1, size(ID,1)
|
||||
do ce = 1, size(ID,2)
|
||||
|
|
@ -563,80 +563,80 @@ subroutine results_mapping_phase(ID,entry,label)
|
|||
!---------------------------------------------------------------------------------------------------
|
||||
! compound type: label(ID) + entry
|
||||
call H5Tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tget_size_f(dt_id, type_size_string, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
|
||||
call H5Tget_size_f(pI64_t, type_size_int, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create memory types for each component of the compound type
|
||||
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tcreate_f(H5T_COMPOUND_F, type_size_int, entry_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(entry_id, 'entry', 0_SIZE_T, pI64_t, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tclose_f(dt_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataspace in memory (local shape = hyperslab) and in file (global shape)
|
||||
call H5Screate_simple_f(2,myShape,memspace_id,hdferr,myShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Screate_simple_f(2,totalShape,filespace_id,hdferr,totalShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! write the components of the compound type individually
|
||||
call H5Pset_preserve_f(plist_id, .true., hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
loc_id = results_openGroup('/cell_to')
|
||||
call H5Dcreate_f(loc_id, 'phase', dtype_id, filespace_id, dset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Dwrite_f(dset_id, label_id, reshape(label(pack(ID,.true.)),myShape), &
|
||||
myShape, hdferr, 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'
|
||||
call H5Dwrite_f(dset_id, entry_id, reshape(pack(entryGlobal,.true.),myShape), &
|
||||
myShape, hdferr, 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'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! close all
|
||||
call HDF5_closeGroup(loc_id)
|
||||
call H5Pclose_f(plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(filespace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(memspace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Dclose_f(dset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(dtype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(label_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(entry_id, hdferr)
|
||||
|
||||
call executionStamp('cell_to/phase','cell ID and constituent ID to phase results')
|
||||
|
|
@ -683,7 +683,7 @@ subroutine results_mapping_homogenization(ID,entry,label)
|
|||
writeSize(worldrank) = size(entry) ! total number of entries of this process
|
||||
|
||||
call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
#ifndef PETSC
|
||||
entryGlobal = int(entry -1,pI64) ! 0-based
|
||||
|
|
@ -691,17 +691,17 @@ subroutine results_mapping_homogenization(ID,entry,label)
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! MPI settings and communication
|
||||
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'
|
||||
|
||||
call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
|
||||
entryOffset = 0_pI64
|
||||
do ce = 1, size(ID,1)
|
||||
entryOffset(ID(ce),worldrank) = entryOffset(ID(ce),worldrank) +1_pI64
|
||||
end do
|
||||
call MPI_Allreduce(MPI_IN_PLACE,entryOffset,size(entryOffset),MPI_INTEGER8,MPI_SUM,MPI_COMM_WORLD,err_MPI)! get offset at each process
|
||||
if(err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
|
||||
entryOffset(:,worldrank) = sum(entryOffset(:,0:worldrank-1),2)
|
||||
do ce = 1, size(ID,1)
|
||||
entryGlobal(ce) = int(entry(ce),pI64) -1_pI64 + entryOffset(ID(ce),worldrank)
|
||||
|
|
@ -715,82 +715,82 @@ subroutine results_mapping_homogenization(ID,entry,label)
|
|||
!---------------------------------------------------------------------------------------------------
|
||||
! compound type: label(ID) + entry
|
||||
call H5Tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tget_size_f(dt_id, type_size_string, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
|
||||
call H5Tget_size_f(pI64_t, type_size_int, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create memory types for each component of the compound type
|
||||
call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tcreate_f(H5T_COMPOUND_F, type_size_int, entry_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tinsert_f(entry_id, 'entry', 0_SIZE_T, pI64_t, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Tclose_f(dt_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataspace in memory (local shape = hyperslab) and in file (global shape)
|
||||
call H5Screate_simple_f(1,myShape,memspace_id,hdferr,myShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Screate_simple_f(1,totalShape,filespace_id,hdferr,totalShape)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! write the components of the compound type individually
|
||||
call H5Pset_preserve_f(plist_id, .true., hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
loc_id = results_openGroup('/cell_to')
|
||||
call H5Dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call H5Dwrite_f(dset_id, label_id, reshape(label(pack(ID,.true.)),myShape), &
|
||||
myShape, hdferr, 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'
|
||||
call H5Dwrite_f(dset_id, entry_id, reshape(pack(entryGlobal,.true.),myShape), &
|
||||
myShape, hdferr, 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'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! close all
|
||||
call HDF5_closeGroup(loc_id)
|
||||
call H5Pclose_f(plist_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(filespace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Sclose_f(memspace_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Dclose_f(dset_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(dtype_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(label_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
call H5Tclose_f(entry_id, hdferr)
|
||||
if(hdferr < 0) error stop 'HDF5 error'
|
||||
if (hdferr < 0) error stop 'HDF5 error'
|
||||
|
||||
call executionStamp('cell_to/homogenization','cell ID to homogenization results')
|
||||
|
||||
|
|
|
|||
|
|
@ -212,10 +212,10 @@ subroutine fromAxisAngle(self,ax,degrees,P)
|
|||
axis = ax(1:3)
|
||||
else
|
||||
axis = ax(1:3) * merge(-1.0_pReal,1.0_pReal,P == 1)
|
||||
if(abs(P) /= 1) call IO_error(402,ext_msg='fromAxisAngle (P)')
|
||||
if (abs(P) /= 1) call IO_error(402,ext_msg='fromAxisAngle (P)')
|
||||
end if
|
||||
|
||||
if(dNeq(norm2(axis),1.0_pReal) .or. angle < 0.0_pReal .or. angle > PI) &
|
||||
if (dNeq(norm2(axis),1.0_pReal) .or. angle < 0.0_pReal .or. angle > PI) &
|
||||
call IO_error(402,ext_msg='fromAxisAngle')
|
||||
|
||||
self%q = ax2qu([axis,angle])
|
||||
|
|
@ -513,11 +513,11 @@ pure function om2qu(om) result(qu)
|
|||
trace = math_trace33(om)
|
||||
|
||||
|
||||
if(trace > 0.0_pReal) then
|
||||
if (trace > 0.0_pReal) then
|
||||
s = 0.5_pReal / sqrt(trace+1.0_pReal)
|
||||
qu = [0.25_pReal/s, (om(3,2)-om(2,3))*s,(om(1,3)-om(3,1))*s,(om(2,1)-om(1,2))*s]
|
||||
else
|
||||
if( om(1,1) > om(2,2) .and. om(1,1) > om(3,3) ) then
|
||||
if ( om(1,1) > om(2,2) .and. om(1,1) > om(3,3) ) then
|
||||
s = 2.0_pReal * sqrt( 1.0_pReal + om(1,1) - om(2,2) - om(3,3))
|
||||
qu = [ (om(3,2) - om(2,3)) /s,0.25_pReal * s,(om(1,2) + om(2,1)) / s,(om(1,3) + om(3,1)) / s]
|
||||
elseif (om(2,2) > om(3,3)) then
|
||||
|
|
@ -528,7 +528,7 @@ pure function om2qu(om) result(qu)
|
|||
qu = [ (om(2,1) - om(1,2)) /s,(om(1,3) + om(3,1)) / s,(om(2,3) + om(3,2)) / s,0.25_pReal * s]
|
||||
end if
|
||||
end if
|
||||
if(sign(1.0_pReal,qu(1))<0.0_pReal) qu =-1.0_pReal * qu
|
||||
if (sign(1.0_pReal,qu(1))<0.0_pReal) qu =-1.0_pReal * qu
|
||||
qu(2:4) = merge(qu(2:4),qu(2:4)*P,dEq0(qu(2:4)))
|
||||
qu = qu/norm2(qu)
|
||||
|
||||
|
|
@ -619,7 +619,7 @@ pure function eu2qu(eu) result(qu)
|
|||
-P*sPhi*cos(ee(1)-ee(3)), &
|
||||
-P*sPhi*sin(ee(1)-ee(3)), &
|
||||
-P*cPhi*sin(ee(1)+ee(3))]
|
||||
if(sign(1.0_pReal,qu(1)) < 0.0_pReal) qu = qu * (-1.0_pReal)
|
||||
if (sign(1.0_pReal,qu(1)) < 0.0_pReal) qu = qu * (-1.0_pReal)
|
||||
|
||||
end function eu2qu
|
||||
|
||||
|
|
@ -807,15 +807,15 @@ subroutine selfTest()
|
|||
|
||||
do i = 1, 20
|
||||
|
||||
if(i==1) then
|
||||
if (i==1) then
|
||||
qu = [1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal]
|
||||
elseif(i==2) then
|
||||
elseif (i==2) then
|
||||
qu = [1.0_pReal,-0.0_pReal,-0.0_pReal,-0.0_pReal]
|
||||
elseif(i==3) then
|
||||
elseif (i==3) then
|
||||
qu = [0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal]
|
||||
elseif(i==4) then
|
||||
elseif (i==4) then
|
||||
qu = [0.0_pReal,0.0_pReal,1.0_pReal,0.0_pReal]
|
||||
elseif(i==5) then
|
||||
elseif (i==5) then
|
||||
qu = [0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal]
|
||||
else
|
||||
call random_number(x)
|
||||
|
|
@ -825,20 +825,20 @@ subroutine selfTest()
|
|||
sin(TAU*x(2))*B,&
|
||||
cos(TAU*x(2))*B,&
|
||||
sin(TAU*x(1))*A]
|
||||
if(qu(1)<0.0_pReal) qu = qu * (-1.0_pReal)
|
||||
if (qu(1)<0.0_pReal) qu = qu * (-1.0_pReal)
|
||||
end if
|
||||
|
||||
|
||||
if(.not. quaternion_equal(om2qu(qu2om(qu)),qu)) error stop 'om2qu2om'
|
||||
if(.not. quaternion_equal(eu2qu(qu2eu(qu)),qu)) error stop 'eu2qu2eu'
|
||||
if(.not. quaternion_equal(ax2qu(qu2ax(qu)),qu)) error stop 'ax2qu2ax'
|
||||
if (.not. quaternion_equal(om2qu(qu2om(qu)),qu)) error stop 'om2qu2om'
|
||||
if (.not. quaternion_equal(eu2qu(qu2eu(qu)),qu)) error stop 'eu2qu2eu'
|
||||
if (.not. quaternion_equal(ax2qu(qu2ax(qu)),qu)) error stop 'ax2qu2ax'
|
||||
|
||||
om = qu2om(qu)
|
||||
if(.not. quaternion_equal(om2qu(eu2om(om2eu(om))),qu)) error stop 'eu2om2eu'
|
||||
if(.not. quaternion_equal(om2qu(ax2om(om2ax(om))),qu)) error stop 'ax2om2ax'
|
||||
if (.not. quaternion_equal(om2qu(eu2om(om2eu(om))),qu)) error stop 'eu2om2eu'
|
||||
if (.not. quaternion_equal(om2qu(ax2om(om2ax(om))),qu)) error stop 'ax2om2ax'
|
||||
|
||||
eu = qu2eu(qu)
|
||||
if(.not. quaternion_equal(eu2qu(ax2eu(eu2ax(eu))),qu)) error stop 'ax2eu2ax'
|
||||
if (.not. quaternion_equal(eu2qu(ax2eu(eu2ax(eu))),qu)) error stop 'ax2eu2ax'
|
||||
|
||||
call R%fromMatrix(om)
|
||||
|
||||
|
|
@ -872,7 +872,7 @@ subroutine selfTest()
|
|||
logical :: ok
|
||||
|
||||
ok = all(dEq(qu1,qu2,1.0e-7_pReal))
|
||||
if(dEq0(qu1(1),1.0e-12_pReal)) &
|
||||
if (dEq0(qu1(1),1.0e-12_pReal)) &
|
||||
ok = ok .or. all(dEq(-1.0_pReal*qu1,qu2,1.0e-7_pReal))
|
||||
|
||||
end function quaternion_equal
|
||||
|
|
|
|||
|
|
@ -119,7 +119,7 @@ function getCWD()
|
|||
|
||||
call getCWD_C(getCWD_Cstring,stat)
|
||||
|
||||
if(stat == 0) then
|
||||
if (stat == 0) then
|
||||
getCWD = c_f_string(getCWD_Cstring)
|
||||
else
|
||||
error stop 'invalid working directory'
|
||||
|
|
@ -141,7 +141,7 @@ function getHostName()
|
|||
|
||||
call getHostName_C(getHostName_Cstring,stat)
|
||||
|
||||
if(stat == 0) then
|
||||
if (stat == 0) then
|
||||
getHostName = c_f_string(getHostName_Cstring)
|
||||
else
|
||||
getHostName = 'n/a (Error!)'
|
||||
|
|
@ -163,7 +163,7 @@ function getUserName()
|
|||
|
||||
call getUserName_C(getUserName_Cstring,stat)
|
||||
|
||||
if(stat == 0) then
|
||||
if (stat == 0) then
|
||||
getUserName = c_f_string(getUserName_Cstring)
|
||||
else
|
||||
getUserName = 'n/a (Error!)'
|
||||
|
|
|
|||
Loading…
Reference in New Issue