admbcs.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/.
!||====================================================================
!||    admbcs        ../starter/source/model/remesh/admbcs.F
!||--- called by ------------------------------------------------------
!||    lectur        ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    admbcs3       ../starter/source/model/remesh/admbcs.F
!||    admbcs4       ../starter/source/model/remesh/admbcs.F
!||    ancmsg        ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE admbcs(IXC,IPARTC,IXTG,IPARTTG,IPART,
     .                  ICODE,ISKEW,ITAB,SH4TREE,SH3TREE)
      USE message_mod
      use element_mod , only : nixc,nixtg
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "scr17_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXC(NIXC,*),IPARTC(*),IXTG(NIXTG,*),IPARTTG(*),
     .        ipart(lipart1,*),icode(*),iskew(*),itab(*),
     .        sh4tree(ksh4tree,*),sh3tree(ksh3tree,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IP,NLEV,N1,N2,IC1,IC2,ICOD,IS1,IS2, 
     .        dir, n
C-----------------------------------------------
      INTEGER MY_AND
      EXTERNAL my_and
C-----------------------------------------------
C
      DO n=1,numelc0
        ip   =ipartc(n)
        nlev =ipart(10,ip)
        IF(nlev>0)THEN
          DO dir=0,3
            n1=ixc(dir+2,n)
            n2=ixc(mod(dir+1,4)+2,n)
            ic1 =icode(n1)
            ic2 =icode(n2)
            icod=my_and(ic1,ic2)
            IF(icod/=0)THEN
              is1=iskew(n1)
              is2=iskew(n2)
              IF(is1/=is2)THEN
                CALL ancmsg(msgid=650,
     .                      msgtype=msgerror,
     .                      anmode=aninfo,
     .                      i2=itab(n2),
     .                      i1=itab(n1),
     .                      i3=ixc(nixc,n))
              END IF
              CALL admbcs4(dir,icod,is1,n ,ixc,
     .                     ipartc,ipart,icode,iskew,sh4tree)
            END IF
          END DO
        END IF
      END DO
C
      DO n=1,numeltg0
        ip   =iparttg(n)
        nlev =ipart(10,ip)
        IF(nlev>0)THEN
          DO dir=0,2
            n1=ixtg(dir+2,n)
            n2=ixtg(mod(dir+1,3)+2,n)
            ic1 =icode(n1)
            ic2 =icode(n2)
            icod=my_and(ic1,ic2)
            IF(icod/=0)THEN
              is1=iskew(n1)
              is2=iskew(n2)
              IF(is1/=is2)THEN
                CALL ancmsg(msgid=650,
     .                      msgtype=msgerror,
     .                      anmode=aninfo,
     .                      i2=itab(n2),
     .                      i1=itab(n1),
     .                      i3=ixtg(nixtg,n))
              END IF
              CALL admbcs3(dir,icod,is1,n ,ixtg,
     .                     iparttg,ipart,icode,iskew,sh3tree)
            END IF
          END DO
        END IF
      END DO
 
      RETURN
      END     
 
 
!||====================================================================
!||    admbcs4       ../starter/source/model/remesh/admbcs.F
!||--- called by ------------------------------------------------------
!||    admbcs        ../starter/source/model/remesh/admbcs.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||====================================================================
      RECURSIVE SUBROUTINE admbcs4(DIR,ICOD ,ISK  ,N    ,IXC    ,
     .                          IPARTC,IPART,ICODE,ISKEW,SH4TREE)
      use element_mod , only : nixc
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "scr17_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER dir,icod,isk,n,ixc(nixc,*),
     .        ipartc(*),ipart(lipart1,*),icode(*),iskew(*),
     .        sh4tree(ksh4tree,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER level,ip,NLEV
      INTEGER son,m1,m2
C-----------------------------------------------
      INTEGER my_or
      EXTERNAL MY_OR
C-----------------------------------------------
      level=sh4tree(3,n)
      IF(level<0)THEN
        level=-(level+1)
      END IF
      ip   =ipartc(n)
      nlev =ipart(10,ip)
 
      IF(level<nlev)THEN
        son=sh4tree(2,n)+dir
        CALL admbcs4(dir,icod,isk,son,ixc,
     .              ipartc,ipart,icode,iskew,sh4tree)
        son=sh4tree(2,n)+mod(dir+1,4)
        CALL admbcs4(dir,icod,isk,son,ixc,
     .              ipartc,ipart,icode,iskew,sh4tree)
      ELSE
        m1=ixc(dir+2,n)
        m2=ixc(mod(dir+1,4)+2,n)
        icode(m1)=my_or(icod,icode(m1))
        icode(m2)=my_or(icod,icode(m2))
        iskew(m1)=isk
        iskew(m2)=isk
      END IF
 
      RETURN
      END     
!||====================================================================
!||    admbcs3       ../starter/source/model/remesh/admbcs.F
!||--- called by ------------------------------------------------------
!||    admbcs        ../starter/source/model/remesh/admbcs.f
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||====================================================================
      RECURSIVE SUBROUTINE admbcs3(DIR,ICOD,ISK,N,IXTG,
     .                         IPARTTG,IPART,ICODE,ISKEW,SH3TREE)
      use element_mod , only : nixtg
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "scr17_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER dir,icod,isk,n,ixtg(nixtg,*),
     .        iparttg(*),ipart(lipart1,*),icode(*),iskew(*),
     .        sh3tree(ksh3tree,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER level,ip,nlev
      INTEGER son, m1, m2
C-----------------------------------------------
      INTEGER my_or
      EXTERNAL my_or
C-----------------------------------------------
      level=sh3tree(3,n)
      IF(level<0)THEN
        level=-(level+1)
      END IF
      ip   =iparttg(n)
      nlev =ipart(10,ip)
 
      IF(level<nlev)THEN
        son=sh3tree(2,n)+dir
        CALL admbcs3(dir,icod,isk,son,ixtg,
     .              iparttg,ipart,icode,iskew,sh3tree)
        son=sh3tree(2,n)+mod(dir+1,3)
        CALL admbcs3(dir,icod,isk,son,ixtg,
     .              iparttg,ipart,icode,iskew,sh3tree)
      ELSE
        m1=ixtg(dir+2,n)
        m2=ixtg(mod(dir+1,3)+2,n)
        icode(m1)=my_or(icod,icode(m1))
        icode(m2)=my_or(icod,icode(m2))
        iskew(m1)=isk
        iskew(m2)=isk
      END IF
 
      RETURN
      END