Esope source files

   1 : C QUELCH    SOURCE    PV        09/03/12    21:32:09     6325           
   2 :       SUBROUTINE QUELCH(IPMELV,IRR)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : *______________________________________________________________________         
   6 : *
   7 : *  ON EXAMINE LE CHAMP POUR VOIR S'IL EST CONSTANT /ELEMENT OU PAS
   8 : *
   9 : *   ENTREES :
  10 : *    IPMELV = POINTEUR SUR UN SEGMENT MELVAL
  11 : *
  12 : *   SORTIES :
  13 : *   IRR     = 0 SI LE CHAMP EST CONSTANT ,=1 SINON
  14 : *
  15 : *   P DOWLATYARI JUIN 92 
  16 : *
  17 : ****************************************************************************
  18 : -INC SMCHAML
  19 : -INC CCREEL 
  20 : *
  21 :       IRR=0 
  22 :       IF(IPMELV.NE.0)THEN
  23 :        MELVAL=IPMELV
  24 :        NBPTE1=VELCHE(/1)
  25 :        NBPTE2=IELCHE(/1)
  26 :        IF(NBPTE2.NE.0)THEN
  27 :          IF(NBPTE2.EQ.1)THEN
  28 :             IRR=0
  29 :          ELSE
  30 :             IRR=1
  31 :          ENDIF
  32 :        ELSEIF(NBPTE1.NE.0)THEN
  33 :          IF(NBPTE1.EQ.1)THEN
  34 :              IRR=0
  35 :          ELSE
  36 :              NEL=VELCHE(/2)
  37 :              DO 10 IB=1,NEL
  38 :                VAL=0.D0
  39 :                DO 20 IGAU=1,NBPTE1
  40 :                   VAL=VAL+VELCHE(IGAU,IB)
  41 :   20           CONTINUE
  42 :                VALM=VAL/NBPTE1
  43 :                xtest=abs(valm * xzprec)
  44 :                DO 30  IGAU=1,NBPTE1
  45 :                   DELTA=ABS(VELCHE(IGAU,IB)-VALM)
  46 :                   IF(DELTA.GT.xtest)THEN
  47 :                      IRR=1
  48 :                      RETURN
  49 :                   ENDIF
  50 :   30           CONTINUE
  51 :   10       CONTINUE
  52 :            IRR=0
  53 :          ENDIF
  54 :        ENDIF
  55 :       ENDIF
  56 :       RETURN
  57 :       END                           
  58 :  
  59 :  
  60 :  
  61 :  
  62 :  
  63 :