inintr_thkvar.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/.
!||====================================================================
!||    thickvar        ../starter/source/interfaces/interf1/inintr_thkvar.F
!||--- called by ------------------------------------------------------
!||    inintr_thkvar   ../starter/source/interfaces/interf1/inintr_thkvar.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE thickvar(ELBUF_TAB,IPARG,THKSH4_VAR,THKSH3_VAR,THKNOD,
     .                    IXC  ,IXTG     )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "param_c.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*), IXC(NIXC,*), IXTG(NIXTG,*)
C     REAL
      my_real
     .   thksh4_var(*), thksh3_var(*), thknod(*)
      TYPE(elbuf_struct_), DIMENSION(NGROUP) :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NG, I, J, N, NEL
C-----------------------------------------------
      DO ng=1,ngroup
        mtn=iparg(1,ng)
        IF (mtn==0 .OR. mtn==13) cycle
        nel=iparg(2,ng)
        nft=iparg(3,ng)
        ity=iparg(5,ng)
        IF (ity == 3) THEN
          DO i=1,nel
            n=nft+i
            thksh4_var(n)=elbuf_tab(ng)%GBUF%THK(i)
            DO j=2,5
              thknod(ixc(j,n))=max(thknod(ixc(j,n)),thksh4_var(n))
            END DO
          END DO
        ELSEIF(ity == 7)THEN
          DO i=1,nel
            n=nft+i
            thksh3_var(n)=elbuf_tab(ng)%GBUF%THK(i)
            DO j=2,4
              thknod(ixtg(j,n))=max(thknod(ixtg(j,n)),thksh3_var(n))
            END DO
          END DO
        END IF
      END DO
C
      RETURN
      END
!||====================================================================
!||    inintr_thkvar          ../starter/source/interfaces/interf1/inintr_thkvar.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    fretitl2               ../starter/source/starter/freform.F
!||    inint3_thkvar          ../starter/source/interfaces/inter3d1/inint3_thkvar.F
!||    thickvar               ../starter/source/interfaces/interf1/inintr_thkvar.f
!||--- uses       -----------------------------------------------------
!||    intbufscratch_mod      ../starter/source/interfaces/interf1/intbufscratch_mod.F
!||    intstamp_mod           ../starter/share/modules1/intstamp_mod.F
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE inintr_thkvar(ELBUF_TAB,
     1                  IPARI   ,INTBUF_TAB,INSCR   ,X       ,
     2                  IXS     ,IXC     ,PM      ,GEO     ,ITAB    ,
     3                  MWA     ,RWA     ,IXTG    ,IKINE   ,
     4                  IPARG   ,KNOD2ELS,
     5                  KNOD2ELC,KNOD2ELTG,NOD2ELS,NOD2ELC ,NOD2ELTG,
     6                  INTSTAMP,SKEW     ,MS     ,IN      ,V       ,
     7                  VR       ,RBY     ,NPBY   ,LPBY    ,IPARTS  ,
     8                  IPARTC,IPARTG,THK_PART,NOM_OPT,PTR_NOPT_INTER)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intstamp_mod
      USE message_mod
      USE elbufdef_mod
      USE intbufdef_mod
      USE intbufscratch_mod
      USE inoutfile_mod
      USE names_and_titles_mod , ONLY : nchartitle
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-----------------------------------------------
#include      "units_c.inc"
#include      "param_c.inc"
#include      "scr15_c.inc"
#include      "scr17_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),  IXS(*),
     .   IXC(*), ITAB(*), MWA(*), IXTG(*), IKINE(*),
     .   IPARG(NPARG,*),
     .   KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
     .   NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
     .   NPBY(NNPBY,*), LPBY(*), IPARTS(*), IPARTC(*), IPARTG(*)
      TYPE(INTSTAMP_DATA), TARGET :: INTSTAMP(*)
      TYPE(INTSTAMP_DATA),POINTER :: pINTSTAMP
      my_real
     .   x(3,*), pm(*), geo(*), rwa(6,*),
     .   ms(*), in(*),  v(3,*), vr(3,*), rby(nrby,*), skew(lskew,*),
     .   thk_part(*)
      INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_INTER
      TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
      TYPE(scratch_struct_) INSCR(*)
 
 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, JINSCR, NINTI, IWRN, I, I_MEM,
     .   resort
      INTEGER NTY, STAT, ISTAMP, MULTIMP,LEN_FILNAM
      my_real,
     .   DIMENSION(:),ALLOCATABLE:: thksh4_var,thksh3_var,thknod
      CHARACTER*2148 FILNAM
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
C-----------------------------------------------
      i_mem = 0
      resort = 0
C----
      ALLOCATE (thksh4_var(numelc) ,stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                           msgtype=msgerror,
     .                         c1='THKSH4_VAR')
      ALLOCATE (thksh3_var(numeltg) ,stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                           msgtype=msgerror,
     .                         c1='THKSH3_VAR')
      ALLOCATE (thknod(numnod) ,stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                           msgtype=msgerror,
     .                         c1='THKNOD')
      thksh4_var=zero
      thksh3_var=zero
      thknod    =zero
C
      CALL thickvar(elbuf_tab,iparg,thksh4_var,thksh3_var,thknod,
     .              ixc  ,ixtg     )
C
      iwrn = 0
      istamp=0
      DO 100 n=1,ninter
      resort = 0
      nty=ipari(7,n)
      IF (nty /= 21 .AND. nty /=23) GOTO 100
C
      IF(nty==21) istamp=istamp+1
C
 200  CONTINUE
C
 
       IF (i_mem == 2)THEN
          multimp = max(ipari(23,n)+8,nint(ipari(23,n)*1.5))
          CALL upgrade_multimp(n,multimp,intbuf_tab(n))
         i_mem = 0
       ENDIF
 
 
 
      jinscr=ipari(10,n)
      ninti=n
      id=nom_opt(1,ptr_nopt_inter+ninti)
      CALL fretitl2(titr,
     .              nom_opt(lnopt1-ltitr+1,ptr_nopt_inter+ninti),ltitr)
   
      IF(istamp > 0)THEN
        pintstamp => intstamp(istamp)
      ELSE
        NULLIFY(pintstamp)
      ENDIF
      
      CALL inint3_thkvar(
     1  intbuf_tab(n),inscr(ninti)%WA           ,x        ,ixs   ,
     2  ixc          ,ixtg         ,pm        ,geo      ,ipari(1,n),
     3  ninti         ,itab         ,mwa       ,rwa      ,iwrn      ,
     4  ikine        ,knod2els     ,knod2elc  ,knod2eltg ,nod2els  ,
     5  nod2elc   ,nod2eltg        ,
     6  thksh4_var,thksh3_var   ,thknod  ,pintstamp  ,skew  ,
     7  ms        ,in           ,v       ,vr             ,rby      ,
     8  npby      ,lpby         ,i_mem   ,resort       ,iparts     ,
     9  ipartc    ,ipartg       ,thk_part     ,id      ,titr,
     a  nom_opt)
      IF (i_mem /= 0) GOTO 200
  100 CONTINUE
C
      IF(iwrn/=0) THEN
        len_filnam = outfile_name_len + rootlen + 6
        filnam = outfile_name(1:outfile_name_len)//rootnam(1:rootlen)//'.coord'
        OPEN(unit=iou2,file=filnam(1:len_filnam),status='UNKNOWN',
     .       form='FORMATTED')
        WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
     .                    '---5---|---6---|---7---|---8---|'
        WRITE(iou2,'(A)')'# NEW NODES COORDINATES'
        WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
     .                    '---5---|---6---|---7---|---8---|'
        WRITE(iou2,'(I10,1P3G20.13)')
     .               (itab(i),x(1,i),x(2,i),x(3,i),i=1,numnod)
        WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
     .                    '---5---|---6---|---7---|---8---|'
        WRITE(iou2,'(A)')'# END OF NEW NODES COORDINATES'
        WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
     .                    '---5---|---6---|---7---|---8---|'
        CLOSE(unit=iou2)
      ENDIF
C
      DEALLOCATE (thksh4_var,thksh3_var)
C-----------
      RETURN
      END