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
C         Le Titr de la PID sert de nom de la variable dans le ref.extract , suivi de l'ID de la PID 
C         2 PIDs peuvent avoir le meme titre
          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 ! si on ne peut pas tester une chaine de caracteres, do i=1,npropgi
            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