From aaae8a701b394cf920c5cf2dd0aba65f1051a2f3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 7 Dec 2022 17:29:03 +0000 Subject: [PATCH] Fortran style adjustments --- src/CLI.f90 | 4 +- src/HDF5_utilities.f90 | 262 ++++++++-------- src/Marc/DAMASK_Marc.f90 | 8 +- src/Marc/discretization_Marc.f90 | 66 ++-- src/Marc/materialpoint_Marc.f90 | 38 +-- src/YAML_parse.f90 | 288 +++++++++--------- src/discretization.f90 | 2 +- src/geometry_plastic_nonlocal.f90 | 8 +- src/grid/base64.f90 | 74 ++--- src/grid/grid_mech_FEM.f90 | 16 +- src/homogenization.f90 | 10 +- src/homogenization_damage.f90 | 2 +- src/materialpoint.f90 | 62 ++-- src/mesh/FEM_utilities.f90 | 4 +- src/parallelization.f90 | 4 +- src/phase_mechanical.f90 | 18 +- ...phase_mechanical_eigen_cleavageopening.f90 | 2 +- src/phase_mechanical_plastic_isotropic.f90 | 4 +- ...phase_mechanical_plastic_kinehardening.f90 | 8 +- src/phase_mechanical_plastic_nonlocal.f90 | 8 +- ...phase_mechanical_plastic_phenopowerlaw.f90 | 8 +- src/phase_thermal_dissipation.f90 | 2 +- src/phase_thermal_externalheat.f90 | 2 +- src/polynomials.f90 | 10 +- src/results.f90 | 124 ++++---- src/rotations.f90 | 38 +-- src/system_routines.f90 | 6 +- 27 files changed, 539 insertions(+), 539 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index 4fef460ff..ce7e4ca1b 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -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) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 4829d0729..a87046c5a 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -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 diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 9f6071efe..33d1268ef 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -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 diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index 0492ef468..405339b9b 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -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 diff --git a/src/Marc/materialpoint_Marc.f90 b/src/Marc/materialpoint_Marc.f90 index 5e1591bbd..dc878f507 100644 --- a/src/Marc/materialpoint_Marc.f90 +++ b/src/Marc/materialpoint_Marc.f90 @@ -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) diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index 2d9cc3620..04ff4d5cc 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -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 diff --git a/src/discretization.f90 b/src/discretization.f90 index f24b0eadf..2c605b422 100644 --- a/src/discretization.f90 +++ b/src/discretization.f90 @@ -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) diff --git a/src/geometry_plastic_nonlocal.f90 b/src/geometry_plastic_nonlocal.f90 index 09c40f8b3..f0da5539b 100644 --- a/src/geometry_plastic_nonlocal.f90 +++ b/src/geometry_plastic_nonlocal.f90 @@ -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 diff --git a/src/grid/base64.f90 b/src/grid/base64.f90 index a81078725..40986d783 100644 --- a/src/grid/base64.f90 +++ b/src/grid/base64.f90 @@ -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 diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index bbfd2802f..537afffb0 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -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 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6e6034567..3474e497b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -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)) diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 885ff9090..f2b585a72 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -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) diff --git a/src/materialpoint.f90 b/src/materialpoint.f90 index 2f22444b2..a0f266afa 100644 --- a/src/materialpoint.f90 +++ b/src/materialpoint.f90 @@ -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 diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index b763dd84a..1ec2f3fcd 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -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 & diff --git a/src/parallelization.f90 b/src/parallelization.f90 index 2934cf65c..04a852a15 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -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 diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index e062bd5c0..07aee02eb 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -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) diff --git a/src/phase_mechanical_eigen_cleavageopening.f90 b/src/phase_mechanical_eigen_cleavageopening.f90 index 1bf231c2c..780ed22b2 100644 --- a/src/phase_mechanical_eigen_cleavageopening.f90 +++ b/src/phase_mechanical_eigen_cleavageopening.f90 @@ -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) diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index e755c5bba..c897c6c6d 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -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)) diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 47b6a777a..692501f42 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -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 diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 8e187c08e..77d73aae7 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -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) diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 0fcdbea6a..04ddbe13c 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -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 diff --git a/src/phase_thermal_dissipation.f90 b/src/phase_thermal_dissipation.f90 index a08d396ec..5cd2d4d90 100644 --- a/src/phase_thermal_dissipation.f90 +++ b/src/phase_thermal_dissipation.f90 @@ -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) diff --git a/src/phase_thermal_externalheat.f90 b/src/phase_thermal_externalheat.f90 index 2d7f541ab..9a58595ae 100644 --- a/src/phase_thermal_externalheat.f90 +++ b/src/phase_thermal_externalheat.f90 @@ -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) diff --git a/src/polynomials.f90 b/src/polynomials.f90 index 38e31eb55..2240616f7 100644 --- a/src/polynomials.f90 +++ b/src/polynomials.f90 @@ -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) diff --git a/src/results.f90 b/src/results.f90 index 17efc87e3..8cdc82c28 100644 --- a/src/results.f90 +++ b/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') diff --git a/src/rotations.f90 b/src/rotations.f90 index 5c8677c81..657480ef4 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -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 diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 3ce6ba6ce..74aa4685b 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -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!)'