st_qaprint_clusters.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_clusters (nom_opt, inom_opt, clusters)

Function/Subroutine Documentation

st_qaprint_clusters()

subroutine st_qaprint_clusters	(	integer, dimension(lnopt1,snom_opt1), intent(in)	nom_opt,
		integer, dimension(sinom_opt), intent(in)	inom_opt,
		type (cluster_), dimension(ncluster)	clusters )

Definition at line 32 of file st_qaprint_clusters.F.

C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE qa_out_mod
      USE cluster_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      "scr17_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
      TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
C-----------------------------------------------
C      NOM_OPT(LNOPT1,SNOM_OPT1) 
C         * Possibly, NOM_OPT(1) = ID
C        NOM_OPT(LNOPT1-LTITL+1:LTITL) <=> TITLES of the OPTIONS
C--------------------------------------------------
C      SNOM_OPT1= NRBODY+NACCELM+NVOLU+NINTER+NINTSUB+
C     +           NRWALL+NJOINT+NSECT+NLINK+
C     +           NUMSKW+1+NUMFRAM+1+NFXBODY+NFLOW+NRBE2+
C     +           NRBE3+NSUBMOD+NFXVEL+NUMBCS+NUMMPC+
C     +           NGJOINT+NUNIT0+NFUNCT+NADMESH+
C     +           NSPHIO+NSPCOND+NRBYKIN+NEBCS+
C     +           NINICRACK+NODMAS+NBGAUGE+NCLUSTER+NINTERFRIC+
C     +           NRBMERGE
C-----------------------------------------------
C      INOM_OPT(SINOM_OPT)
C--------------------------------------------------
C      INOM_OPT(1) = NRBODY
C      INOM_OPT(2) = INOM_OPT(1) + NACCELM
C      INOM_OPT(3) = INOM_OPT(2) + NVOLU
C      INOM_OPT(4) = INOM_OPT(3) + NINTER
C      INOM_OPT(5) = INOM_OPT(4) + NINTSUB
C      INOM_OPT(6) = INOM_OPT(5) + NRWALL
C      INOM_OPT(7) = INOM_OPT(6) 
C      INOM_OPT(8) = INOM_OPT(7) + NJOINT
C      INOM_OPT(9) = INOM_OPT(8) + NSECT
C      INOM_OPT(10)= INOM_OPT(9) + NLINK
C      INOM_OPT(11)= INOM_OPT(10)+ NUMSKW+1+NUMFRAM+1+NSUBMOD
C      INOM_OPT(12)= INOM_OPT(11)+ NFXBODY
C      INOM_OPT(13)= INOM_OPT(12)+ NFLOW
C      INOM_OPT(14)= INOM_OPT(13)+ NRBE2
C      INOM_OPT(15)= INOM_OPT(14)+ NRBE3
C      INOM_OPT(16)= INOM_OPT(15)+ NFXVEL
C      INOM_OPT(17)= INOM_OPT(16)+ NUMBCS
C      INOM_OPT(18)= INOM_OPT(17)+ NUMMPC
C      INOM_OPT(19)= INOM_OPT(18)+ NGJOINT
C      INOM_OPT(20)= INOM_OPT(19)+ NUNIT0
C      INOM_OPT(21)= INOM_OPT(20)+ NFUNCT
C      INOM_OPT(22)= INOM_OPT(21)+ NADMESH
C      INOM_OPT(23)= INOM_OPT(22)+ NSPHIO
C      INOM_OPT(24)= INOM_OPT(23)+ NSPCOND
C      INOM_OPT(25)= INOM_OPT(24)+ NEBCS
C      INOM_OPT(26)= INOM_OPT(25)+ NINICRACK
C      INOM_OPT(27)= INOM_OPT(26)+ NODMAS
C      INOM_OPT(28)= INOM_OPT(27)+ NBGAUGE
C      INOM_OPT(29)= INOM_OPT(28)+ NCLUSTER
C      INOM_OPT(30)= INOM_OPT(29)+ NINTERFRIC
C      INOM_OPT(31)= INOM_OPT(30)+ NRBMERGE
C      .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
C-----------------------------------------------
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, MY_ID, MY_CLUSTER, TEMP_INT
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER (LEN=255) :: VARNAME
      DOUBLE PRECISION TEMP_DOUBLE
C-----------------------------------------------
C     /CLUSTER
C-----------------------------------------------
      IF (myqakey('/CLUSTER')) THEN
        DO my_cluster=1,ncluster
C        
          titr(1:nchartitle)=''
          my_id = clusters(my_cluster)%ID
          CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(28) + my_cluster),ltitr)
          IF(len_trim(titr)/=0)THEN
            CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
          ELSE
            CALL qaprint('A_CLUSTER_FAKE_NAME', my_id,0.0_8)
          END IF
C
          WRITE(varname,'(A)') 'CLUSTER_ELGROUP'
          temp_int = clusters(my_cluster)%IGR
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          WRITE(varname,'(A)') 'CLUSTER_TYPE'
          temp_int = clusters(my_cluster)%TYPE
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          WRITE(varname,'(A)') 'CLUSTER_SKEW'
          temp_int = clusters(my_cluster)%SKEW
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          WRITE(varname,'(A)') 'CLUSTER_NEL'
          temp_int = clusters(my_cluster)%NEL
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          DO i = 1, clusters(my_cluster)%NEL
             WRITE(varname,'(A,I0)') 'CLUSTER_ELEM_',i
             temp_int = clusters(my_cluster)%ELEM(i)
             CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)                         
          ENDDO
C
          WRITE(varname,'(A)') 'CLUSTER_IFAIL'
          temp_int = clusters(my_cluster)%IFAIL
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          WRITE(varname,'(A)') 'CLUSTER_OFF'
          temp_int = clusters(my_cluster)%OFF
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          WRITE(varname,'(A)') 'CLUSTER_FAIL'
          temp_double = clusters(my_cluster)%FAIL
          CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
C
          WRITE(varname,'(A)') 'CLUSTER_NNOD'
          temp_int = clusters(my_cluster)%NNOD
          CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
C
          DO i = 1, clusters(my_cluster)%NNOD
             WRITE(varname,'(A,I0)') 'CLUSTER_NNOD1_',i
             temp_int = clusters(my_cluster)%NOD1(i)
             CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)                         
          ENDDO
C
          DO i = 1, clusters(my_cluster)%NNOD
             WRITE(varname,'(A,I0)') 'CLUSTER_NNOD2_',i
             temp_int = clusters(my_cluster)%NOD2(i)
             CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)                         
          ENDDO
C
          DO i = 1,2
            WRITE(varname,'(A,I0)') 'CLUSTER_FMAX',i
            temp_double = clusters(my_cluster)%FMAX(i)
            CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
          ENDDO
C
          DO i = 1,2
            WRITE(varname,'(A,I0)') 'CLUSTER_MMAX',i
            temp_double = clusters(my_cluster)%MMAX(i)
            CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
          ENDDO
C
          IF (clusters(my_cluster)%IFAIL == 3) THEN
C
            DO i = 1,4
              WRITE(varname,'(A,I0)') 'CLUSTER_AX',i
              temp_double = clusters(my_cluster)%AX(i)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            ENDDO
C            
            DO i = 1,4
              WRITE(varname,'(A,I0)') 'CLUSTER_NX',i
              temp_double = clusters(my_cluster)%NX(i)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            ENDDO
C          
          ENDIF
C
        END DO
      END IF
C-----------------------------------------------
      RETURN