st_qaprint_properties.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	st_qaprint_properties (igeo, geo, bufgeo, pm_stack, geo_stack, igeo_stack)

Function/Subroutine Documentation

st_qaprint_properties()

subroutine st_qaprint_properties	(	integer, dimension(npropgi,numgeo), intent(in)	igeo,
		dimension(npropg,numgeo), intent(in)	geo,
		dimension(*), intent(in)	bufgeo,
		dimension(20,ns_stack), intent(in)	pm_stack,
		dimension(6*npt_stack+1,ns_stack), intent(in)	geo_stack,
		integer, dimension(4* npt_stack+2,ns_stack), intent(in)	igeo_stack )

Definition at line 31 of file st_qaprint_properties.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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IGEO(NPROPGI,NUMGEO),IGEO_STACK(4* NPT_STACK+2,NS_STACK)
      my_real, INTENT(IN) :: geo(npropg,numgeo),geo_stack(6*npt_stack+1,ns_stack),
     .                       pm_stack(20,ns_stack),bufgeo(*)
C--------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, MY_ID, MY_PID, 
     .        IADBUF, NUPARAM, IADMAT, NJMAT, IADPID, NJPID, IADFUN, NJFUN, IADTAB, NJTAB
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER (LEN=255) :: VARNAME
      DOUBLE PRECISION TEMP_DOUBLE
C=======================================================================
 
      IF (myqakey('PROPERTIES')) THEN
 
        DO my_pid=1,numgeo
        CALL fretitl2(titr,igeo(npropgi-ltitr+1,my_pid),ltitr) 
C
          IF(len_trim(titr)/=0)THEN
            CALL qaprint(titr(1:len_trim(titr)),igeo(1,my_pid),0.0_8)
          ELSE
            CALL qaprint('A_PID_FAKE_NAME',igeo(1,my_pid),0.0_8)
          END IF
          DO i=1,npropgi-ltitr 
            IF(igeo(i,my_pid)/=0)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'IGEO_',i      ! IGEO(11) => 'IGEO_11'
              CALL qaprint(varname(1:len_trim(varname)),igeo(i,my_pid),0.0_8)
            END IF
          END DO
          DO i=1,npropg
            IF(geo(i,my_pid)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'GEO_',i
              temp_double = geo(i,my_pid)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
C---------------------------------------------------
C Warning: Some properties are storing some other data at the same locations 
C         as the addresses (IADBUF, NUPARAM, etc) in IGEO
C         => to be cleaned before branching THIS !
C---------------------------------------------------
          iadbuf =igeo(57,my_pid)
          nuparam=igeo(52,my_pid)
          DO i=1,nuparam
            IF(bufgeo(iadbuf+i-1)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'BUFGEO_IADBUF_',i
              temp_double = bufgeo(iadbuf+i-1)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
          iadfun =igeo(58,my_pid)
          njfun  =igeo(53,my_pid)
          DO i=1,njfun
            IF(bufgeo(iadfun+i-1)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'BUFGEO_IADFUN_',i
              temp_double = bufgeo(iadfun+i-1)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
          iadmat =igeo(59,my_pid)
          njmat  =igeo(54,my_pid)
          DO i=1,njmat
            IF(bufgeo(iadmat+i-1)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'BUFGEO_IADMAT_',i
              temp_double = bufgeo(iadmat+i-1)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
          iadpid =igeo(60,my_pid)
          njpid  =igeo(55,my_pid)
          DO i=1,njpid
            IF(bufgeo(iadpid+i-1)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'BUFGEO_IADPID_',i
              temp_double = bufgeo(iadpid+i-1)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
          iadtab =igeo(61,my_pid)
          njtab  =igeo(56,my_pid)
          DO i=1,njtab
            IF(bufgeo(iadtab+i-1)/=zero)THEN
C
C             VARNAME: variable name in ref.extract (without blanks)
              WRITE(varname,'(A,I0)') 'BUFGEO_IADTAB_',i
              temp_double = bufgeo(iadtab+i-1)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
        END DO
c          
        DO my_pid=1,ns_stack
          my_id = my_pid
          CALL qaprint('STACK_NAME_NO', my_id,0.0_8)
c
          DO i=1,20
            IF (pm_stack(i,my_pid) /= zero) THEN
              WRITE(varname,'(A,I0)') 'STACK_PM_',i
              temp_double = pm_stack(i,my_pid)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
c                  
          DO i=1,6*npt_stack+1
            IF (geo_stack(i,my_pid) /= zero) THEN
              WRITE(varname,'(A,I0)') 'STACK_GEO_',i
              temp_double = geo_stack(i,my_pid)
              CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
            END IF
          END DO
c        
          DO i=1,3*npt_stack+2
            IF (igeo_stack(i,my_pid) /= 0) THEN
              WRITE(varname,'(A,I0)') 'STACK_IGEO_',i     
              CALL qaprint(varname(1:len_trim(varname)),igeo_stack(i,my_pid),0.0_8)
            END IF
          END DO                
        END DO
c        
      END IF
C-----------------------------------------------------------------------
      RETURN