st_qaprint_output_databases.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_output_databases (nom_opt, inom_opt, laccelm, accelm, lgauge, gauge)

Function/Subroutine Documentation

st_qaprint_output_databases()

subroutine st_qaprint_output_databases	(	integer, dimension(lnopt1,snom_opt1), intent(in)	nom_opt,
		integer, dimension(sinom_opt), intent(in)	inom_opt,
		integer, dimension(3, naccelm), intent(in)	laccelm,
		dimension(llaccelm, naccelm), intent(in)	accelm,
		integer, dimension(3,nbgauge), intent(in)	lgauge,
		dimension(llgauge,nbgauge), intent(in)	gauge )

Definition at line 31 of file st_qaprint_output_databases.F.

C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE qa_out_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"
#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)
      INTEGER, INTENT(IN) :: LACCELM(3, NACCELM)
      my_real, INTENT(IN) :: accelm(llaccelm, naccelm)
      INTEGER, INTENT(IN) :: LGAUGE(3,NBGAUGE)
      my_real, INTENT(IN) :: gauge(llgauge,nbgauge)
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, ID, II, TEMP_INT
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER (LEN=255) :: VARNAME
      DOUBLE PRECISION TEMP_DOUBLE
      LOGICAL :: OK_QA
C-----------------------------------------------
C     /DAMP
C-----------------------------------------------
      ok_qa = myqakey('/ACCEL')
      IF (ok_qa) THEN
        DO ii = 1, naccelm
C
          titr(1:nchartitle)=''
          id = nom_opt(1, inom_opt(1) + ii)
          CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1, inom_opt(1) + ii), ltitr)
          IF(len_trim(titr)/=0)THEN
            CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
          ELSE
            CALL qaprint('A_ACCEL_FAKE_NAME', id,0.0_8)
          END IF
C     
          DO i = 1, 3
             WRITE(varname,'(A,I0,A,I0)') 'IACCEL_',id,'_',i
             temp_int = laccelm(i,ii)
             CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
          ENDDO
          DO i = 1, llaccelm
             WRITE(varname,'(A,I0,A,I0)') 'RACCEL_',id,'_',i
             temp_double = accelm(i,ii)
             CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
          END DO
C
        END DO 
      END IF
C-----------------------------------------------
C     /GAUGE
C-----------------------------------------------
      IF (myqakey('/GAUGE')) THEN
C       
       IF (nbgauge > 0) THEN 
        DO ii = 1, nbgauge
          titr(1:nchartitle)=''
          id = nom_opt(1, inom_opt(27) + ii)
          CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1, inom_opt(27) + ii), ltitr)
          IF(len_trim(titr)/=0)THEN
            CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
          ELSE
            CALL qaprint('A_GAUGE_FAKE_NAME', id,0.0_8)
          END IF     
          DO i = 1, 3
           IF(lgauge(i,ii) /=0)THEN
             WRITE(varname,'(A,I0,A,I0)') 'LGAUGE_',i,'_',ii
             temp_int = lgauge(i,ii)
             CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
           ENDIF
          ENDDO
          DO i = 1, llgauge
           IF(gauge(i,ii) /=0)THEN
             WRITE(varname,'(A,I0,A,I0)') 'GAUGE_',i,'_',ii
             temp_double = gauge(i,ii)
             CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
           ENDIF
          END DO
        END DO 
       END IF
      END IF
 
C-----------------------------------------------
      RETURN