st_qaprint_dfs_detonators.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_dfs_detonators (detonators)

Function/Subroutine Documentation

st_qaprint_dfs_detonators()

subroutine st_qaprint_dfs_detonators

(

type(detonators_struct_), intent(in)

detonators

)

Definition at line 31 of file st_qaprint_dfs_detonators.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE qa_out_mod
        USE groupdef_mod
        USE detonators_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        TYPE(DETONATORS_STRUCT_), INTENT(IN) :: DETONATORS
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: OK_QA
      CHARACTER (LEN=255) :: VARNAME
      INTEGER K
      DOUBLE PRECISION TEMP_DOUBLE
      INTEGER TEMP_INTEGER
      INTEGER :: NDETPS,NDETSG,NECRAN,NDETPL,NDETCORD
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      ok_qa = myqakey('DETONATORS')  
 
      ndetps = detonators%N_DET_POINT
      ndetsg = detonators%N_DET_LINE
      necran = detonators%N_DET_WAVE_SHAPER
      ndetpl = detonators%N_DET_PLANE
      ndetcord = detonators%N_DET_CORD
                                                         
      IF (ok_qa) THEN                                                                   
 
        !/DFS/DETPOINT                           
        DO k=1,ndetps
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__ISHADOW_'
            temp_integer = detonators%POINT(k)%SHADOW
            IF(temp_integer > 0)CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__MAT_'
            temp_integer = detonators%POINT(k)%MAT
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__TDET_'
            temp_double = detonators%POINT(k)%TDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)              
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__XDET_'
            temp_double = detonators%POINT(k)%XDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__YDET_'
            temp_double = detonators%POINT(k)%YDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__ZDET_'
            temp_double = detonators%POINT(k)%ZDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__GRNOD_ID_'
            temp_integer = detonators%POINT(k)%GRNOD_ID
            IF(temp_integer > 0)CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
        ENDDO !next K                                                                   
 
        !/DFS/DETLINE
        DO k=1,ndetsg
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__MAT_'
            temp_integer = detonators%LINE(k)%MAT
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__TDET_'
            temp_double = detonators%LINE(k)%TDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__XDET_1_'
            temp_double = detonators%LINE(k)%XDET_1
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__YDET_1_'
            temp_double = detonators%LINE(k)%YDET_1
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__ZDET_1_'
            temp_double = detonators%LINE(k)%ZDET_1
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__XDET_2_'
            temp_double = detonators%LINE(k)%XDET_2
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__YDET_2_'
            temp_double = detonators%LINE(k)%YDET_2
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__ZDET_2_'
            temp_double = detonators%LINE(k)%ZDET_2
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
        ENDDO !next K   
 
        !/DFS/WAV_SHA
        DO k=1,necran
            WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__MAT_'
            temp_integer = detonators%WAVE_SHAPER(k)%MAT
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__NUMNOD_'
            temp_integer = detonators%WAVE_SHAPER(k)%NUMNOD
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__vdet_'
            TEMP_DOUBLE = DETONATORS%WAVE_SHAPER(K)%VDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_wavsha_',K ,'__tdet_'
            TEMP_DOUBLE = DETONATORS%WAVE_SHAPER(K)%TDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_wavsha_',K ,'__xdet_'
            TEMP_DOUBLE = DETONATORS%WAVE_SHAPER(K)%XDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_wavsha_',K ,'__ydet_'
            TEMP_DOUBLE = DETONATORS%WAVE_SHAPER(K)%YDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_wavsha_',K ,'__zdet_'
            TEMP_DOUBLE = DETONATORS%WAVE_SHAPER(K)%ZDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
        ENDDO !next K          
 
        !/DFS/DETPLAN
        DO K=1,NDETPL
            WRITE(VARNAME,'(a,i0,a)') 'dfs_detplane_',K ,'__mat_'
            TEMP_INTEGER = DETONATORS%PLANE(K)%MAT
            CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_detplane_',K ,'__tdet_'
            TEMP_DOUBLE = DETONATORS%PLANE(K)%TDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_detplane_',K ,'__xdet_'
            TEMP_DOUBLE = DETONATORS%PLANE(K)%XDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_detplane_',K ,'__ydet_'
            TEMP_DOUBLE = DETONATORS%PLANE(K)%YDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'dfs_detplane_',K ,'__zdet_'
            TEMP_DOUBLE = DETONATORS%PLANE(K)%ZDET
            IF(TEMP_DOUBLE/=ZERO)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
 
            WRITE(VARNAME,'(a,i0,a)') 'DFS_DETPLANE_',k ,'__NX_'
            temp_double = detonators%PLANE(k)%NX
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__NY_'
            temp_double = detonators%PLANE(k)%NY
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__NZ_'
            temp_double = detonators%PLANE(k)%NZ
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
        ENDDO !next K          
 
        !/DFS/DETCORD
        DO k=1,ndetcord
            WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__MAT_'
            temp_integer = detonators%CORD(k)%MAT
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__IOPT_'
            temp_integer = detonators%CORD(k)%IOPT
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__NUMNOD_'
            temp_integer = detonators%CORD(k)%NUMNOD
            CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__TDET_'
            temp_double = detonators%CORD(k)%TDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
 
            WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__VDET_'
            temp_double = detonators%CORD(k)%VDET
            IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
        ENDDO !next K  
                
      ENDIF                                                                             
C-----------------------------------------------
        RETURN