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