A routine to load global informations from the header file in the given directory.
Read the header only on the root process, broadcast to all others
Broadcast the header informations to all processes.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(tem_global_type), | intent(out) | :: | me |
Structure to store header in |
||
| character(len=*), | intent(in) | :: | dirname |
Directory containing the mesh informations |
||
| integer, | intent(in) | :: | myPart |
The process local part (= MPI Rank in comm) |
||
| integer, | intent(in) | :: | nParts |
Number of partitions, the mesh is partitioned into (= Number of MPI processes in comm). |
||
| integer, | intent(in) | :: | comm |
MPI Communicator to use |
subroutine load_tem_global( me, dirname, myPart, nParts, comm ) ! -------------------------------------------------------------------- ! !> Structure to store header in type(tem_global_type), intent(out) :: me !> Directory containing the mesh informations character(len=*), intent(in) :: dirname !> The process local part (= MPI Rank in comm) integer, intent(in) :: myPart !> Number of partitions, the mesh is partitioned into (= Number of MPI !! processes in comm). integer, intent(in) :: nParts !> MPI Communicator to use integer, intent(in) :: comm ! -------------------------------------------------------------------- ! character(len=300) :: headname integer :: iError integer :: root integer :: i logical :: ex integer :: thandle, sub_handle type( flu_State ) :: conf ! lua flu state to read lua file ! -------------------------------------------------------------------- ! root = 0 me%comm = comm me%myPart = myPart me%nParts = nParts me%dirname = trim(adjustl(dirname)) headname = trim(me%dirname)//'header.lua' write(logUnit(1), *) 'Load mesh header from file: '//trim(headname) if (myPart == root) then inquire(file=trim(headname), exist=ex) if (.not. ex) then write(*,*) 'File ',trim(headname),' not found. Aborting.' stop endif !! Read the header only on the root process, broadcast to all others ! open mesh header file call open_config_file(L = conf, filename = trim(headname)) ! load label call aot_get_val( L = conf, & & key = 'label', & & val = me%label, & & ErrCode = iError ) call aot_get_val( L = conf, & & key = 'comment', & & val = me%comment, & & ErrCode = iError ) ! Open boundingbox table call aot_table_open( L = conf, thandle = thandle, key='boundingbox' ) ! Read the origin call aot_table_open( L = conf, & & parent = thandle, & & thandle = sub_handle, & & key = 'origin' ) do i = 1,3 call aot_get_val( L = conf, & & thandle = sub_handle, & & pos = i, & & val = me%origin(i), & & ErrCode = iError ) end do call aot_table_close( L = conf, thandle = sub_handle ) ! Read the bounding cube length call aot_get_val( L = conf, & & thandle = thandle, & & key = 'length', & & val = me%BoundingCubeLength, & & ErrCode = iError ) ! Close boundingbox table again call aot_table_close( L = conf, thandle = thandle ) call aot_get_val( L = conf, & & key = 'nElems', & & val = me%nElems, & & ErrCode = iError ) call aot_get_val( L = conf, & & key = 'minLevel', & & val = me%minLevel, & & ErrCode = iError ) call aot_get_val( L = conf, & & key = 'maxLevel', & & val = me%maxLevel, & & ErrCode = iError ) call aot_get_val( L = conf, & & key = 'nProperties', & & val = me%nProperties, & & ErrCode = iError ) ! Read the effective bounding cube parameters ! Open the effective bounding box table call aot_table_open( L = conf, thandle = thandle, key='effBoundingbox' ) ! Read the origin call aot_table_open( L = conf, & & parent = thandle, & & thandle = sub_handle, & & key = 'origin' ) do i = 1,3 call aot_get_val( L = conf, & & thandle = sub_handle, & & pos = i, & & val = me%effboundingcube(i,1), & & ErrCode = iError ) end do call aot_table_close( L = conf, thandle = sub_handle ) me%effOrigin = me%effboundingcube(:,1) ! Read the effective length (min and max) call aot_table_open( L = conf, & & parent = thandle, & & thandle = sub_handle, & & key = 'effLength' ) do i = 1,3 call aot_get_val( L = conf, & & thandle = sub_handle, & & pos = i, & & val = me%effLength(i), & & ErrCode = iError ) me%effboundingcube(i,2) = me%effboundingcube(i,1) + me%effLength(i) end do call aot_table_close( L = conf, thandle = sub_handle ) end if write(logUnit(1),*) 'The real bounding cube is...' write(logUnit(1),*) ' min: ',me%effBoundingCube(:,1) write(logUnit(1),*) ' max: ',me%effBoundingCube(:,2) !! Broadcast the header informations to all processes. call MPI_Bcast(me%nElems, 1, long_k_mpi, root, me%comm, iError) call MPI_Bcast(me%label, LabelLen, MPI_CHARACTER, root, me%comm, iError) call MPI_Bcast(me%comment, LabelLen, MPI_CHARACTER, root, me%comm, iError) call MPI_Bcast(me%BoundingCubeLength, 1, rk_mpi, root, me%comm, iError) call MPI_Bcast(me%Origin, 3, rk_mpi, root, me%comm, iError) call MPI_Bcast(me%minLevel, 1, MPI_INTEGER, root, me%comm, iError) call MPI_Bcast(me%maxLevel, 1, MPI_INTEGER, root, me%comm, iError) call MPI_Bcast(me%nProperties, 1, MPI_INTEGER, root, me%comm, iError) call MPI_Bcast(me%effBoundingCube, 6, rk_mpi, root, me%comm, iError) if (associated(me%Property)) deallocate(me%property) allocate(me%Property(me%nProperties)) call load_tem_prophead( me = me%Property, & & myPart = myPart, & & comm = me%comm, & & conf = conf, & & root = root ) if (myPart == root) then call close_config(conf) end if end subroutine load_tem_global