lecrefsta.F File Reference

#include "implicit_f.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "r2r_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	lecrefsta (itabm1, unitab, ixc, ixtg, ixs, xyzref, xrefc, xreftg, xrefs, tagnod, iddlevel, tagref)

Function/Subroutine Documentation

lecrefsta()

subroutine lecrefsta	(	integer, dimension(*)	itabm1,
		type (unit_type_), intent(in)	unitab,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(nixs,*)	ixs,
			xyzref,
			xrefc,
			xreftg,
			xrefs,
		integer, dimension(*)	tagnod,
		integer	iddlevel,
		integer, dimension(*)	tagref )

Definition at line 36 of file lecrefsta.F.

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)