lecrefsta.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/.
!||====================================================================
!||    lecrefsta        ../starter/source/loads/reference_state/refsta/lecrefsta.F
!||--- called by ------------------------------------------------------
!||    lectur           ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg           ../starter/source/output/message/message.F
!||    r2r_sys          ../starter/source/coupling/rad2rad/routines_r2r.F
!||    usr2sys          ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    message_mod      ../starter/share/message_module/message_mod.F
!||    reader_old_mod   ../starter/share/modules1/reader_old_mod.F90
!||    refsta_mod       ../starter/share/modules1/refsta_mod.F
!||====================================================================
      SUBROUTINE lecrefsta(ITABM1  ,UNITAB,IXC   ,IXTG  ,IXS   ,
     .                     XYZREF  ,XREFC ,XREFTG,XREFS ,TAGNOD,
     .                     IDDLEVEL,TAGREF )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE reader_old_mod , ONLY : irec, nslash
      USE unitab_mod
      USE message_mod
      USE refsta_mod , ONLY : rs0_fmt
      USE reader_old_mod , ONLY : line
      use element_mod , only : nixs,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      "scr03_c.inc"
#include      "scr17_c.inc"
#include      "com04_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
      INTEGER ITABM1(*),IXC(NIXC,*),IXTG(NIXTG,*),IXS(NIXS,*),TAGNOD(*)
      INTEGER IDDLEVEL,TAGREF(*)
      my_real xrefc(4,3,*),xreftg(3,3,*),xrefs(8,3,*),xyzref(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  IE, IN, ID, NN, NNOD
      my_real XX, YY, ZZ
      CHARACTER MESS*40
      DATA mess/'REFSTA'/      
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS,R2R_SYS
C=======================================================================
C--------------------------------------                              
C  READING OF REFERENCE STATE NODES
C--------------------------------------
      IF(iddlevel == 0) THEN
        WRITE(iout,1000)
        IF(ipri >= 5) WRITE(iout,'(8X,A7,3(18X,A2))') 'node-id',' x',' y',' z'
      ENDIF
      NNOD=0
      DO
        READ(IIN6,FMT='(a)',END=799,ERR=798)LINE          
        IF (LINE(1:1) == '#') CYCLE                    
        IF (rs0_fmt == 1)THEN                             
          READ(line,'(I8,3F16.0)', err=797) id,xx,yy,zz   
        ELSE                                              
          READ(line,'(I10,3F20.0)',err=797) id,xx,yy,zz   
        ENDIF
        IF (id <= 0) cycle
        IF (nsubdom == 0) nn = usr2sys(id,itabm1,mess,0)
        IF (nsubdom  > 0) THEN
                   nn = r2r_sys(id,itabm1,mess)
                   IF (nn == 0) cycle
        ENDIF
        tagref(nn) = 1
        IF (tagnod(nn) == 0) THEN
          nnod=nnod+1
          IF(iddlevel == 0.AND.ipri >= 5) WRITE(iout,'(5X,I10,5X,1P3G20.13)') id,xx,yy,zz
          xyzref(1,nn) = xx                                   
          xyzref(2,nn) = yy                                   
          xyzref(3,nn) = zz
        ELSEIF(iddlevel == 0) THEN
C   ERROR : THIS NODE IS ALSO DEFINED IN XREF
          CALL ancmsg(msgid=1034,
     .                msgtype=msgerror,anmode=aninfo,
     .                i1=id)
        ENDIF                                  
      ENDDO                                          
C-------------                                                       
 797  CONTINUE                                          
      CALL ancmsg(msgid=733,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            c1=line)
 798  CONTINUE                                          
      CALL ancmsg(msgid=734,
     .            msgtype=msgerror,
     .            anmode=aninfo)
 799  CONTINUE                                          
      IF(iddlevel == 0.AND.ipri < 5) WRITE(iout,1010) nnod
C-------------                                                       
      DO ie=1,numelc                                    
        DO in=1,4                                       
          nn = ixc(in+1,ie)
          IF (tagnod(nn) == 0)THEN
            xrefc(in,1,ie) = xyzref(1,nn)               
            xrefc(in,2,ie) = xyzref(2,nn)               
            xrefc(in,3,ie) = xyzref(3,nn)               
          ENDIF                          
        ENDDO                                           
      ENDDO                                             
      DO ie=1,numeltg                                   
        DO in=1,3                                       
          nn = ixtg(in+1,ie)                            
          IF (tagnod(nn) == 0)THEN
            xreftg(in,1,ie) = xyzref(1,nn)                
            xreftg(in,2,ie) = xyzref(2,nn)                
            xreftg(in,3,ie) = xyzref(3,nn)                
          ENDIF                          
        ENDDO                                           
      ENDDO                                             
      DO ie=1,numels8                                   
        DO in=1,8                                       
          nn = ixs(in+1,ie)                             
          IF (tagnod(nn) == 0)THEN
            xrefs(in,1,ie) = xyzref(1,nn)                 
            xrefs(in,2,ie) = xyzref(2,nn)                 
            xrefs(in,3,ie) = xyzref(3,nn)                 
          ENDIF                          
        ENDDO                                           
      ENDDO 
C-----------
      RETURN
 1000 FORMAT(//
     & 5x,'    REFERENCE STATE (REFSTA)  ',/
     & 5x,'    ------------------------  ',/)
 1010 FORMAT(
     & 5X,'number of nodes . . . . . . . . =',I10)
      END SUBROUTINE LECREFSTA