st_qaprint_seatbelts.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_seatbelts (itab)

Function/Subroutine Documentation

st_qaprint_seatbelts()

subroutine st_qaprint_seatbelts

(

integer, dimension(*), intent(in)

itab

)

Definition at line 30 of file st_qaprint_seatbelts.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE qa_out_mod
        USE seatbelt_mod
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: ITAB(*)
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: OK_QA
      CHARACTER (LEN=255) :: VARNAME
      INTEGER :: I,J
      DOUBLE PRECISION :: TMPVAL
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      IF(nslipring + nretractor == 0)RETURN
C
      ok_qa = myqakey('/SLIPRING')  
C                                                         
      IF (ok_qa) THEN
C   
         DO i = 1, nslipring
C
            CALL qaprint('SLIPRING ID ',slipring(i)%ID,0.0_8)
            CALL qaprint('SLIPRING NFRAM  ',slipring(i)%NFRAM,0.0_8)
            CALL qaprint('SLIPRING FL_FLAG',slipring(i)%FL_FLAG,0.0_8)
            CALL qaprint('SLIPRING SENSID ',slipring(i)%SENSID,0.0_8)
            CALL qaprint('SLIPRING FUNC1 ',slipring(i)%IFUNC(1),0.0_8)
            CALL qaprint('SLIPRING FUNC2 ',slipring(i)%IFUNC(2),0.0_8)
            CALL qaprint('SLIPRING FUNC3 ',slipring(i)%IFUNC(3),0.0_8)
            CALL qaprint('SLIPRING FUNC4 ',slipring(i)%IFUNC(4),0.0_8)
C
            tmpval = slipring(i)%DC
            CALL qaprint('SLIPRING DC FACTOR ',0,tmpval)
            tmpval = slipring(i)%A
            CALL qaprint('SLIPRING A FACTOR ',0,tmpval)
C
            tmpval = slipring(i)%FRIC
            CALL qaprint('SLIPRING FRICD ',0,tmpval)
            tmpval = slipring(i)%FAC_D(1)
            CALL qaprint('SLIPRING FACD1 ',0,tmpval)
            tmpval = slipring(i)%FAC_D(2)
            CALL qaprint('SLIPRING FACD2 ',0,tmpval)
            tmpval = slipring(i)%FAC_D(3)
            CALL qaprint('SLIPRING FACD3 ',0,tmpval)
C
            tmpval = slipring(i)%FRICS
            CALL qaprint('SLIPRING FRICS ',0,tmpval)
            tmpval = slipring(i)%FAC_S(1)
            CALL qaprint('SLIPRING FACS1 ',0,tmpval)
            tmpval = slipring(i)%FAC_S(2)
            CALL qaprint('SLIPRING FACS2 ',0,tmpval)
            tmpval = slipring(i)%FAC_S(3)
            CALL qaprint('SLIPRING FACS3 ',0,tmpval)
C
            DO j=1,slipring(i)%NFRAM
C
              CALL qaprint('SLIPRING N1 ',itab(slipring(i)%FRAM(j)%NODE(1)),0.0_8)
              CALL qaprint('SLIPRING N2 ',itab(slipring(i)%FRAM(j)%NODE(2)),0.0_8)
              CALL qaprint('SLIPRING N3 ',itab(slipring(i)%FRAM(j)%NODE(3)),0.0_8)
              CALL qaprint('SLIPRING ANCHOR ',itab(slipring(i)%FRAM(j)%ANCHOR_NODE),0.0_8)
              IF (slipring(i)%FRAM(j)%ORIENTATION_NODE > 0) THEN
                CALL qaprint('SLIPRING ORIENTATION NODE ',itab(slipring(i)%FRAM(j)%ORIENTATION_NODE),0.0_8)
              ENDIF
              CALL qaprint('SLIPRING DIRECTION1 ',slipring(i)%FRAM(j)%STRAND_DIRECTION(1),0.0_8)
              CALL qaprint('SLIPRING DIRECTION2 ',slipring(i)%FRAM(j)%STRAND_DIRECTION(2),0.0_8)
C
              tmpval = slipring(i)%FRAM(j)%ORIENTATION_ANGLE
              CALL qaprint('SLIPRING ANGLE ',0,tmpval)
C
              tmpval = slipring(i)%FRAM(j)%VECTOR(1)
              CALL qaprint('SLIPRING VECTOR1 ',0,tmpval)
              tmpval = slipring(i)%FRAM(j)%VECTOR(2)
              CALL qaprint('SLIPRING VECTOR2 ',0,tmpval)
              tmpval = slipring(i)%FRAM(j)%VECTOR(3)
              CALL qaprint('SLIPRING VECTOR3 ',0,tmpval)
              tmpval = slipring(i)%FRAM(j)%VECTOR(4)
              CALL qaprint('SLIPRING VECTOR4 ',0,tmpval)
              tmpval = slipring(i)%FRAM(j)%VECTOR(5)
              CALL qaprint('SLIPRING VECTOR5 ',0,tmpval)
              tmpval = slipring(i)%FRAM(j)%VECTOR(6)
              CALL qaprint('SLIPRING VECTOR6 ',0,tmpval)
C
            ENDDO
C
         ENDDO 
      ENDIF
C        
      ok_qa = myqakey('/RETRACTOR')  
C                                                         
      IF (ok_qa) THEN   
         DO i = 1, nretractor
C
            CALL qaprint('RETRACTOR ID ',retractor(i)%ID,0.0_8)
            CALL qaprint('RETRACTOR N1 ',itab(retractor(i)%NODE(1)),0.0_8)
            CALL qaprint('RETRACTOR N2 ',itab(retractor(i)%NODE(2)),0.0_8)
            CALL qaprint('RETRACTOR ANCHOR ',itab(retractor(i)%ANCHOR_NODE),0.0_8)
            CALL qaprint('RETRACTOR DIRECTION ',retractor(i)%STRAND_DIRECTION,0.0_8)
            CALL qaprint('RETRACTOR FUNC1 ',retractor(i)%IFUNC(1),0.0_8)
            CALL qaprint('RETRACTOR FUNC2 ',retractor(i)%IFUNC(2),0.0_8)
            CALL qaprint('RETRACTOR FUNC3 ',retractor(i)%IFUNC(3),0.0_8)
            CALL qaprint('RETRACTOR SENSID1 ',retractor(i)%ISENS(1),0.0_8)
            CALL qaprint('RETRACTOR SENSID2 ',retractor(i)%ISENS(2),0.0_8)
            CALL qaprint('RETRACTOR TENSTYP ',retractor(i)%TENS_TYP,0.0_8)
            CALL qaprint('RETRACTOR INACTIVE NODES ',retractor(i)%INACTI_NNOD,0.0_8)
C
            DO j=1,retractor(i)%INACTI_NNOD
              CALL qaprint('RETRACTOR INACTI NODE ',itab(retractor(i)%INACTI_NODE(j)),0.0_8)
            ENDDO
C
            tmpval = retractor(i)%VECTOR(1)
            CALL qaprint('RETRACTOR VECTOR1 ',0,tmpval)
            tmpval = retractor(i)%VECTOR(2)
            CALL qaprint('RETRACTOR VECTOR2 ',0,tmpval)
            tmpval = retractor(i)%VECTOR(3)
            CALL qaprint('RETRACTOR VECTOR3 ',0,tmpval)
C
            tmpval = retractor(i)%ELEMENT_SIZE
            CALL qaprint('RETRACTOR ELEM SIZE ',0,tmpval)
            tmpval = retractor(i)%FORCE
            CALL qaprint('RETRACTOR FORCE ',0,tmpval)
C
            tmpval = retractor(i)%FAC(1)
            CALL qaprint('RETRACTOR FAC1 ',0,tmpval)
            tmpval = retractor(i)%FAC(2)
            CALL qaprint('RETRACTOR FAC2 ',0,tmpval)
            tmpval = retractor(i)%FAC(3)
            CALL qaprint('RETRACTOR FAC3 ',0,tmpval)
            tmpval = retractor(i)%FAC(4)
            CALL qaprint('RETRACTOR FAC4 ',0,tmpval)
C
            tmpval = retractor(i)%PULLOUT
            CALL qaprint('RETRACTOR PULLOUT ',0,tmpval)
C
         ENDDO 
      ENDIF                                                                        
C-----------------------------------------------
      RETURN