nboxlist.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    nboxlst                ../starter/source/model/box/nboxlist.F
!||--- called by ------------------------------------------------------
!||    hm_read_box            ../starter/source/model/box/hm_read_box.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      INTEGER FUNCTION nboxlst(LIST  ,NLIST  ,IBOXTMP,NBBOX  ,
     .                         IX1   ,IX2    ,INDEX  ,KK     ,ID   ,TITR)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
C      FONCTION DONNE N0 SYSTEME D'UNE LISTE DE BOXES USER
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER nlist,kk,nbbox,id
      INTEGER list(nlist),index(nbbox*3),iboxtmp(nbbox),ix1(nbbox),ix2(nbbox)
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: titr
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER i,j,nbox,nold,k,k0,k1,kall,id0,
     .        iwork(70000),isign(nlist),isign1(nlist),
     .        signold,fac(nlist+1),indxold,fac1(nlist+1),
     .        facx,list1(nlist),idel(nlist),idbl(nlist)
      CHARACTER box*3
C-----------------------
C TRI DE LIST EN ORDRE CROISSANT
C-----------------------
        DO i=1,nlist
          isign(i) = sign(1,list(i))
          list(i) = abs(list(i))
        ENDDO
C---
        CALL my_orders(0,iwork,list,index,nlist,1)
        DO i=1,nlist
          index(nlist+i) = list(index(i))
          isign1(i)= isign(index(i))
        ENDDO
C---
        DO i=1,nlist
          list(i)  = index(nlist+i)
          isign(i) = isign1(i)
        ENDDO
C---
        nbox = nlist
C-----------------------
C TRI DE IBOX() EN ORDRE CROISSANT si KK = 0
C-----------------------
        IF (kk == 0) THEN
          DO i=1,nbbox
            ix2(i) = iboxtmp(i)
          ENDDO
          CALL my_orders(0,iwork,ix2,index,nbbox,1)
          DO i=1,nbbox
            ix1(i) = ix2(index(i))
          ENDDO
          DO i=1,nbbox
            ix2(i) = index(i)
          ENDDO
        ENDIF
C-----------------------
C RECHERCHE DES ELEMENTS DE LIST() DANS IBOX()
C  ALGO < NLIST+NBBOX
C-----------------------
        i=1
        j=1
        DO i=1,nbox
          DO WHILE(abs(list(i)) > ix1(j).AND. j < nbbox)
            j=j+1
          ENDDO
          IF (abs(list(i)) == ix1(j))THEN
            list(i) = ix2(j)*isign(i)
          ELSE
            CALL ancmsg(msgid=795,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  i1=id,
     .                  c1=titr,
     .                  i2=list(i))
            nboxlst=i-1
            RETURN
          ENDIF
        ENDDO
C---
        nboxlst = nbox
C---
        RETURN
        END