Sources Esope | Cast3M

agrega
C AGREGA    SOURCE    FD218221  25/12/24    21:15:04     12435          
      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(2)
      DATA MCLE1/'SOMM','PROD','MOYE','MOHA','MOGE','VARI','ECTY',
     &           'ASYM','KURT','MEDI','PMOM','PMOY','PNOR','LEHM',
     &           'KSL','KSU','BOLT'/
      DATA MCLE2/'ROBU','DERI'/
      DATA ZER/0.D0/,UN/1.D0/
 
C     Lecture du mot clef obligatoire (fonction d'agregation choisie ?)
      CALL LIRMOT(MCLE1,NMOT,IPOSI,1)
      IF (IERR .NE. 0) RETURN
 
C     Lecture des mots clefs facultatifs (calcul robuste ? calcul des derivees ?)
      IROBU=0
      IDERI=0
      DO I=1,2
        CALL LIRMOT(MCLE2,2,I1,0)
        IF (IERR .NE. 0) RETURN
        IF (I1.EQ.1) IROBU=1
        IF (I1.EQ.2) IDERI=1
      ENDDO
 
C     Lecture d'un 'LISTREEL' obligatoire et activation
      CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
      IF (IERR .NE. 0) RETURN
      SEGACT,MLREE1
 
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(MLREE1,IPOSI,XP,IDERI,IROBU,XRESU,MLREE2)
      IF (IERR.NE.0) RETURN
 
C     Ecriture des resultats (FLOTTANT et LISTREEL)
      IF (IDERI.EQ.1) THEN
        CALL ECROBJ('LISTREEL',MLREE2)
      ENDIF
      CALL ECRREE(XRESU)
      RETURN
      END