1 : C KARSET SOURCE CHAT 05/01/13 00:51:39 5004 2 : SUBROUTINE KARSET(A,B,N,NM,X,Y,KVU) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C********************************************************************* 6 : C SP appele par KAINTE 7 : C 8 : C - MISE A JOUR DES INTERVALLES D INTEGRATION 9 : C A : A(1,I),A(2,I) I=1,N INTERVALLES D INTEGRATION 10 : C B : TABLEAU DE SAUVEGARDE DE A 11 : C X Y : SEGMENT A ENLEVER X25 : IF(X.LT.B(2,N).AND.Y.GT.B(1,1)) THEN 26 : 27 : C11> 28 : IF(X.LE.B(1,1)) THEN 29 : IF(Y.GE.B(2,N)) THEN 30 : KVU=0 31 : ELSE 32 : C** 33 : C recherche de j 34 : IF (Y.GT.B(1,N)) THEN 35 : J=N 36 : ELSEIF(N.NE.1) THEN 37 : DO 200 J=1,N-1 38 : IF(Y.GT.B(1,J).AND.Y.LE.B(1,J+1)) GOTO 201 39 : 200 CONTINUE 40 : 201 CONTINUE 41 : ENDIF 42 : 43 : 44 : C13> 45 : IF(Y.GT.B(2,J)) THEN 46 : NI=J 47 : IF(J+1.LE.N) THEN 48 : DO 22 K=J+1,N 49 : A(1,K-NI)=B(1,K) 50 : A(2,K-NI)=B(2,K) 51 : 22 CONTINUE 52 : ENDIF 53 : N=N-NI 54 : C13- 55 : ELSE 56 : A(1,1)= Y 57 : A(2,1)= B(2,J) 58 : NI=J-1 59 : IF(J+1.LE.N) THEN 60 : DO 23 K=J+1,N 61 : A(1,K-NI)=B(1,K) 62 : A(2,K-NI)=B(2,K) 63 : 23 CONTINUE 64 : ENDIF 65 : N=N-NI 66 : 67 : ENDIF 68 : C13< 69 : ENDIF 70 : C11- 71 : ELSE 72 : C2> 73 : IF(N.EQ.1) THEN 74 : C** N=1 75 : 76 : IF(Y.LT.B(2,N)) THEN 77 : N=2 78 : A(2,1)=X 79 : A(1,2)=Y 80 : A(2,2)=B(2,1) 81 : ELSE 82 : A(2,1)=X 83 : ENDIF 84 : 85 : 86 : C2- N::1 87 : 88 : ELSE 89 : C recherche de i 90 : IF (X.GT.B(1,N)) THEN 91 : I=N 92 : ELSEIF(N.NE.1) THEN 93 : DO 300 I=1,N-1 94 : IF(X.GT.B(1,I).AND.X.LE.B(1,I+1)) GOTO 301 95 : 300 CONTINUE 96 : 301 CONTINUE 97 : ENDIF 98 : C3> 99 : IF(Y.LT.B(2,I)) THEN 100 : C** I=J 101 : A(2,I)=X 102 : A(1,I+1)=Y 103 : A(2,I+1)=B(2,I) 104 : IF(I+1.LE.N) THEN 105 : DO 11 K=I+1,N 106 : A(1,K+1)=B(1,K) 107 : A(2,K+1)=B(2,K) 108 : 11 CONTINUE 109 : ENDIF 110 : N=N+1 111 : C3- 112 : ELSEIF(Y.LT.B(1,I+1)) THEN 113 : A(2,I)=DMIN1(X,B(2,I)) 114 : C3- 115 : ELSE 116 : C** J::I 117 : C recherche de j 118 : IF (Y.GT.B(1,N)) THEN 119 : J=N 120 : ELSEIF(N.NE.1) THEN 121 : DO 400 J=I+1,N-1 122 : IF(Y.GT.B(1,J).AND.Y.LE.B(1,J+1)) GOTO 401 123 : 400 CONTINUE 124 : 401 CONTINUE 125 : ENDIF 126 : 127 : C4> 128 : IF(Y.LT.B(2,J)) THEN 129 : 130 : A(2,I)=DMIN1(X,B(2,I)) 131 : A(1,I+1)=Y 132 : A(2,I+1)=B(2,J) 133 : NI=J-I-1 134 : IF(J+1.LE.N) THEN 135 : DO 13 K=J+1,N 136 : A(1,K-NI)=B(1,K) 137 : A(2,K-NI)=B(2,K) 138 : 13 CONTINUE 139 : ENDIF 140 : N=N-NI 141 : C4- 142 : ELSE 143 : A(2,I)=DMIN1(X,B(2,I)) 144 : NI=J-I 145 : IF(J+1.LE.N) THEN 146 : DO 12 K=J+1,N 147 : A(1,K-NI)=B(1,K) 148 : A(2,K-NI)=B(2,K) 149 : 12 CONTINUE 150 : ENDIF 151 : N=N-NI 152 : 153 : ENDIF 154 : C4< 155 : ENDIF 156 : C3< 157 : ENDIF 158 : C2< 159 : ENDIF 160 : C11< 161 : ENDIF 162 : C1< 163 : A(1,N+1)=AM 164 : 165 : 166 : RETURN 167 : END 168 :
© Cast3M 2003 - All rights reserved.
Disclaimer