Esope source files

   1 : C BORNE4    SOURCE    FANDEUR   10/12/16    21:15:20     6816           
   2 : 
   3 :       SUBROUTINE BORNE4 (IPCHPE,MLCOMP,MLIOPE,MLBMIN,MLBMAX, IPCHPS)
   4 : 
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : 
   8 : C*-INC CCOPTIO
   9 : -INC SMCHPOI
  10 : -INC SMLENTI
  11 : -INC SMLMOTS
  12 : -INC SMLREEL
  13 : 
  14 :       CHARACTER*4 mot4
  15 : 
  16 :       IPCHPS = 0
  17 :       IRETS  = 0
  18 :       MCHPO1 = IPCHPE
  19 :       SEGINI,MCHPOI=MCHPO1
  20 : 
  21 : C- Quelques verifications
  22 :       MLMOTS = MLCOMP
  23 : C*    SEGACT,MLMOTS
  24 :       DO i = 1, MOTS(/2)
  25 :         mot4 = MOTS(i)
  26 :         DO j = 1, i-1
  27 :           IF (mot4.EQ.MOTS(j)) MOTS(j) = '    '
  28 :         ENDDO
  29 :       ENDDO
  30 :       NCOMP = 0
  31 :       DO i = 1, MOTS(/2)
  32 :         IF (MOTS(i).NE.'    ') NCOMP = NCOMP+1
  33 :       ENDDO
  33 :       IF (NCOMP.EQ.0) CALL ERREUR(5)
  34 : 
  35 :       MLENT1 = MLIOPE
  36 : C*    SEGACT,MLENT1
  37 :       MLREE1 = MLBMIN
  38 : C*    SEGACT,MLREE1
  39 :       MLREE2 = MLBMAX
  40 : C*    SEGACT,MLREE2
  41 : 
  42 : C- Realisation du bornage des champs par point
  43 :       NSOUPO = IPCHP(/1)
  44 :       DO i = 1, NSOUPO
  45 :         MSOUP1 = IPCHP(i)
  46 :         SEGACT,MSOUP1
  47 :         MPOVA1 = MSOUP1.IPOVAL
  48 :         SEGACT,MPOVA1
  49 :         N     = MPOVA1.VPOCHA(/1)
  50 :         NCOMP = MPOVA1.VPOCHA(/2)
  51 :         SEGINI,MSOUPO=MSOUP1
  52 :         SEGINI,MPOVAL=MPOVA1
  53 :         NC = 0
  54 :         DO icour = 1, NCOMP
  55 :           mot4 = MSOUP1.NOCOMP(icour)
  56 : C*        IF (mot4.EQ.'    ') GOTO 100
  56 :           CALL PLACE(MOTS,MOTS(/2),ncour,mot4)
  57 :           IF (ncour.NE.0) THEN
  58 :             NC = NC+1
  59 :             NOCOMP(NC) = mot4
  60 :             NOCONS(NC) = MSOUP1.NOCONS(icour)
  61 :             NOHARM(NC) = MSOUP1.NOHARM(icour)
  62 :             INDOPE = MLENT1.LECT(ncour)
  63 :             XBMIN  = MLREE1.PROG(ncour)
  64 :             XBMAX  = MLREE2.PROG(ncour)
  65 : C- BORNER 'MAXIMUM' :
  66 :             IF (INDOPE.EQ.1) THEN
  67 :               DO j = 1, N
  68 :                 VPOCHA(j,NC) = MIN( MPOVA1.VPOCHA(j,icour), XBMAX)
  69 :               ENDDO
  70 : C- BORNER 'MINIMUM' :
  71 :             ELSE IF (INDOPE.EQ.2) THEN
  72 :               DO j = 1, N
  73 :                 VPOCHA(j,NC) = MAX( MPOVA1.VPOCHA(j,icour), XBMIN)
  74 :               ENDDO
  75 : C- BORNER 'COMPRIS' :
  76 :             ELSE IF (INDOPE.EQ.3) THEN
  77 :               DO j = 1, N
  78 :                 x = MIN( MPOVA1.VPOCHA(j,icour), XBMAX)
  79 :                 VPOCHA(j,NC) = MAX( x, XBMIN)
  80 :               ENDDO
  81 :             ELSE
  81 :               CALL ERREUR(5)
  82 :             ENDIF
  83 :           ENDIF
  84 : C*100     CONTINUE
  85 :         ENDDO
  86 :         SEGDES,MPOVA1,MSOUP1
  87 :         IF (NC.NE.0) THEN
  88 :           IRETS = IRETS + 1
  89 :           IF (NC.NE.NCOMP) THEN
  90 :             SEGADJ,MPOVAL,MSOUPO
  91 :           ENDIF
  92 :           IPCHP(IRETS) = MSOUPO
  93 :           IPOVAL = MPOVAL
  94 :           SEGDES,MPOVAL,MSOUPO
  95 :         ELSE
  96 :           SEGSUP,MPOVAL,MSOUPO
  97 :         ENDIF
  98 :       ENDDO
  99 : 
 100 :       IF (IRETS.GT.0) THEN
 101 :         IF (IRETS.NE.NSOUPO) THEN
 102 :           NSOUPO = IRETS
 103 :           NAT = JATTRI(/1)
 104 :           SEGADJ,MCHPOI
 105 :         ENDIF
 106 :         IPCHPS = MCHPOI
 107 :       ELSE
 107 :         CALL ERREUR(280)
 108 :       ENDIF
 109 : 
 110 :  900  CONTINUE
 111 :       IF (IPCHPS.NE.0) THEN
 112 :         SEGDES,MCHPOI
 113 :       ELSE
 114 :         SEGSUP,MCHPOI
 115 :       ENDIF
 116 : 
 117 :       RETURN
 118 :       END
 119 : 
 120 :