st_qaprint_materials.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_materials   ../starter/source/output/qaprint/st_qaprint_materials.F
!||--- called by ------------------------------------------------------
!||    st_qaprint_driver      ../starter/source/output/qaprint/st_qaprint_driver.F
!||--- calls      -----------------------------------------------------
!||    fretitl2               ../starter/source/starter/freform.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE st_qaprint_materials(MAT_ELEM    ,IPM       ,PM        ,BUFMAT    )
C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE qa_out_mod
      USE mat_elem_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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IPM(NPROPMI,NUMMAT)
      my_real, INTENT(IN) ::
     .                       pm(npropm,nummat), bufmat(*)
      TYPE(mat_elem_) ,INTENT(IN) :: MAT_ELEM
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,IP, MY_ID,MY_MAT,IADBUF,NUPARAM,NIPARAM,NFAIL,IVISC,IVAR,
     .        IRUPT,FAIL_ID,FAIL_IP,NUVAR,NFUNCF,NTABF,NMOD,NBMAT,MID
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER (LEN=255) :: VARNAME
      DOUBLE PRECISION TEMP_DOUBLE,PTHK
      LOGICAL :: OK_QA
C-----------------------------------------------
      ok_qa = myqakey('MATERIALS')
      IF (ok_qa) THEN
        DO my_mat=1,nummat-1 ! Do not write global material
          CALL fretitl2(titr,ipm(npropmi-ltitr+1,my_mat),ltitr)
          titr = mat_elem%MAT_PARAM(my_mat)%TITLE
 
C         Le Titr du MAT sert de nom de la variable dans le ref.extract , suivi de l'ID du MAT 
C         2 MATs peuvent avoir le meme titre
          IF(len_trim(titr)/=0)THEN
            CALL qaprint(titr(1:len_trim(titr)),ipm(1,my_mat),0.0_8)
          ELSE
            CALL qaprint('A_MAT_FAKE_NAME',ipm(1,my_mat),0.0_8)
          END IF
          DO i=1,npropmi-ltitr ! si on ne peut pas tester une chaine de caracteres, do i=1,npropmi
            IF(ipm(i,my_mat) /=0)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'IPM_',i      ! IPM(11) => 'IPM_11'
              CALL qaprint(varname(1:len_trim(varname)),ipm(i,my_mat),0.0_8)
            END IF
          END DO
          DO i=1,npropm
            IF(pm(i,my_mat)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'PM_',i
              temp_double = pm(i,my_mat)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
          iadbuf =ipm(7,my_mat)
          nuparam=ipm(9,my_mat)
          DO i=1,nuparam
            IF(bufmat(iadbuf+i-1)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'BUFMAT_',i
              temp_double = bufmat(iadbuf+i-1)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
c-----------------------------
c         MATERIAL FAILURE MODELS 
c-----------------------------
          nfail = mat_elem%MAT_PARAM(my_mat)%NFAIL
          IF (nfail > 0) THEN
            CALL qaprint('NUMBER OF FAILURE MODELS',nfail,0.0_8)
c
            DO i=1,nfail
              irupt   = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%IRUPT
              fail_id = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%FAIL_ID
              nuparam = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NUPARAM
              niparam = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NIPARAM
              nuvar   = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NUVAR
              nfuncf  = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NFUNC
              ntabf   = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NTABLE
              nmod    = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%NMOD
              fail_ip = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%FAIL_IP
              pthk    = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%PTHK
c
              CALL qaprint(' FAIL MODEL TYPE',irupt,0.0_8)
              CALL qaprint(' FAIL_ID',fail_id,0.0_8)
              CALL qaprint(' FAIL_IP',fail_ip,0.0_8)
              CALL qaprint(' PTHK',0,pthk)
              CALL qaprint(' NUMBER OF STATE VARIABLES',nuvar,0.0_8)
              CALL qaprint(' NUMBER OF FAILURE MODES',nmod,0.0_8)
c
              CALL qaprint(' NUPARAM',nuparam,0.0_8)
              DO j=1,nuparam
                temp_double = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%UPARAM(j)
                IF (temp_double /= zero) THEN
                  WRITE(varname,'(A,I0,A,I0)') 'UPARF_',i,'_',j
                  CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
                END IF
              END DO
              CALL qaprint(' NIPARAM',niparam,0.0_8)
              DO j=1,niparam
                ivar = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%IPARAM(j)   
                IF (ivar /= 0) THEN
                  WRITE(varname,'(A,I0)') 'IPARF_',j
                  CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
                END IF
              END DO
              CALL qaprint(' NFUNC',nfuncf,0.0_8)
              DO j=1,nfuncf
                ivar = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%IFUNC(j)   
                IF (ivar /= 0) THEN
                  WRITE(varname,'(A,I0)') 'IFUNC_',j
                  CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
                END IF
              END DO
              CALL qaprint(' NTABLE',ntabf,0.0_8)
              DO j=1,ntabf
                ivar = mat_elem%MAT_PARAM(my_mat)%FAIL(i)%TABLE(j)   
                IF (ivar /= 0) THEN
                  WRITE(varname,'(A,I0)') 'TABLE_',j
                  CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
                END IF
              END DO
            END DO    ! NFAIL
          END IF      ! NFAIL > 0
c-----------------------------
c         UPARAM of /VISC
c-----------------------------
          ivisc = mat_elem%MAT_PARAM(my_mat)%IVISC
          IF (ivisc > 0) THEN
            CALL qaprint('** VISC_MODEL',i,0.0_8)
            nuparam = mat_elem%MAT_PARAM(my_mat)%VISC%NUPARAM
            niparam = mat_elem%MAT_PARAM(my_mat)%VISC%NIPARAM
            DO j=1,nuparam
              temp_double = mat_elem%MAT_PARAM(my_mat)%VISC%UPARAM(j)
              IF (temp_double /= zero) THEN
                WRITE(varname,'(A,I0)') 'UPARV_',j
                CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
              END IF
            END DO
            DO j=1,niparam
              ivar = mat_elem%MAT_PARAM(my_mat)%VISC%IPARAM(j)
              IF (ivar /= 0) THEN
                WRITE(varname,'(A,I0)') 'IPARV_',j
                CALL qaprint(varname(1:len_trim(varname)),ivar,0.0_8)
              END IF
            END DO
          END IF
          
c-----------------------------
c         MULTIMAT
c-----------------------------
          nbmat = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%NB
          IF (nbmat > 0) THEN
            DO j=1,nbmat
              mid   = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%MID(j)
              temp_double = mat_elem%MAT_PARAM(my_mat)%MULTIMAT%VFRAC(j)
              IF (temp_double /= zero) THEN
                WRITE(varname,'(A,I0)') 'MID_',j
                CALL qaprint(varname(1:len_trim(varname)),mid,0.0_8)              
                WRITE(varname,'(A,I0)') 'VFRAC_',j
                CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
              END IF
            END DO
          END IF   
                 
c-----------------------------
        END DO   ! MY_MAT
      END IF
C-----------------------------------------------------------------------
      RETURN
      END