lecig3d.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	lecig3d (itab, ipart, ipartig3d, ipm, igeo, kxig3d, ixig3d, itabm1, nctrlmax, tabconpatch)

Function/Subroutine Documentation

lecig3d()

subroutine lecig3d	(	integer, dimension(*)	itab,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipartig3d,
		integer, dimension(npropmi,*)	ipm,
		integer, dimension(npropgi,*)	igeo,
		integer, dimension(nixig3d,*)	kxig3d,
		integer, dimension(*)	ixig3d,
		integer, dimension(*)	itabm1,
		integer	nctrlmax,
		type(tabconpatch_ig3d_), dimension(*)	tabconpatch )

Definition at line 38 of file lecig3d.F.

C----------------------------------------------------------
C     M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE meshsurfig3d_mod
      USE format_mod , ONLY : fmt_10i, fmt_8i, fmt_2i
      USE reader_old_mod , ONLY : kline, kcur, line, kige3d, koptad, irec
C----------------------------------------------------------
C     READING ISO GEOMETRIC ELEMENT
C-----------------------------------------------
C     KXIG3D(1,*):IMID :   ID DU MATERIAU
C     kxig3d(2,*):ipid: property id
C     kxig3d(3,*):nnod: number of control points of the element
C     KXIG3D(4,*):IAD  :   address of the node numbers area in IXIG3D
C                                     IXIG3D(IAD) A IXIG3D(IAD+NNOD-1)
C     KXIG3D(5,*):ID   :   ID DE L'ELEMENT.
C     KXIG3D(6,*):ID   :   index of 1st knot in the Xknot vector corresponding to the element
C     KXIG3D(7,*):ID   :   index of 1st knot in the Yknot vector corresponding to the element
C     KXIG3D(8,*):ID   :   index of 1st knot in the Zknot vector corresponding to the element
C     KXIG3D(9,*):ID   :   index of 2nd knot in the Xknot vector corresponding to the element
C     KXIG3D(10,*):ID  :   index of 2nd knot in the Yknot vector corresponding to the element
C     KXIG3D(11,*):ID  :   index of 2nd knot in the Zknot vector corresponding to the element
C     KXIG3D(12,*):    :
C     KXIG3D(13,*):    :   
C     KXIG3D(14,*):    :   
C     KXIG3D(15,*):ID  :   ID OF THE FIRST NODE FOR ANIMATION FILE (27 BRICKS)   
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      "com04_c.inc"
#include      "scr17_c.inc"
#include      "units_c.inc"
#include      "param_c.inc"
#include      "ige3d_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER KXIG3D(NIXIG3D,*),IXIG3D(*),ITAB(*), 
     .        IPART(LIPART1,*),IPARTIG3D(*),
     .        IPM(NPROPMI,*),IGEO(NPROPGI,*),ITABM1(*),
     .        NCTRLMAX
      TYPE(TABCONPATCH_IG3D_), DIMENSION(*) :: TABCONPATCH
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I,N,J,ID,IDS,IAD,
     .           I1, I2,MID,PID,IDX1,IDY1,IDZ1,NCTRL,NBLINE,
     .           NRAFX,NRAFY,NRAFZ,NBIG3D_PATCH
      INTEGER :: TABIDS(NUMELIG3D0),J10(10)
      CHARACTER :: MESS*40
      my_real :: bid
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER  USR2SYS
C-----------------------------------------------
      DATA mess /'ISO-GEOMETRIC ELEMENTS DEFINITION       '/
C=======================================================================
c
        nbig3d_patch = 0
        nbpart_ig3d = 0
c
        kcur = kige3d
        nbpart_ig3d = nbpart_ig3d+1
        tabconpatch(nbpart_ig3d)%ID_TABCON=nbpart_ig3d
        irec = koptad(kcur)
        irec=irec+1
        READ(iin,rec=irec,err=999,fmt='(A)')line
        DO WHILE( line(1:1) /= '/' .OR. line(1:6) == '/IGE3D')
        
         IF (line(1:1) == '/')THEN  ! change of part
          irec=irec+1
          READ(iin,rec=irec,err=999,fmt='(A)')line
         ENDIF
       
         READ(line,err=999,fmt=fmt_8i)id,idx1,idy1,idz1,nctrl,nrafx,nrafy,nrafz
         nbig3d_patch=nbig3d_patch+1
         irec = irec + ((nctrl-1)/10)+2
         READ(iin,rec=irec,err=999,fmt='(A)')line
         
         IF (line(1:6) == '/IGE3D')THEN  !  ON A ONE CHANGEMENT DE PART
           tabconpatch(nbpart_ig3d)%L_TAB_IG3D=nbig3d_patch
           ALLOCATE(tabconpatch(nbpart_ig3d)%TAB_IG3D(nbig3d_patch))
           nbpart_ig3d = nbpart_ig3d+1
           nbig3d_patch=0
           irec=irec+1
           READ(iin,rec=irec,err=999,fmt='(A)')line
         ENDIF
 
        ENDDO
 
        tabconpatch(nbpart_ig3d)%L_TAB_IG3D=nbig3d_patch
        ALLOCATE(tabconpatch(nbpart_ig3d)%TAB_IG3D(nbig3d_patch))
 
        nbpart_ig3d = 0
        nbig3d_patch = 0
 
        bid =0
        iad =1
        kcur=kige3d
        irec=koptad(kcur)-1 
        i = 0
        inod_ige = firstnod_isogeo
        ids=0
        DO WHILE( i < numelig3d0 )              
         irec=irec+1                        
         READ(iin,rec=irec,err=999,fmt='(A)')line
         IF (line(1:1) == '/')THEN
          nbpart_ig3d = nbpart_ig3d+1
          nbig3d_patch = 0
          kline=line                                     
          CALL fredec0(id)
          ids=0
          DO j=1,npart
            IF(ipart(4,j) == id)ids=j
          ENDDO
          IF(ids == 0) THEN
            CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="IGE3D",i1=id,i2=id,prmod=msg_cumu)
          ENDIF
          tabconpatch(nbpart_ig3d)%PID=ids
         ELSE
          i = i + 1
          kxig3d(1,i) =ipart(1,ids)
          kxig3d(2,i) =ipart(2,ids)
          kxig3d(4,i) =iad
          ipartig3d(i)=ids
 
          READ(iin,rec=irec,err=999,fmt='(A)')line
          READ(line,err=999,fmt=fmt_8i) id,idx1,idy1,idz1,nctrl,nrafx,nrafy,nrafz
          nbig3d_patch = nbig3d_patch + 1
          tabconpatch(nbpart_ig3d)%TAB_IG3D(nbig3d_patch)=i ! ID
          nctrlmax = max(nctrlmax,nctrl)
          kxig3d(3,i)=nctrl
          kxig3d(5,i)=id
          kxig3d(6,i)=idx1
          kxig3d(7,i)=idy1
          kxig3d(8,i)=idz1
 
          kxig3d(12,i)=max(nrafx,1)
          kxig3d(13,i)=max(nrafy,1)
          kxig3d(14,i)=max(nrafz,1)
          kxig3d(15,i)=inod_ige
          inod_ige = inod_ige + 64
C                  
          nbline= ((nctrl-1)/10)+1
 
          DO n=1,nbline
            irec=irec+1
            READ(iin,rec=irec,err=999,fmt='(A)')line
            READ(line,err=999,fmt=fmt_10i) j10
            DO j=1,10
             IF(j10(j) /= 0)THEN
               ixig3d(iad)=usr2sys(j10(j),itabm1,mess,id)
               iad=iad+1
             ENDIF
            ENDDO
          ENDDO
         ENDIF
        ENDDO
C-----------
      CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
C-------------------------------------
C search for duplicate IDs
C-------------------------------------
      DO i=1,numelig3d0
         tabids(i)= kxig3d(5,i)
      ENDDO
      CALL udouble(tabids,1,numelig3d0,mess,0,bid)
C-------------------------------------
C Print
C-------------------------------------
      i1=1
      i2=min0(50,numelig3d0)
C
   90 WRITE (iout,300)
      DO 100 i=i1,i2
       mid=ipm(1,kxig3d(1,i))
       pid=igeo(1,kxig3d(2,i))
       WRITE (iout,'(4(I10,1X))') i,kxig3d(5,i),mid,pid
       WRITE (iout,'(10(I10,1X))')
     .    (itab(ixig3d(iad)),iad=kxig3d(4,i),kxig3d(4,i)+kxig3d(3,i)-1)
  100 CONTINUE
      IF(i2==numelig3d0)GOTO 200
      i1=i1+50
      i2=min0(i2+50,numelig3d0)
      GOTO 90
C
 200  CONTINUE
C
 300  FORMAT(/' ISO-GEOMETRIC ELEMENTS'/
     +        ' ----------------------'/
     + '    LOC-EL     GLO-EL      MATER       GEOM'/
     + '    NODES LIST')
      RETURN
C-------------------------------------
  999 CALL freerr(3)
      RETURN