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