Sources Esope | Cast3M

agrega
C AGREGA    SOURCE    FD218221  25/03/11    21:15:02     12187          
      SUBROUTINE AGREGA
 
C     Typages implicites habituels
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
C     Les includes necessaires
-INC PPARAM
-INC CCOPTIO
-INC SMLREEL
 
C     Les objets necessaires
      PARAMETER (NMOT=17)
      CHARACTER*(4) MCLE1(NMOT),MCLE2(1)
      DATA MCLE1/'SOMM','PROD','MOYE','MOHA','MOGE','VARI','ECTY',
     &           'ASYM','KURT','MEDI','PMOM','PMOY','PNOR','LEHM',
     &           'KSL','KSU','BOLT'/
      DATA MCLE2/'ROBU'/
      DATA ZER/0.D0/,UN/1.D0/
 
C     Lecture d'un 'MOT-CLE' obligatoire
      CALL LIRMOT(MCLE1,NMOT,IPOSI,1)
      IF (IERR .NE. 0) RETURN
 
C     Lecture d'un 'MOT-CLE' facultatif
      CALL LIRMOT(MCLE2,1,IROBU,0)
      IF (IERR .NE. 0) RETURN
 
C     Lecture d'un 'LISTREEL' obligatoire et activation
      CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU)
      IF (IERR .NE. 0) RETURN
      SEGACT,MLREEL
 
C     Lecture d'un 'FLOTTANT' facultatif
      CALL LIRREE(XP,0,IRETOU)
      IF (IERR .NE. 0) RETURN
      IF (IRETOU.EQ.0) XP=1.D0
 
C     Appel a la subroutine qui fait le travail
      CALL AGREG1(MLREEL,IPOSI,XP,IROBU,XRESU)
      IF (IERR.NE.0) RETURN
 
C     Ecriture du resultat (FLOTTANT)
      CALL ECRREE(XRESU)
      RETURN
      END