C KOPS1 SOURCE FANDEUR 22/05/02 21:15:25 11359 SUBROUTINE KOPS1(V,V1,V2,XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************* C C Routine de calcul intensif appele par KOPS C C C C C************************************************************************* -INC CCREEL REAL*8 V(*),V1(*),V2(*),XVEC(3) C DATA LOPER/'MULT ','DIVI ','PSRN ','PSCA ','ET ', C & '* ','/ ','+ ','- ','** ', C & '|< ','>| ','GRAD ','ROT '/ C*** REAL*8 DDOT EXTERNAL DDOT LONG=NS*NC c write(6,*)' LONG=',LONG,' IKAS=',IKAS,' KOP=',KOP,' NC2=',nc2 GO TO (21,22,23,24,25,21,22,26,27,28,29,30,31,32),KOP C MULT 21 CONTINUE C cas particulier ? LONG=NS LONG=NS IF(IKAS.EQ.1)THEN DO L=1,NC2 L1=LONG*(L-1) DO K=1,LONG V(K+L1)=XVAL1*V2(K+L1) ENDDO ENDDO ELSEIF(IKAS.EQ.2)THEN DO L=1,NC2 L1=LONG*(L-1) DO K=1,LONG V(K+L1)=XVAL2*V1(K+L1) ENDDO ENDDO ELSEIF(IKAS.EQ.3)THEN DO L=1,NC2 L1=LONG*(L-1) DO K=1,LONG V(K+L1)=V1(K)*V2(K+L1) ENDDO ENDDO ELSEIF(IKAS.EQ.4)THEN DO L=1,NC2 L1=LONG*(L-1) DO K=1,LONG V(K+L1)=XVEC(L)*V2(K) ENDDO ENDDO ELSEIF(IKAS.EQ.5)THEN DO L=1,NC2 L1=LONG*(L-1) DO K=1,LONG V(K+L1)=XVEC(L)*V1(K) ENDDO ENDDO ELSEIF(IKAS.EQ.6)THEN DO L=1,NC2 L1=LONG*(L-1) DO K=1,LONG V(K+L1)=V1(K+L1)*V2(K+L1) ENDDO ENDDO ENDIF RETURN C DIVI 22 CONTINUE IF(IKAS.EQ.1)THEN DO 221 K=1,LONG V(K)=XVAL1/V2(K) 221 CONTINUE ELSEIF(IKAS.EQ.2)THEN if (abs(xval2).le.xpetit) then call erreur(908) return endif DO 222 K=1,LONG V(K)=V1(K)/XVAL2 222 CONTINUE ELSE DO 223 K=1,LONG V(K)=V1(K)/V2(K) 223 CONTINUE ENDIF RETURN C PSRN 23 CONTINUE N=NS*NC XVAL1=DDOT(N,V1,1,V2,1) RETURN C PSCA 24 CONTINUE DO 244 K=1,NC DO 243 I=1,NS V(I)=V(I)+V1(I+(K-1)*NS)*V2(I+(K-1)*NS) 243 CONTINUE 244 CONTINUE RETURN C ET 25 CONTINUE WRITE(6,*)' ET : Non operationnel pour l''instant' RETURN C '+' 26 CONTINUE IF(IKAS.EQ.1)THEN DO 261 K=1,LONG V(K)=XVAL1+V2(K) 261 CONTINUE ELSEIF(IKAS.EQ.2)THEN DO 262 K=1,LONG V(K)=XVAL2+V1(K) 262 CONTINUE ELSE DO 263 K=1,LONG V(K)=V1(K)+V2(K) 263 CONTINUE ENDIF RETURN C '-' 27 CONTINUE IF(IKAS.EQ.1)THEN DO 271 K=1,LONG V(K)=XVAL1-V2(K) 271 CONTINUE ELSEIF(IKAS.EQ.2)THEN DO 272 K=1,LONG V(K)=V1(K)-XVAL2 272 CONTINUE ELSE DO 273 K=1,LONG V(K)=V1(K)-V2(K) 273 CONTINUE ENDIF RETURN C '|<' 28 CONTINUE IF(IKAS.EQ.1)THEN DO 281 K=1,LONG V(K)=XVAL1**V2(K) 281 CONTINUE ELSEIF(IKAS.EQ.2)THEN DO 282 K=1,LONG V(K)=V1(K)**XVAL2 282 CONTINUE ELSE DO 283 K=1,LONG V(K)=V1(K)**V2(K) 283 CONTINUE ENDIF RETURN C '|<' 29 CONTINUE IF(IKAS.EQ.1)THEN DO 291 K=1,LONG V(K)= MAX(XVAL1,V2(K)) 291 CONTINUE ELSEIF(IKAS.EQ.2)THEN DO 292 K=1,LONG V(K)= MAX(V1(K),XVAL2) 292 CONTINUE ELSE DO 293 K=1,LONG V(K)= MAX(V1(K),V2(K)) 293 CONTINUE ENDIF RETURN C '>|' 30 CONTINUE IF(IKAS.EQ.1)THEN DO 301 K=1,LONG V(K)=MIN(XVAL1,V2(K)) 301 CONTINUE ELSEIF(IKAS.EQ.2)THEN DO 302 K=1,LONG V(K)=MIN(V1(K),XVAL2) 302 CONTINUE ELSE DO 303 K=1,LONG V(K)=MIN(V1(K),V2(K)) 303 CONTINUE ENDIF RETURN C 'GRAD' 31 CONTINUE RETURN C 'ROT' 32 CONTINUE RETURN END