hm__read__thgrns_8F_source.html

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/.

!||====================================================================

!||    hm_read_thgrns           ../starter/source/output/th/hm_read_thgrns.F

!||--- called by ------------------------------------------------------

!||    hm_read_thgrou           ../starter/source/output/th/hm_read_thgrou.f

!||--- calls      -----------------------------------------------------

!||    ancmsg                   ../starter/source/output/message/message.F

!||    fretitl                  ../starter/source/starter/freform.F

!||    fretitl2                 ../starter/source/starter/freform.F

!||    hm_get_int_array_index   ../starter/source/devtools/hm_reader/hm_get_int_array_index.F

!||    hm_get_intv              ../starter/source/devtools/hm_reader/hm_get_intv.F

!||    hm_get_string_index      ../starter/source/devtools/hm_reader/hm_get_string_index.F

!||    hm_thvarc                ../starter/source/output/th/hm_read_thvarc.F

!||    nintrn                   ../starter/source/system/nintrn.F

!||    zeroin                   ../starter/source/system/zeroin.F

!||--- uses       -----------------------------------------------------

!||    hm_option_read_mod       ../starter/share/modules1/hm_option_read_mod.F

!||    message_mod              ../starter/share/message_module/message_mod.F

!||    submodel_mod             ../starter/share/modules1/submodel_mod.F

!||====================================================================


      SUBROUTINE hm_read_thgrns(

     1      ITYP  ,KEY    ,ITAB   ,ITABM1,KXX    ,

     3      IXX   ,IAD    ,IFI    ,ITHGRP,ITHBUF ,

     4      NV    ,VARE   ,VARG   ,NVG   ,IVARG  ,

     5      NSNE  ,IVNS2R, NV0    ,ID    ,TITR   ,

     6      ITHVAR,FLAGABF,NVARABF, LSUBMODEL)

C-----------------------------------------------

C   M o d u l e s

C-----------------------------------------------

      USE message_mod

      USE submodel_mod

      USE hm_option_read_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      "scr23_c.inc"

#include      "scr17_c.inc"

#include      "scr03_c.inc"

#include      "com04_c.inc"

#include      "units_c.inc"

#include      "param_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER NIX,ITYP,ITABM1(*),KXX(NIXX,*),IXX(*),

     .        ITAB(*),ITHGRP(NITHGR),ITHBUF(*),

     .        IFI,IAD,NV,NVG,IVARG(18,*),NSNE,

     .        IVNS2R(18,*),NV0,ITHVAR(*),FLAGABF,NVARABF

      CHARACTER*10 VARE(NV),KEY,VARG(NVG)

      CHARACTER(LEN=NCHARTITLE)::TITR

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER J,JJ, I,ISU,ID,NNE,NOSYS,J10(10),NTOT,KK,IER,

     .        ok,igs,igrs,nsu,k,l,jrec,cont,iad0,iadv,ntri,nl,

     .        ifitmp,iadfin,nvar,m,n,iad1,iad2,isk,iproc,

     .        idns, ins, iun, ist, nst, idst

      CHARACTER(LEN=NCHARTITLE) :: TITLE

      CHARACTER :: MESS*40,CSTRAND1*9,CSTRAND2*13

      TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(NSUBMOD)

      LOGICAL IS_AVAILABLE

      INTEGER LENTRIM

C-----------------------------------------------

C   E x t e r n a l   F u n c t i o n s

C-----------------------------------------------

      INTEGER NINTRN,THVARC,HM_THVARC

      DATA mess/'TH GROUP DEFINITION                     '/

      DATA iun/1/,

     .     cstrand1/'STRAND_ID'/,cstrand2/'STRAND_NUMBER'/

C-----------------------------------------------

      id=ithgrp(1)

      CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)

      ithgrp(2)=ityp

      ithgrp(3)=0

      ifitmp=ifi+1000

      ! Number of variables indicated by the user

      CALL hm_get_intv('Number_Of_Variables',nvar,is_available,lsubmodel)


      ! Number of stored variables and reading the variables

      IF (nvar>0) nvar = hm_thvarc(vare,nv,ithbuf(iad),varg,nvg,ivarg,nv0,id,titr ,lsubmodel)

      IF(nvar == 0) CALL ancmsg(msgid=1109,

     .   msgtype=msgerror,

     .   anmode=aninfo_blind_1,

     .   i1=id,

     .   c1=titr )

c

      ithgrp(6)=nvar

      ithgrp(7)=iad

      iad=iad+nvar

      ifi=ifi+nvar

C

       !JREC=IREC+1

       !READ(IIN,REC=JREC,ERR=999,FMT='(A)')LINE

       !READ(LINE,ERR=999,FMT=FMT_I)IDNS

       !CALL FRETITL2(TITR,ITHGRP(NITHGR-LTITR+1),LTITR)

       !INS =NINTRN(IDNS,KXX,NIXX,NUMELX,ITHGRP(1),TITR)

       !NNE =KXX(3,INS)-1

       CALL hm_get_intv('ids',idns,is_available,lsubmodel)

       ins =nintrn(idns,kxx,nixx,numelx,ithgrp(1),titr)

       nne =kxx(3,ins)-1

C

C

       !NST=0

       !DOWHILE(LINE(1:1)/='/')

       ! READ(line,err=999,fmt=fmt_thgr)ist,idst,titr

       ! IF (IST>NNE) THEN

       !    CALL FRETITL2(TITR,ITHGRP(NITHGR-LTITR+1),LTITR)

       !    CALL ANCMSG(MSGID=361,

     . !                MSGTYPE=MSGERROR,

     . !                ANMODE=ANINFO_BLIND_1,

     . !                I1=ITHGRP(1),

     . !                C1=TITR,

     . !                I2=IST)

       !    GOTO 999

       ! ENDIF

       ! NST=NST+1

       ! JREC=JREC+1

       ! READ(IIN,REC=JREC,ERR=999,FMT='(A)')LINE

       !ENDDO


       CALL hm_get_intv('Num_Cards',nst,is_available,lsubmodel)


C

      ithgrp(4)=nst

      ithgrp(5)=iad

      iad2=iad+4*nst

      ithgrp(8)=iad2

      ifi=ifi+4*nst+40*nst

      CALL zeroin(iad,iad+44*nst-1,ithbuf)

C

      DO k=1,nst

        !IREC=IREC+1

        ithbuf(iad)=ins

        !READ(IIN,REC=IREC,ERR=999,FMT='(A)')LINE

        CALL hm_get_int_array_index('XELEM_NUM',ist,k,is_available,lsubmodel)

        CALL hm_get_int_array_index('XELEM_USER',idst,k,is_available,lsubmodel)

        CALL hm_get_string_index('NAME_ARRAY',title,k,80,is_available)

        lentrim = len_trim(title)

        title = title(1:lentrim)


        IF (ist > nne) THEN

           CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)

           CALL ancmsg(msgid=361,

     .                 msgtype=msgerror,

     .                 anmode=aninfo_blind_1,

     .                 i1=ithgrp(1),

     .                 c1=titr,

     .                 i2=ist)

           GOTO 999

        ENDIF


        !READ(LINE,ERR=999,FMT=FMT_THGR)IST,IDST,TITLE

        ithbuf(iad+2*nst)=idst

        ithbuf(iad+3*nst)=ist

        iproc=0

        ithbuf(iad+nst)=iproc

        CALL fretitl(title,ithbuf(iad2),40)

        iad=iad+1

        iad2=iad2+40

      ENDDO

C

      iad = ithgrp(5)

      iad2= ithgrp(8)

      iad=iad2+40*nst

C

      nsne=nsne+nst


C=======================================================================

C ABF FILES

C=======================================================================

      nvar = ithgrp(6)

      iad0 = ithgrp(7)

      ithgrp(9) = nvarabf

      DO j = iad0,iad0+nvar-1

        DO k = 1,10

          ithvar((ithgrp(9)+(j-iad0)-1)*10+k) = ichar(vare(ithbuf(j))(k:k))

        ENDDO

      ENDDO

      nvarabf = nvarabf + nvar


C=======================================================================

C PRINTOUT

C=======================================================================

      IF(ipri >= 1) THEN

        n=ithgrp(4)

        iad1=ithgrp(5)

        nvar=ithgrp(6)

        iad0=ithgrp(7)

        iad2=ithgrp(8)

        WRITE(iout,'(//)')

        CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)

        WRITE(iout,'(A,I10,3A,I3,A,I2,2A,I10)')' TH GROUP:',ithgrp(1),',',trim(titr),',',nvar,' VAR',iun,key,':',idns

        WRITE(iout,'(A)')' -------------------'

        WRITE(iout,'(10A10)')(vare(ithbuf(j)),j=iad0,iad0+nvar-1)

        WRITE(iout,'(4A)')cstrand1,' ',cstrand2,' P_SPMD       NAME '

        DO k=iad1,iad1+n-1

         CALL fretitl2(titr,ithbuf(iad2),40)

         WRITE(iout,'(3I10,2A)')ithbuf(k+2*n),ithbuf(k+3*n),ithbuf(k+n),' ',titr(1:40)

         iad2=iad2+40

        ENDDO

      ENDIF


      iad1=ithgrp(7)

      DO i=1,nvar

       ithbuf(iad1+i-1)=ivns2r(ithbuf(iad1+i-1),1)

      ENDDO


      RETURN

 999  CALL freerr(1)

      RETURN


      END

hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164

hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523

hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53

hm_read_thgrns
subroutine hm_read_thgrns(ityp, key, itab, itabm1, kxx, ixx, iad, ifi, ithgrp, ithbuf, nv, vare, varg, nvg, ivarg, nsne, ivns2r, nv0, id, titr, ithvar, flagabf, nvarabf, lsubmodel)
Definition hm_read_thgrns.F:48

hm_read_thgrou
subroutine hm_read_thgrou(ithgrp, ithbuf, itab, itabm1, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, kxx, ixx, ipart, ifi, nthwa, kxsp, ixri, iskwn, iframe, nthgrp2, pathid, suthid, fxbipm, iparth, nparth, nvparth, nvsubth, imerge, ithvar, flagabf, nvarabf, nom_opt, ptr_nopt_fxby, ptr_nopt_inter, ptr_nopt_rwall, ptr_nopt_sect, ptr_nopt_joint, ptr_nopt_monv, ptr_nopt_acc, ptr_nopt_skw, ptr_nopt_gau, ptr_nopt_clus, ptr_nopt_sphio, isphio, rfi, t_monvol, igrsurf, subset, ithflag, npby, lsubmodel, iparg, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartx, ipartsp, ipartig3d, lithbufmx, map_tables, iflag, ptr_nopt_slipring, ptr_nopt_retractor, sensors, interfaces, ipari, dump_thnms1_file, itherm_fe, checksum, nsubdom, ipri)
Definition hm_read_thgrou.F:78

hm_option_read_mod
Definition hm_option_read_mod.F:408

message_mod
Definition message_mod.F:1249

names_and_titles_mod
Definition names_and_titles_mod.F:997

names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003

submodel_mod
Definition submodel_mod.F:712

nvar
integer function nvar(text)
Definition nvar.F:32

ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

nl
character *2 function nl()
Definition message.F:2354

freerr
subroutine freerr(it)
Definition freform.F:506

fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620

fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804

starter
program starter
Definition starter.F:39

zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47