SSsrcLink_init_part2 Subroutine

public subroutine SSsrcLink_init_part2(me, krn, cfg)

Arguments

Type IntentOptional Attributes Name
type(SSsrcLink_t), intent(inout) :: me
type(krn_t), intent(inout), target :: krn
class(input_t), intent(in), pointer :: cfg

Calls

proc~~sssrclink_init_part2~~CallsGraph proc~sssrclink_init_part2 SSsrcLink_init_part2 interface~to_ptr_arr to_ptr_arr proc~sssrclink_init_part2->interface~to_ptr_arr proc~input_dbl1d input_t%input_dbl1d proc~sssrclink_init_part2->proc~input_dbl1d proc~input_dict1d input_t%input_dict1d proc~sssrclink_init_part2->proc~input_dict1d proc~input_has_key input_t%input_has_key proc~sssrclink_init_part2->proc~input_has_key proc~input_int1d input_t%input_int1d proc~sssrclink_init_part2->proc~input_int1d proc~input_str input_t%input_str proc~sssrclink_init_part2->proc~input_str proc~input_str1d input_t%input_str1d proc~sssrclink_init_part2->proc~input_str1d proc~krn_coo_add_link krn_t%krn_coo_add_link proc~sssrclink_init_part2->proc~krn_coo_add_link proc~material_init material_init proc~sssrclink_init_part2->proc~material_init proc~port_list_find port_list_t%port_list_find proc~sssrclink_init_part2->proc~port_list_find proc~to_ptr_arr0d to_ptr_arr0d interface~to_ptr_arr->proc~to_ptr_arr0d proc~to_ptr_arr1d to_ptr_arr1d interface~to_ptr_arr->proc~to_ptr_arr1d proc~to_ptr_arr2d to_ptr_arr2d interface~to_ptr_arr->proc~to_ptr_arr2d proc~input_dbl1d->proc~input_has_key interface~to_str to_str proc~input_dbl1d->interface~to_str proc~continue_if continue_if proc~input_dbl1d->proc~continue_if proc~get1d_hdf5 get1d_hdf5 proc~input_dbl1d->proc~get1d_hdf5 proc~input_node input_t%input_node proc~input_dbl1d->proc~input_node proc~select_scalar select_scalar proc~input_dbl1d->proc~select_scalar to_real to_real proc~input_dbl1d->to_real proc~input_dict1d->proc~input_has_key get_string get_string proc~input_dict1d->get_string proc~input_dict1d->proc~input_node proc~select_dict select_dict proc~input_dict1d->proc~select_dict proc~select_list select_list proc~input_dict1d->proc~select_list get get proc~input_has_key->get proc~input_has_key->proc~select_dict proc~input_int1d->proc~input_has_key proc~input_int1d->interface~to_str proc~input_int1d->proc~continue_if proc~get1d_range get1d_range proc~input_int1d->proc~get1d_range proc~input_int1d->proc~input_node proc~input_int1d->proc~select_scalar to_integer to_integer proc~input_int1d->to_integer proc~input_str->proc~input_has_key proc~input_str->proc~input_node proc~input_str->proc~select_scalar proc~input_str1d->proc~input_has_key proc~input_str1d->proc~input_node proc~input_str1d->proc~select_scalar proc~material_init->proc~input_str proc~port_list_find->interface~to_str proc~to_int to_int proc~port_list_find->proc~to_int proc~str_from_int str_from_int interface~to_str->proc~str_from_int proc~str_from_real str_from_real interface~to_str->proc~str_from_real proc~get1d_hdf5->proc~input_has_key proc~get1d_hdf5->proc~input_str h5dclose_f h5dclose_f proc~get1d_hdf5->h5dclose_f h5dopen_f h5dopen_f proc~get1d_hdf5->h5dopen_f h5dread_f h5dread_f proc~get1d_hdf5->h5dread_f h5fclose_f h5fclose_f proc~get1d_hdf5->h5fclose_f h5fopen_f h5fopen_f proc~get1d_hdf5->h5fopen_f h5ltget_dataset_info_f h5ltget_dataset_info_f proc~get1d_hdf5->h5ltget_dataset_info_f proc~get1d_range->proc~input_has_key proc~input_node->get proc~input_node->proc~select_dict proc~dictionary_traverse dictionary_traverse proc~input_node->proc~dictionary_traverse proc~dictionary_traverse->proc~dictionary_traverse get_dictionary get_dictionary proc~dictionary_traverse->get_dictionary proc~abort_if abort_if proc~dictionary_traverse->proc~abort_if

Called by

proc~~sssrclink_init_part2~~CalledByGraph proc~sssrclink_init_part2 SSsrcLink_init_part2 program~reims_p reims_p program~reims_p->proc~sssrclink_init_part2

Source Code

subroutine SSsrcLink_init_part2(me,krn,cfg)
    type(SSsrcLink_t), intent(inout) :: me
    type(krn_t), target, intent(inout) :: krn
    class(input_t), pointer, intent(in)    :: cfg

    type(input_t), allocatable :: links(:)
    real(dp), allocatable :: distances1(:), distances2(:), surfaces(:), thicks(:)
    integer, allocatable :: nodes1(:), nodes2(:)
    type(str_ptr), allocatable :: labels(:)
    integer :: i,offset1,offset2,j

    ! TODO : Check that chunck is always index 1, mesh2D/solid index 2
    
    links = cfg%dict1d('link')

    nodes1=links(1)%int1d('node')
    offset1 = krn%SS_src_list%find(links(1)%str('id'), 1) - 1
    distances1=links(1)%dbl1d('distance', n=me%sizeNodes)

    call material_init(me%mat_ins,cfg)
    
    if(links(2)%has_key('node')) then 
      allocate(me%lk(2,me%sizeNodes),me%SurfCont(me%sizeNodes),me%Lins(me%sizeNodes))
      allocate(me%DerSrcS1dT2(me%sizeNodes),me%DerSrcS2dT1(me%sizeNodes))
      allocate(me%Lk12(me%sizeNodes),me%Lk21(me%sizeNodes))
      nodes2=links(2)%int1d('node')
      offset2 = krn%SS_src_list%find(links(2)%str('id'), 1) - 1
      distances2=links(2)%dbl1d('distance', n=me%sizeNodes)
      surfaces=cfg%dbl1d('contact_surface', n=me%sizeNodes)
      thicks=cfg%dbl1d('thickness', n=me%sizeNodes)
      do i = 1, me%sizeNodes
          me%lk(1,i)%p => krn%SS_src_ports(offset1 + nodes1(i))
          me%lk(1,i)%p%Dist4Grad = distances1(i)
          me%lk(2,i)%p => krn%SS_src_ports(offset2 + nodes2(i))    
          me%lk(2,i)%p%Dist4Grad = distances2(i)
          me%SurfCont(i)=surfaces(i)
          me%Lins(i)=thicks(i)
      enddo

      do i = 1, me%sizeNodes
        call krn%coo_add_link(me%lk(1,i)%p, me%lk(2,i)%p, [1], [1], to_ptr_arr(me%Lk12(i)))
        call krn%coo_add_link(me%lk(2,i)%p, me%lk(1,i)%p, [1], [1], to_ptr_arr(me%Lk21(i)))    
      enddo

    else if(links(2)%has_key('label')) then 
      ! Concept is one flag per chunk.
      ! In old version, one chunk could be associated to 2 flags (contacts _H and _V) --> requires here accumulation
      allocate(me%lk(maxval(me%nb_2D_Ports(:))+1,me%sizeNodes))
      allocate(me%Lins(me%sizeNodes),me%LkArr(maxval(me%nb_2D_Ports(:))+1,maxval(me%nb_2D_Ports(:))+1,me%sizeNodes))
      allocate(me%Der4LkArr(maxval(me%nb_2D_Ports(:))+1,maxval(me%nb_2D_Ports(:))+1,me%sizeNodes))
      labels=links(2)%str1d('label')
      thicks=cfg%dbl1d('thickness', n=me%sizeNodes)
      do i = 1, me%sizeNodes
        me%lk(1,i)%p => krn%SS_src_ports(offset1 + nodes1(i))
        me%lk(1,i)%p%Dist4Grad = distances1(i)
        do j=1,me%nb_2D_Ports(i)
          me%lk(1+j,i)%p => krn%SS_src_ports(krn%SS_src_list%find(links(2)%str('id')//"+"//trim(labels(i)%p),j))
        enddo
        me%Lins(i)=thicks(i)
      enddo

      do i = 1, me%sizeNodes      
        do j=1,me%nb_2D_Ports(i)        
          call krn%coo_add_link(me%lk(1,i)%p, me%lk(1+j,i)%p, [1], [1], to_ptr_arr(me%LkArr(1,1+j,i)))
          call krn%coo_add_link(me%lk(1+j,i)%p, me%lk(1,i)%p, [1], [1], to_ptr_arr(me%LkArr(1+j,1,i)))    
        enddo
      enddo

    endif

end subroutine SSsrcLink_init_part2