st_qaprint_admesh.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_admesh (ipart, ipadmesh, padmesh, sh4tree, sh3tree, ixc, ixtg, sh4trim, sh3trim)

Function/Subroutine Documentation

st_qaprint_admesh()

subroutine st_qaprint_admesh	(	integer, dimension(lipart1,*), intent(in)	ipart,
		integer, dimension(kipadmesh,*), intent(in)	ipadmesh,
		dimension(kpadmesh,*), intent(in)	padmesh,
		integer, dimension(ksh4tree,*), intent(in)	sh4tree,
		integer, dimension(ksh3tree,*), intent(in)	sh3tree,
		integer, dimension(nixc,*), intent(in)	ixc,
		integer, dimension(nixtg,*), intent(in)	ixtg,
		integer, dimension(*), intent(in)	sh4trim,
		integer, dimension(*), intent(in)	sh3trim )

Definition at line 30 of file st_qaprint_admesh.F.

C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE qa_out_mod
      USE names_and_titles_mod , ONLY : nchartitle
      use element_mod , only :nixc,nixtg
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      "remesh_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IPART(LIPART1,*), IPADMESH(KIPADMESH,*)
      INTEGER, INTENT(IN) :: SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
     .                       SH4TRIM(*),SH3TRIM(*) ,IXC(NIXC,*), IXTG(NIXTG,*)
      my_real, INTENT(IN) :: padmesh(kpadmesh,*)
 
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, MY_ID, N , IP
      CHARACTER (LEN=255) :: VARNAME
      DOUBLE PRECISION TEMP_DOUBLE
C-----------------------------------------------
C     /ADMESH
C-----------------------------------------------
      IF (myqakey('ADMESH')) THEN
 
        IF (nadmesh > 0) THEN    
 
          WRITE(varname,'(A)') 'NADMESH'
          CALL qaprint(varname(1:len_trim(varname)),nadmesh,0.0_8)
          
          IF(levelmax /= 0) THEN
             WRITE(varname,'(A)') 'LEVELMAX'
             CALL qaprint(varname(1:len_trim(varname)),levelmax,0.0_8)
          ENDIF
 
          IF(iadmrule /= 0) THEN
             WRITE(varname,'(A)') 'IADMRULE'
             CALL qaprint(varname(1:len_trim(varname)),iadmrule,0.0_8)
          ENDIF
 
          IF(iadmstat /= 0) THEN
             WRITE(varname,'(A)') 'IADMSTAT'
             CALL qaprint(varname(1:len_trim(varname)),iadmstat,0.0_8)
          ENDIF
 
          IF(istatcnd /= 0) THEN
             WRITE(varname,'(A)') 'ISTATCND'
             CALL qaprint(varname(1:len_trim(varname)),istatcnd,0.0_8)
          ENDIF
 
          IF(iadmerrt /= 0) THEN
             WRITE(varname,'(A)') 'IADMERRT'
             CALL qaprint(varname(1:len_trim(varname)),iadmerrt,0.0_8)
          ENDIF
 
          IF(dtadmesh /= zero) THEN
            WRITE(varname,'(A)') 'DTADMESH'
            temp_double = dtadmesh
            CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
          ENDIF
 
          IF(tadmesh /= zero) THEN
            WRITE(varname,'(A)') 'TADMESH'
            temp_double = tadmesh
            CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
          ENDIF
 
 
          DO ip=1,npart
C
             my_id = ipart(4,ip)
             IF(ipart(10,ip) /= 0) THEN
C
                CALL qaprint('PART_ID_ADMESH_', my_id,0.0_8)
C
                CALL qaprint('LEVELMAX',ipart(10,ip),0.0_8)
C
                DO i=1,kipadmesh
                   WRITE(varname,'(A,I0)') 'IPADMESH_',i
                   IF(ipadmesh(i,ip)/= 0) CALL qaprint(varname(1:len_trim(varname)),ipadmesh(i,ip),0.0_8)
                ENDDO
C
                DO i=1,kpadmesh
                    WRITE(varname,'(A,I0)') 'PADMESH_',i
                    temp_double = padmesh(i,ip)
                    IF(temp_double/= zero) CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
                ENDDO
             ENDIF
C
          ENDDO
C
          DO n=1,numelc
             CALL qaprint('ELEM_ADMESH_4N_ID_', ixc(nixc,n),0.0_8)
             DO i=1,ksh4tree
                WRITE(varname,'(A,I0)') 'SH4TREE_',i
                 IF(sh4tree(i,n)/= 0)CALL qaprint(varname(1:len_trim(varname)),sh4tree(i,n),0.0_8)
             ENDDO
           ENDDO
C
          DO n=1,numeltg
             CALL qaprint('ELEM_ADMESH_3N_ID_', ixtg(nixtg,n),0.0_8)
             DO i=1,ksh3tree
                WRITE(varname,'(A,I0)') 'SH3TREE_',i
                 IF(sh3tree(i,n)/= 0)CALL qaprint(varname(1:len_trim(varname)),sh3tree(i,n),0.0_8)
             ENDDO
           ENDDO
 
          IF(iadmstat/=0)THEN
 
            DO n=1,lsh4trim 
               IF(sh4trim(n)/= 0) THEN
                 CALL qaprint('ELEM_ADMESH_STAT_4N_ID_', ixc(nixc,n),0.0_8)
                 WRITE(varname,'(A,I0)') 'SH4TRIM_',n
                 CALL qaprint(varname(1:len_trim(varname)),sh4trim(n),0.0_8)
               ENDIF
            ENDDO
 
            DO n=1,lsh3trim
               IF(sh3trim(n)/= 0) THEN
                  CALL qaprint('ELEM_ADMESH_STAT_3N_ID_', ixtg(nixtg,n),0.0_8)
                  WRITE(varname,'(A,I0)') 'SH3TRIM_',n
                  CALL qaprint(varname(1:len_trim(varname)),sh3trim(n),0.0_8)
               ENDIF
            ENDDO
 
          ENDIF
 
        ENDIF
 
       ENDIF
C-----------------------------------------------
      RETURN