st_qaprint_element.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/.
!||====================================================================
!||    st_qaprint_element     ../starter/source/output/qaprint/st_qaprint_element.F
!||--- called by ------------------------------------------------------
!||    st_qaprint_driver      ../starter/source/output/qaprint/st_qaprint_driver.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE st_qaprint_element(IXS , IXS10, IPM   , IGEO, ITAB, 
     1                              ISOLNOD,IXR, R_SKEW,ISKWN, IXP ,
     2                              IXT    ,X  , IXC   ,IXTG ,THKE ,
     3                              SH4ANG ,THKEC,SH3ANG,KXSP ,IPARTSP,
     4                              IPART  ,IXR_KJ,KXX ,IXX  , IPARTX ,
     5                              IXRI   ,IXS16 ,IXQ ,IBEAM_VECTOR,RBEAM_VECTOR)
C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE qa_out_mod
      USE message_mod
      USE my_alloc_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      "com04_c.inc"
#include      "param_c.inc"
#include      "scr17_c.inc"
#include      "scr23_c.inc"
#include      "sphcom.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IXS(NIXS,*), IXS10(6,*), IPM(NPROPMI,*), IGEO(NPROPGI,*)
      INTEGER, INTENT(IN) :: ITAB(*), ISOLNOD(*),IXR_KJ(5,*)
      INTEGER, INTENT(IN) :: IXR(NIXR,*), R_SKEW(*), ISKWN(LISKN,*), IXP(NIXP,*), IXT(NIXT,*),
     .                       IXC(NIXC,*),IXTG(NIXTG,*),KXSP(NISP,*),IPARTSP(*),IPART(LIPART1,*),
     .                       KXX(NIXX,*),IXX(*),IPARTX(*),IXRI(4,*),IXS16(8,*),IXQ(NIXQ,*)
      INTEGER, INTENT(IN) :: IBEAM_VECTOR(NUMELP)
      my_real, INTENT(IN) ::
     .                       x(3,numnod),
     .                        thke(*),thkec(*),sh4ang(*),sh3ang(*)
      my_real, INTENT(IN) :: rbeam_vector(3,numelp)
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, MY_ID, TEMP_INT, NS, MY_MID, MY_PID, MY_NOD, MY_SKEW,NC
      INTEGER :: WORK(70000),NUMEL_KJ
      INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX,ITR1
      CHARACTER(LEN=NCHARTITLE)::TITR
      CHARACTER (LEN=255) :: VARNAME
      DOUBLE PRECISION TEMP_DOUBLE
      INTEGER ITETRA4(4),IPENTA6(6)
      DATA itetra4/2,4,7,6/,ipenta6/2,3,4,6,7,8/
C-----------------------------------------------
C     Elements
C-----------------------------------------------
 
      IF (myqakey('ELEMENTS')) THEN
C
C-----------------------------------------------
C       Solid elements
C-----------------------------------------------
C
        CALL my_alloc(index,2*numels)
        CALL my_alloc(itr1,numels)
C
        DO i=1,numels8
          itr1(i)=ixs(nixs,i)
        ENDDO 
        CALL my_orders(0,work,itr1,index,numels8,1)
        DO i=1,numels8
          ns=index(i)
C
          my_id = ixs(nixs,ns)
          CALL qaprint('A_SOLID_ELEMENT_ID', my_id,0.0_8)
C
          my_mid = ipm(1,ixs(1,ns))
          CALL qaprint('A_SOLID_ELEMENT_MID', my_mid,0.0_8)
C
          my_pid = igeo(1,ixs(10,ns))
          CALL qaprint('A_SOLID_ELEMENT_PID', my_pid,0.0_8)
C
          IF(isolnod(ns)==4)THEN
            DO j=1,4
              IF(ixs(itetra4(j),ns)/=0)THEN
C
C               VARNAME: variable name in ref.extract (without blanks)
C
                my_nod = itab(ixs(itetra4(j),ns))
                WRITE(varname,'(A,I0)') 'NODE_',j
                CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
              END IF
            END DO
          ELSEIF(isolnod(ns)==6)THEN
            DO j=1,6
              IF(ixs(ipenta6(j),ns)/=0)THEN
C
C               VARNAME: variable name in ref.extract (without blanks)
C
                my_nod = itab(ixs(ipenta6(j),ns))
                WRITE(varname,'(A,I0)') 'NODE_',j
                CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
              END IF
            END DO
          ELSEIF(isolnod(ns)==8)THEN
            DO j=2,9
              IF(ixs(j,ns)/=0)THEN
C
C               VARNAME: variable name in ref.extract (without blanks)
C
                my_nod = itab(ixs(j,ns))
                WRITE(varname,'(A,I0)') 'NODE_',j-1
                CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
              END IF
            END DO
          END IF
C
        END DO ! DO I=1,NUMELS8
C
C-----------------------------------------------
C       Tetra10 Elements
C-----------------------------------------------
        DO i=1,numels10
          itr1(i)=ixs(nixs,numels8+i)
        ENDDO 
        CALL my_orders(0,work,itr1,index,numels10,1)
C
        DO i=1,numels10
          ns=index(i)
C
          my_id = ixs(nixs,numels8+ns)
          CALL qaprint('A_TETRA10_ELEMENT_ID', my_id,0.0_8)
C
          my_mid = ipm(1,ixs(1,numels8+ns))
          CALL qaprint('A_TETRA10_ELEMENT_MID', my_mid,0.0_8)
C
          my_pid = igeo(1,ixs(10,numels8+ns))
          CALL qaprint('A_TETRA10_ELEMENT_PID', my_pid,0.0_8)
C
          DO j=1,4
            IF(ixs(itetra4(j),numels8+ns)/=0)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
C
              my_nod = itab(ixs(itetra4(j),numels8+ns))
              WRITE(varname,'(A,I0)') 'NODE_',j
              CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
            END IF
          END DO
C
          DO j=1,6
            IF(ixs10(j,ns)/=0)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
C
              my_nod = itab(ixs10(j,ns))
              WRITE(varname,'(A,I0)') 'NODE_',j+4
              CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
            END IF
          END DO
C
        END DO ! DO I=1,NUMELS10
C-----------------------------------------------
C       Shell16 elements
C-----------------------------------------------
        DO i=1,numels16
          itr1(i)=ixs(nixs,numels8+numels10+numels20+i)
        ENDDO 
        CALL my_orders(0,work,itr1,index,numels16,1)
C
        DO i=1,numels16
          ns=index(i)
C
          my_id = ixs(nixs,numels8+numels10+numels20+ns)
          CALL qaprint('A_SHEL16_ELEMENT_ID', my_id,0.0_8)
C
          my_mid = ipm(1,ixs(1,numels8+numels10+numels20+ns))
          CALL qaprint('A_SHEL16_ELEMENT_MID', my_mid,0.0_8)
C
          my_pid = igeo(1,ixs(10,numels8+numels10+numels20+ns))
          CALL qaprint('A_SHEL16_ELEMENT_PID', my_pid,0.0_8)
C
          DO j=2,9
            IF(ixs(j,numels8+numels10+numels20+ns)/=0)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
C
              my_nod = itab(ixs(j,numels8+numels10+numels20+ns))
              WRITE(varname,'(A,I0)') 'NODE_',j
              CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
            END IF
          END DO
C
          DO j=1,8
            IF(ixs16(j,ns)/=0)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
C
              my_nod = itab(ixs16(j,ns))
              WRITE(varname,'(A,I0)') 'NODE_',j+8
              CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
            END IF
          END DO
C
        END DO ! DO I=1,NUMELS16
 
        DEALLOCATE(index,itr1)
C
C-----------------------------------------------
C       Spring elements
C-----------------------------------------------
C
        CALL my_alloc(index,2*numelr)
        CALL my_alloc(itr1,numelr)
C
        DO i=1,numelr
          itr1(i)=ixr(nixr,i)
        ENDDO 
        CALL my_orders(0,work,itr1,index,numelr,1)
C
        DO i=1,numelr
          ns=index(i)
C
          my_id = ixr(nixr,ns)
          CALL qaprint('A_SPRING_ELEMENT_ID', my_id,0.0_8)
C
          my_mid = 0
          IF (ixr(5,ns) > 0) my_mid = ipm(1,ixr(5,ns))
          CALL qaprint('A_SPRING_ELEMENT_MID', my_mid,0.0_8)
C
          my_pid = igeo(1,ixr(1,ns))
          CALL qaprint('A_SPRING_ELEMENT_PID', my_pid,0.0_8)
C
          DO j=2,3
            IF(ixr(j,ns)/=0)THEN
              my_nod = itab(ixr(j,ns))
              WRITE(varname,'(A,I0)') 'NODE_',j-1
              CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
            END IF
          END DO
C
          IF(ixr(4,ns)/=0)THEN
            my_nod = itab(ixr(4,ns))
            WRITE(varname,'(A,I0)') 'NODE_',3
            CALL qaprint(varname(1:len_trim(varname)), my_nod,0.0_8)
C
            temp_double = x(1,ixr(4,ns))-x(1,ixr(2,ns))
            CALL qaprint('--> vec_n1n3_x', 0,TEMP_DOUBLE)
            TEMP_DOUBLE = X(2,IXR(4,NS))-X(2,IXR(2,NS))
            CALL QAPRINT('--> vec_n1n3_y', 0,TEMP_DOUBLE)
            TEMP_DOUBLE = X(3,IXR(4,NS))-X(3,IXR(2,NS))
            CALL QAPRINT('--> vec_n1n3_z', 0,TEMP_DOUBLE)
          END IF
C
          IF(R_SKEW(NS)/=0)THEN
            MY_SKEW = ISKWN(4,R_SKEW(NS))
            WRITE(VARNAME,'(a,i0)') 'skew_',J-1
            CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_SKEW,0.0_8)
          END IF
C
        END DO ! DO I=1,NUMELR
C
        DEALLOCATE(INDEX,ITR1)
C
C-----  Additional output of IXR_KJ for kjoints
C
        IF (NUMELR > 0) THEN
C
          NUMEL_KJ = IXR_KJ(1,NUMELR+1)
          CALL MY_ALLOC(INDEX,2*NUMEL_KJ)
          CALL MY_ALLOC(ITR1,NUMEL_KJ)
C
          DO I=1,NUMEL_KJ
            ITR1(I)=IXR_KJ(4,I)
          ENDDO 
          CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMEL_KJ,1)
C
          DO I=1,NUMEL_KJ
            NS=INDEX(I)
C
            DO J=1,3
              IF(IXR_KJ(J,NS)/=0)THEN
                MY_NOD = ITAB(IXR_KJ(J,NS))
                WRITE(VARNAME,'(a,x,i0,x,a,i0)') 'kjoint_id',IXR_KJ(4,NS),'additional_node_',3+J
                CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
              END IF
            END DO
C
          ENDDO
C
          DEALLOCATE(INDEX,ITR1)
C
        ENDIF
C
C-----------------------------------------------
C       Beam elements
C-----------------------------------------------
C
        CALL MY_ALLOC(INDEX,2*NUMELP)
        CALL MY_ALLOC(ITR1,NUMELP)
C
        DO I=1,NUMELP
          ITR1(I)=IXP(NIXP,I)
        ENDDO 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELP,1)
C
        DO I=1,NUMELP
          NS=INDEX(I)
C
          MY_ID = IXP(NIXP,NS)
          CALL QAPRINT('a_beam_element_id', MY_ID,0.0_8)
C
          MY_MID = IPM(1,IXP(1,NS))
          CALL QAPRINT('a_beam_element_mid', MY_MID,0.0_8)
C
          MY_PID = IGEO(1,IXP(5,NS))
          CALL QAPRINT('a_beam_element_pid', MY_PID,0.0_8)
C
          DO J=2,3
            IF(IXP(J,NS)/=0)THEN
              MY_NOD = ITAB(IXP(J,NS))
              WRITE(VARNAME,'(a,i0)') 'node_',J-1
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
            END IF
          END DO
C
          IF (IBEAM_VECTOR(NS) == 1) THEN
            TEMP_DOUBLE = RBEAM_VECTOR(1,NS)
            CALL QAPRINT('--> input_vec_x', 0,TEMP_DOUBLE)
            TEMP_DOUBLE = RBEAM_VECTOR(2,NS)
            CALL QAPRINT('--> input_vec_y', 0,TEMP_DOUBLE)
            TEMP_DOUBLE = RBEAM_VECTOR(3,NS)
            CALL QAPRINT('--> input_vec_z', 0,TEMP_DOUBLE)
          ELSEIF(IXP(4,NS)/=0)THEN
            MY_NOD = ITAB(IXP(4,NS))
            WRITE(VARNAME,'(a,i0)') 'node_',J-1
            CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
C
            TEMP_DOUBLE = X(1,IXP(4,NS))-X(1,IXP(2,NS))
            CALL QAPRINT('--> vec_n1n3_x', 0,TEMP_DOUBLE)
            TEMP_DOUBLE = X(2,IXP(4,NS))-X(2,IXP(2,NS))
            CALL QAPRINT('--> vec_n1n3_y', 0,TEMP_DOUBLE)
            TEMP_DOUBLE = X(3,IXP(4,NS))-X(3,IXP(2,NS))
            CALL QAPRINT('--> vec_n1n3_z', 0,TEMP_DOUBLE)
          END IF
C
        END DO ! DO I=1,NUMELP
C
        DEALLOCATE(INDEX,ITR1)
C
C-----------------------------------------------
C       Truss elements
C-----------------------------------------------
C
        CALL MY_ALLOC(INDEX,2*NUMELT)
        CALL MY_ALLOC(ITR1,NUMELT)
C
        DO I=1,NUMELT
          ITR1(I)=IXT(NIXT,I)
        ENDDO 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELT,1)
C
        DO I=1,NUMELT
          NS=INDEX(I)
C
          MY_ID = IXT(NIXT,NS)
          CALL QAPRINT('a_truss_element_id', MY_ID,0.0_8)
C
          MY_MID = IPM(1,IXT(1,NS))
          CALL QAPRINT('a_truss_element_mid', MY_MID,0.0_8)
C
          MY_PID = IGEO(1,IXT(4,NS))
          CALL QAPRINT('a_truss_element_pid', MY_PID,0.0_8)
C
          DO J=2,3
            IF(IXT(J,NS)/=0)THEN
              MY_NOD = ITAB(IXT(J,NS))
              WRITE(VARNAME,'(a,i0)') 'node_',J-1
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
            END IF
          END DO
C
        END DO ! DO I=1,NUMELT
C
        DEALLOCATE(INDEX,ITR1)
C
C-----------------------------------------------
C       SHELL elements
C-----------------------------------------------
        CALL MY_ALLOC(INDEX,2*NUMELC)
        CALL MY_ALLOC(ITR1,NUMELC)
C
        DO I=1,NUMELC
          ITR1(I)=IXC(NIXC,I)
        ENDDO 
 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELC,1)
        DO I=1,NUMELC
          NC=INDEX(I)
C
          MY_ID = IXC(NIXC,NC)
          CALL QAPRINT('a_shell_element_id', MY_ID,0.0_8)
C
          MY_MID = IPM(1,IXC(1,NC))
          CALL QAPRINT('a_shell_element_mid', MY_MID,0.0_8)
C
          MY_PID = IGEO(1,IXC(6,NC))
          CALL QAPRINT('a_shell_element_pid', MY_PID,0.0_8)
C
          DO J=1,4
              MY_NOD = ITAB(IXC(J+1,NC))
              WRITE(VARNAME,'(a,i0)') 'node_',J
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
          END DO
C
          WRITE(VARNAME,'(a,i0)') 'thk_'
          TEMP_DOUBLE = THKE(NC)
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)  
C
          WRITE(VARNAME,'(a,i0)') 'angle_'
          TEMP_DOUBLE = SH4ANG(NC)
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE) 
 
        ENDDO 
        DEALLOCATE(INDEX,ITR1)
C-----------------------------------------------
C       QUAD elements
C-----------------------------------------------
        CALL MY_ALLOC(INDEX,2*NUMELQ)
        CALL MY_ALLOC(ITR1,NUMELQ)
C
        DO I=1,NUMELQ
          ITR1(I)=IXQ(NIXQ,I)
        ENDDO 
 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELQ,1)
        DO I=1,NUMELQ
          NC=INDEX(I)
C
          MY_ID = IXQ(NIXQ,NC)
          CALL QAPRINT('a_quad_element_id', MY_ID,0.0_8)
C
          MY_MID = IPM(1,IXQ(1,NC))
          CALL QAPRINT('a_quad_element_mid', MY_MID,0.0_8)
C
          MY_PID = IGEO(1,IXQ(6,NC))
          CALL QAPRINT('a_quad_element_pid', MY_PID,0.0_8)
C
          DO J=1,4
              MY_NOD = ITAB(IXQ(J+1,NC))
              WRITE(VARNAME,'(a,i0)') 'node_',J
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
          END DO
C
        ENDDO 
        DEALLOCATE(INDEX,ITR1)
C-----------------------------------------------
C       SH3N elements
C-----------------------------------------------
        CALL MY_ALLOC(INDEX,2*NUMELTG)
        CALL MY_ALLOC(ITR1,NUMELTG)
C
        DO I=1,NUMELTG
          ITR1(I)=IXTG(NIXTG,I)
        ENDDO 
 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELTG,1)
        DO I=1,NUMELTG
          NC=INDEX(I)
C
          MY_ID = IXTG(NIXTG,NC)
          CALL QAPRINT('a_sh3n_element_id', MY_ID,0.0_8)
C
          MY_MID = IPM(1,IXTG(1,NC))
          CALL QAPRINT('a_sh3n_element_mid', MY_MID,0.0_8)
C
          MY_PID = IGEO(1,IXTG(5,NC))
          CALL QAPRINT('a_sh3n_element_pid', MY_PID,0.0_8)
C
          DO J=1,3
              MY_NOD = ITAB(IXTG(J+1,NC))
              WRITE(VARNAME,'(a,i0)') 'node_',J
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_NOD,0.0_8)
          END DO
C
          WRITE(VARNAME,'(a,i0)') 'thk_'
          TEMP_DOUBLE = THKEC(NC)
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)  
C
          WRITE(VARNAME,'(a,i0)') 'angle_'
          TEMP_DOUBLE = SH3ANG(NC)
          CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE) 
 
        ENDDO 
        DEALLOCATE(INDEX,ITR1)
C
C-----------------------------------------------
C       Sph elements
C-----------------------------------------------
        CALL MY_ALLOC(INDEX,2*NUMSPH)
        CALL MY_ALLOC(ITR1,NUMSPH)
C
        DO I=1,NUMSPH
          ITR1(I)=KXSP(NISP,I)
        ENDDO 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMSPH,1)
C
        DO I=1,NUMSPH
C
          NS=INDEX(I)
C
          MY_ID = KXSP(NISP,NS)
          CALL QAPRINT('a_sph_cell_element_id', MY_ID,0.0_8)
C
          MY_ID = IPARTSP(NS)
          CALL QAPRINT('a_sph_cell_part_id', MY_ID,0.0_8)
 
          MY_MID = IPART(1,IPARTSP(NS))
          CALL QAPRINT('a_sph_cell_mid', MY_MID,0.0_8)
C
          MY_PID = IGEO(1,IPART(2,IPARTSP(NS)))
          CALL QAPRINT('a_sph_cell_pid', MY_PID,0.0_8)
C
          DO J=2,7
            MY_ID = KXSP(J,NS)
            IF (MY_ID /= 0) THEN
              WRITE(VARNAME,'(a,i0)') 'kxsp_',J
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_ID,0.0_8)
            ENDIF
          ENDDO
C
        ENDDO
        DEALLOCATE(INDEX,ITR1)
C-----------------------------------------------
C       Xelem elements
C-----------------------------------------------
        CALL MY_ALLOC(INDEX,2*NUMELX)
        CALL MY_ALLOC(ITR1,NUMELX)
C
        DO I=1,NUMELX
          ITR1(I)=KXX(NIXX,I)
        ENDDO 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NUMELX,1)
C
        DO I=1,NUMELX
C
          NS=INDEX(I)
C
          MY_ID = KXX(NIXX,NS)
          CALL QAPRINT('a_xelem_element_id', MY_ID,0.0_8)
C
          MY_ID = IPARTX(NS)
          CALL QAPRINT('a_xelem_part_id', MY_ID,0.0_8)
C
          DO J=1,KXX(3,NS)
            MY_ID = ITAB(IXX(KXX(4,NS)+J-1))
            IF (MY_ID /= 0) THEN
              WRITE(VARNAME,'(a,i0)') 'ixx_',KXX(4,NS)+J
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_ID,0.0_8)
            ENDIF
          ENDDO
C
        ENDDO
        DEALLOCATE(INDEX,ITR1)
C-----------------------------------------------
C       Rivet elements
C-----------------------------------------------
        CALL MY_ALLOC(INDEX,2*NRIVET)
        CALL MY_ALLOC(ITR1,NRIVET)
C
        DO I=1,NRIVET
          ITR1(I)=IXRI(4,I)
        ENDDO 
        CALL MY_ORDERS(0,WORK,ITR1,INDEX,NRIVET,1)
C
        DO I=1,NRIVET
C
          NS=INDEX(I)
C
          MY_ID = IXRI(4,NS)
          CALL QAPRINT('a_rivet_element_id', MY_ID,0.0_8)
C
          MY_ID = IGEO(1,IXRI(1,NS))
          CALL QAPRINT('a_rivet_pid', MY_ID,0.0_8)
C
          DO J=1,2
            MY_ID = ITAB(IXRI(J+1,NS))
            IF (MY_ID /= 0) THEN
              WRITE(VARNAME,'(a,i0)') 'ixri_',J
              CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), MY_ID,0.0_8)
            ENDIF
          ENDDO
C
        ENDDO
        DEALLOCATE(INDEX,ITR1)
C-----------------------------------------------
      END IF
C-----------------------------------------------
      RETURN
      END