1 : C BORNE5 SOURCE PV 11/03/07 21:15:13 6885 2 : 3 : SUBROUTINE BORNE5 (IPCHME,MLCOMP,MLIOPE,MLBMIN,MLBMAX, IPCHMS) 4 : 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : 8 : -INC CCOPTIO 9 : -INC SMCHAML 10 : -INC SMLENTI 11 : -INC SMLMOTS 12 : -INC SMLREEL 13 : POINTEUR MLREE4.MLREEL 14 : 15 : CHARACTER*4 mot4 16 : 17 : IPCHMS = 0 18 : IRETS = 0 19 : MCHEL1 = IPCHME 20 : SEGINI,MCHELM=MCHEL1 21 : 22 : C- Quelques verifications 23 : MLMOTS = MLCOMP 24 : C* SEGACT,MLMOTS 25 : DO i = 1, MOTS(/2) 26 : mot4 = MOTS(i) 27 : DO j = 1, i-1 28 : IF (mot4.EQ.MOTS(j)) MOTS(j) = ' ' 29 : ENDDO 30 : ENDDO 31 : NCOMP = 0 32 : DO i = 1, MOTS(/2) 33 : IF (MOTS(i).NE.' ') NCOMP = NCOMP+1 34 : ENDDO 34 : IF (NCOMP.EQ.0) CALL ERREUR(5) 35 : 36 : MLENTI = MLIOPE 37 : C* SEGACT,MLENTI 38 : MLREE1 = MLBMIN 39 : C* SEGACT,MLREE1 40 : MLREE2 = MLBMAX 41 : C* SEGACT,MLREE2 42 : 43 : C- Realisation du bornage des champs par element 44 : N1 = ICHAML(/1) 45 : N3 = INFCHE(/2) 46 : DO i = 1, N1 47 : 48 : MCHAM1 = ICHAML(i) 49 : SEGACT,MCHAM1 50 : NCOMP = MCHAM1.NOMCHE(/2) 51 : SEGINI,MCHAML=MCHAM1 52 : N2 = 0 53 : DO icour = 1, NCOMP 54 : mot4 = MCHAM1.NOMCHE(icour) 55 : C* IF (mot4.EQ.' ') GOTO 100 55 : CALL PLACE(MOTS,MOTS(/2),ncour,mot4) 56 : IF (ncour.NE.0) THEN 57 : N2 = N2+1 58 : NOMCHE(N2) = mot4 59 : TYPCHE(N2) = MCHAM1.TYPCHE(icour) 60 : MELVA1 = MCHAM1.IELVAL(icour) 61 : SEGINI,MELVAL=MELVA1 62 : IELVAL(N2) = MELVAL 63 : INDOPE = MLENTI.LECT(ncour) 64 : XBMIN = MLREE1.PROG(ncour) 65 : XBMAX = MLREE2.PROG(ncour) 66 : IF (TYPCHE(N2).EQ.'REAL*8') THEN 67 : N1PTEL = VELCHE(/1) 68 : N1EL = VELCHE(/2) 69 : C- BORNER 'MAXIMUM' : 70 : IF (INDOPE.EQ.1) THEN 71 : DO iel = 1, N1EL 72 : DO igau = 1, N1PTEL 73 : VELCHE(igau,iel) = MIN( VELCHE(igau,iel), XBMAX) 74 : ENDDO 75 : ENDDO 76 : C- BORNER 'MINIMUM' : 77 : ELSE IF (INDOPE.EQ.2) THEN 78 : DO iel = 1, N1EL 79 : DO igau = 1, N1PTEL 80 : VELCHE(igau,iel) = MAX( VELCHE(igau,iel), XBMIN) 81 : ENDDO 82 : ENDDO 83 : C- BORNER 'COMPRIS' : 84 : ELSE IF (INDOPE.EQ.3) THEN 85 : DO iel = 1, N1EL 86 : DO igau = 1, N1PTEL 87 : x = MIN( VELCHE(igau,iel), XBMAX) 88 : VELCHE(igau,iel) = MAX( x, XBMIN) 89 : ENDDO 90 : ENDDO 91 : ELSE 91 : CALL ERREUR(5) 92 : ENDIF 93 : ELSE IF (TYPCHE(N2).EQ.'POINTEURLISTREEL') THEN 94 : N2PTEL = IELCHE(/1) 95 : N2EL = IELCHE(/2) 96 : DO iel = 1, N2EL 97 : DO igau = 1, N2PTEL 98 : ILREEE = IELCHE(igau,iel) 98 : CALL BORNE2(ILREEE,INDOPE,XBMIN,XBMAX, ILREES) 99 : IELCHE(igau,iel) = ILREES 100 : ENDDO 101 : ENDDO 102 : ELSE IF (TYPCHE(N2).EQ.'POINTEUREVOLUTIO') THEN 103 : N2PTEL = IELCHE(/1) 104 : N2EL = IELCHE(/2) 105 : JG = 1 106 : SEGINI,MLENT2,MLENT3,MLREE3,MLREE4 107 : MLENT2.LECT(1) = 1 108 : MLENT3.LECT(1) = INDOPE 109 : MLREE3.PROG(1) = XBMIN 110 : MLREE4.PROG(1) = XBMAX 111 : DO iel = 1, N2EL 112 : DO igau = 1, N2PTEL 113 : IEVOLE = IELCHE(igau,iel) 113 : CALL BORNE3(IEVOLE,MLENT2,MLENT3,MLREE3,MLREE4,IEVOLS) 114 : IELCHE(igau,iel) = IEVOLS 115 : IF (IEVOLS.EQ.0) IRETS = -1 116 : ENDDO 117 : ENDDO 118 : SEGSUP,MLENT2,MLENT3,MLREE3,MLREE4 119 : ELSE IF (TYPCHE(N2).EQ.'POINTEURLISTENTI') THEN 120 : N2PTEL = IELCHE(/1) 121 : N2EL = IELCHE(/2) 122 : IBMIN = nint(XBMIN) 123 : IBMAX = nint(XBMAX) 124 : DO iel = 1, N2EL 125 : DO igau = 1, N2PTEL 126 : ILENTE = IELCHE(igau,iel) 126 : CALL BORNE1(ILENTE,INDOPE,IBMIN,IBMAX, ILENTS) 127 : IELCHE(igau,iel) = ILENTS 128 : ENDDO 129 : ENDDO 130 : ELSE 131 : MOTERR(1:8)=MCHAM1.NOMCHE(icour) 131 : CALL ERREUR(679) 132 : IRETS = -1 133 : ENDIF 134 : SEGDES,MELVAL 135 : ENDIF 136 : C*100 CONTINUE 137 : ENDDO 138 : IF (IRETS.NE.-1) THEN 139 : IF (N2.NE.0) THEN 140 : IRETS = IRETS + 1 141 : IF (N2.NE.NCOMP) THEN 142 : SEGADJ,MCHAML 143 : ENDIF 144 : SEGDES,MCHAML 145 : ICHAML(IRETS) = MCHAML 146 : IF (IRETS.NE.i) THEN 147 : CONCHE(IRETS) = CONCHE(i) 148 : IMACHE(IRETS) = IMACHE(i) 149 : DO j = 1, N3 150 : INFCHE(IRETS,j) = INFCHE(i,j) 151 : ENDDO 152 : ENDIF 153 : ELSE 154 : SEGSUP,MCHAML 155 : ENDIF 156 : ENDIF 157 : SEGDES,MCHAM1 158 : ENDDO 159 : 160 : IF (IRETS.GT.0) THEN 161 : IF (IRETS.NE.N1) THEN 162 : N1 = IRETS 163 : L1 = TITCHE(/1) 164 : SEGADJ,MCHELM 165 : ENDIF 166 : IPCHMS = MCHELM 167 : ELSE IF (IRETS.EQ.0) THEN 167 : CALL ERREUR(280) 168 : ENDIF 169 : 170 : 900 CONTINUE 171 : IF (IPCHMS.NE.0) THEN 172 : SEGDES,MCHELM 173 : ELSE 174 : SEGSUP,MCHELM 175 : ENDIF 176 : 177 : RETURN 178 : END 179 : 180 : 181 :
© Cast3M 2003 - All rights reserved.
Disclaimer