rings_ogl.F90

Go to the documentation of this file.

! This file is part of the 'atomes' software.
!
! 'atomes' is free software: you can redistribute it and/or modify it under the terms
! of the GNU Affero General Public License as published by the Free Software Foundation,
! either version 3 of the License, or (at your option) any later version.
!
! 'atomes' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
! See the GNU General Public License for more details.
!
! You should have received a copy of the GNU Affero General Public License along with 'atomes'.
! If not, see <https://www.gnu.org/licenses/>
!
! Copyright (C) 2022-2024 by CNRS and University of Strasbourg
!
 
INTEGER FUNCTION rings_to_ogl (STEP, IDSEARCH, NRI, RSAVED, OSAVED)
 
USE parameters
 
INTEGER, INTENT(IN) :: step, idsearch
INTEGER, DIMENSION(TAILLR, NS), INTENT(IN) :: nri
INTEGER, DIMENSION(TAILLR,NUMA,TAILLR), INTENT(IN) :: rsaved, osaved
INTEGER, DIMENSION(NUMA) :: ring_list
INTEGER, DIMENSION(:), ALLOCATABLE :: ring_id
INTEGER :: raa, rab, rac, rad, rae
 
rab=0
do raa=3, taillr
  if (nri(raa,step) > 0) then
    rab=rab+1
    call allocate_all_rings (idsearch, step-1, raa, nri(raa,step))
  endif
enddo
 
do raa=1, na
  do rab=3, taillr
    rac = 0
    do rad=1, numa
      ring_list(rad) = 0
    enddo
    do rad=1, nri(rab,step)
      do rae=1, rab
        if (rsaved(rab,rad,rae) .eq. raa) then
          rac=rac+1
          ring_list(rac) = rad
          goto 001
        endif
      enddo
      001 continue
    enddo
    if (allocated(ring_id)) deallocate(ring_id)
    allocate(ring_id(rac), stat=err)
    if (err .ne. 0) then
      call show_error ("Impossible to allocate memory"//char(0), &
                       "Function: RINGS_TO_OGL"//char(0), "Table: RING_ID (1)"//char(0))
      rings_to_ogl = 0
      goto 002
    endif
    do rad=1, rac
      ring_id(rad) = ring_list(rad)
    enddo
    !write (6, '("Sending atom/rings data:: step= ",i1,", at= ",i4," ring= ",i2,", size= ",i2,", num= ",i4)') STEP-1, RAA-1, IDSEARCH, RAB, RAC
    if (rac > 0) call send_atom_rings_id_opengl (step-1, raa-1, idsearch, rab-1, rac, ring_id)
  enddo
enddo
 
do raa=3, taillr
  if (allocated(ring_id)) deallocate(ring_id)
  allocate(ring_id(raa), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: RINGS_TO_OGL"//char(0), "Table: RING_ID (2)"//char(0))
    rings_to_ogl = 0
    goto 002
  endif
  do rab=1, nri(raa,step)
    do rac=1, raa
      ring_id(rac) = osaved(raa,rab,rac)
    enddo
    call send_rings_opengl (idsearch, step-1, raa-1, rab-1, ring_id)
  enddo
enddo
 
rings_to_ogl = 1
 
if (allocated(ring_id)) deallocate(ring_id)
 
002 continue
 
END FUNCTION
 
INTEGER FUNCTION rings_to_ogl_bis (STEP, IDSEARCH, NRI, RSAVED, OSAVED)
 
USE parameters
 
INTEGER, INTENT(IN) :: step, idsearch
INTEGER, DIMENSION(TAILLR), INTENT(IN) :: nri
INTEGER, DIMENSION(TAILLR,NUMA,TAILLR), INTENT(IN) :: rsaved, osaved
INTEGER, DIMENSION(NUMA) :: ring_list
INTEGER, DIMENSION(:), ALLOCATABLE :: ring_id
INTEGER :: raa, rab, rac, rad, rae
 
do raa=3, taillr
  if (nri(raa) > 0) call allocate_all_rings (idsearch, step-1, raa, nri(raa))
enddo
 
do raa=1, na
  do rab=3, taillr
    rac = 0
    do rad=1, numa
      ring_list(rad) = 0
    enddo
    do rad=1, nri(rab)
      do rae=1, rab
        if (rsaved(rab,rad,rae) .eq. raa) then
          rac=rac+1
          ring_list(rac) = rad
          goto 001
        endif
      enddo
      001 continue
    enddo
    if (allocated(ring_id)) deallocate(ring_id)
    allocate(ring_id(rac), stat=err)
    if (err .ne. 0) then
      call show_error ("Impossible to allocate memory"//char(0), &
                       "Function: RINGS_TO_OGL_BIS"//char(0), "Table: RING_ID (1)"//char(0))
      rings_to_ogl_bis = 0
      goto 002
    endif
    do rad=1, rac
      ring_id(rad) = ring_list(rad)
    enddo
    !write (6, '("Sending atom/rings data:: step= ",i1,", at= ",i4," ring= ",i2,", size= ",i2,", num= ",i4)') STEP-1, RAA-1, IDSEARCH, RAB, RAC
    if (rac > 0) call send_atom_rings_id_opengl (step-1, raa-1, idsearch, rab, rac, ring_id)
  enddo
enddo
 
do raa=3, taillr
  if (allocated(ring_id)) deallocate(ring_id)
  allocate(ring_id(raa), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: RINGS_TO_OGL_BIS"//char(0), "Table: RING_ID (2)"//char(0))
    rings_to_ogl_bis = 0
    goto 002
  endif
  do rab=1, nri(raa)
    do rac=1, raa
      ring_id(rac) = osaved(raa,rab,rac)
    enddo
    call send_rings_opengl (idsearch, step-1, raa, rab-1, ring_id)
  enddo
enddo
 
rings_to_ogl_bis = 1
 
if (allocated(ring_id)) deallocate(ring_id)
 
002 continue
 
END FUNCTION
 
INTEGER FUNCTION rings_to_ogl_menu (IDSEARCH, NRI)
 
USE parameters
 
INTEGER, INTENT(IN) :: idsearch
INTEGER, DIMENSION(TAILLR, NS), INTENT(IN) :: nri
INTEGER, DIMENSION(:), ALLOCATABLE :: ring_id, ring_jd
 
if (allocated(ring_id)) deallocate(ring_id)
allocate(ring_id(taillr), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: RINGS_TO_OGL_MENU"//char(0), "Table: RING_ID "//char(0))
  rings_to_ogl_menu = 0
  goto 001
endif
 
k = 0
do i=1, taillr
  ring_id(i) = 0
  do j=1, ns
    ring_id(i) = ring_id(i) + nri(i,j)
  enddo
  if (ring_id(i) > 0) then
    k = k + 1
  endif
enddo
 
if (allocated(ring_jd)) deallocate(ring_jd)
allocate(ring_jd(k), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: RINGS_TO_OGL_MENU"//char(0), "Table: RING_JD "//char(0))
  rings_to_ogl_menu = 0
  goto 001
endif
 
k = 0
do i=1, taillr
  if (ring_id(i) > 0) then
    k = k + 1
    ring_jd(k) = i
  endif
enddo
 
call send_coord_opengl (4+idsearch, 1, 0, 0, k, k)
call init_menurings (4+idsearch, idsearch, k, ring_jd, 1)
 
if (allocated(ring_id)) deallocate(ring_id)
if (allocated(ring_jd)) deallocate(ring_jd)
 
rings_to_ogl_menu = 1
 
001 continue
 
END FUNCTION
 
INTEGER FUNCTION rings_to_ogl_m (IDSEARCH)
 
USE parameters
 
INTEGER, INTENT(IN) :: idsearch
INTEGER, DIMENSION(:), ALLOCATABLE :: ring_id, ring_jd
 
if (allocated(ring_id)) deallocate(ring_id)
allocate(ring_id(taillr), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: RINGS_TO_OGL_MENU"//char(0), "Table: RING_ID "//char(0))
  rings_to_ogl_m = 0
  goto 001
endif
 
k = 0
do i=1, taillr
  ring_id(i) = 0
  do j=1, ns
    ring_id(i) = ring_id(i) + nring(i,j)
  enddo
  if (ring_id(i) > 0) then
    k = k + 1
  endif
enddo
 
write (6, *) "k= ",k
 
if (allocated(ring_jd)) deallocate(ring_jd)
allocate(ring_jd(k), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: RINGS_TO_OGL_MENU"//char(0), "Table: RING_JD "//char(0))
  rings_to_ogl_m = 0
  goto 001
endif
 
k = 0
do i=1, taillr
  if (ring_id(i) > 0) then
    k = k + 1
    ring_jd(k) = i
  endif
enddo
 
call send_coord_opengl (4+idsearch, 1, 0, 0, k, k)
call init_menurings (4+idsearch, idsearch, k, ring_jd, 1)
 
if (allocated(ring_id)) deallocate(ring_id)
if (allocated(ring_jd)) deallocate(ring_jd)
 
rings_to_ogl_m = 1
 
001 continue
 
END FUNCTION