Esope source files

   1 : C ERF       SOURCE    BP208322  12/07/10    21:15:07     7432           
   2 : C=====================================================================
   3 : C  FONCTION D'ERREUR ERF
   4 : C     
   5 : C  ON DONNE EN ARGUMENT UN CHPO, UN MCHAML, UN LISTREEL OU UN REEL
   6 : C  CREE UN OBJET DE MEME TYPE AVEC LES VALEURS ERF(VALEUR DANS L'OBJET)
   7 : C     
   8 : C  INTEGRATION DE LA GAUSSIENNE NORMALISEE ENTRE 0 ET LA VALEUR
   9 : C  ARGUMENT
  10 : C  POUR L'INTEGRATION ON UTILISE LA METHODE DE ROMBERG
  11 : C     
  12 : C  APPELE OPCHEL OPCHPO ET OPLREE
  13 : C     
  14 : C  FORTRAN77 + ESOPE
  15 : C======================================================================
  16 :       SUBROUTINE ERF
  17 : C
  18 :       IMPLICIT INTEGER(I-N)
  19 :       IMPLICIT REAL*8(A-H,O-Z)
  20 : C
  21 : -INC CCOPTIO
  22 : C     
  23 : C     MCHAML
  24 : C     
  24 :       CALL LIROBJ('MCHAML',IPO1,0,IRETOU)
  25 :       IF (IRETOU.EQ.0) GOTO 10
  25 :       CALL OPCHEL(IPO1,13,IPO2)
  25 :       CALL ECROBJ('MCHAML',IPO2)
  26 :       RETURN
  27 : C     
  28 : C     CAS D UN CHPOINT
  29 : C     
  30 :  10   CONTINUE
  30 :       CALL LIROBJ('CHPOINT ',IPO1,0,IRETOU)
  31 :       IF(IRETOU.EQ.0) GOTO 20
  31 :       CALL OPCHPO(IPO1,13,IPO2)
  31 :       CALL ECROBJ('CHPOINT ',IPO2)
  32 :       RETURN
  33 : C     
  34 : C     CAS D UN LISTREEL
  35 : C     
  36 :  20   CONTINUE
  36 :       CALL LIROBJ('LISTREEL',IPO1,0,IRETOU)
  37 :       IF(IRETOU.EQ.0) GOTO 30
  37 :       CALL OPLREE(IPO1,13,IPO2)
  37 :       CALL ECROBJ('LISTREEL',IPO2)
  38 :       RETURN
  39 : C     
  40 : C     CAS DU FLOTTANT
  41 : C     
  42 :  30   CONTINUE
  42 :       CALL LIRREE(XR,0,IRETOU)
  43 :       IF(IRETOU.EQ.0) GO TO 40
  44 :       YY = ERGAUS(XR)
  44 :       CALL ECRREE(YY)
  45 :       RETURN
  46 : C                                                                               
  47 : C     EVOLUTION                                                                  
  48 : C                                                                               
  49 :   40  CONTINUE                                                                  
  49 :       CALL LIROBJ('EVOLUTIO',IPO1,0,IRETOU)                                     
  50 :       IF (IRETOU.EQ.0) GO TO 50                                                 
  50 :       CALL OPEVOL(IPO1,13,IPO2)                                                  
  50 :       CALL ECROBJ('EVOLUTIO',IPO2)                                              
  51 :       RETURN                                                                    
  52 : C                                                                               
  53 : C     
  54 : C    PAS D OPERANDE CORRECTE TROUVE
  55 : C     
  55 :  50   CALL QUETYP(MOTERR(1:8),0,IRETOU)
  56 :       IF(IRETOU.NE.0) THEN
  56 :          CALL ERREUR (39)
  57 :       ELSE
  57 :          CALL ERREUR(533)
  58 :       ENDIF
  59 :       RETURN
  60 :       END
  61 : 
  62 :  
  63 :