Télécharger la plaquette Cast3M


fr en

Télécharger kops1.eso

Retour à la liste

Numérotation des lignes : 

kops1

  1. C KOPS1     SOURCE    FANDEUR   22/05/02    21:15:25     11359          
  2.       SUBROUTINE KOPS1(V,V1,V2,XVAL1,XVAL2,NC,NC2,NS,IKAS,KOP,XVEC)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C  Routine de calcul intensif appele par KOPS
  8. C
  9. C
  10. C
  11. C
  12. C*************************************************************************
  13.  
  14. -INC CCREEL
  15.       REAL*8 V(*),V1(*),V2(*),XVEC(3)
  16. C     DATA LOPER/'MULT    ','DIVI    ','PSRN    ','PSCA    ','ET      ',
  17. C    &           '*       ','/       ','+       ','-       ','**      ',
  18. C    &           '|<      ','>|      ','GRAD    ','ROT     '/
  19. C***
  20.       REAL*8   DDOT
  21.       EXTERNAL DDOT
  22.  
  23.       LONG=NS*NC
  24.  
  25. c      write(6,*)' LONG=',LONG,' IKAS=',IKAS,' KOP=',KOP,' NC2=',nc2
  26.       GO TO (21,22,23,24,25,21,22,26,27,28,29,30,31,32),KOP
  27.  
  28. C MULT
  29.  21   CONTINUE
  30. C cas particulier ? LONG=NS
  31.       LONG=NS
  32.  
  33.       IF(IKAS.EQ.1)THEN
  34.       DO L=1,NC2
  35.         L1=LONG*(L-1)
  36.         DO K=1,LONG
  37.           V(K+L1)=XVAL1*V2(K+L1)
  38.         ENDDO
  39.       ENDDO
  40.       ELSEIF(IKAS.EQ.2)THEN
  41.       DO L=1,NC2
  42.         L1=LONG*(L-1)
  43.         DO K=1,LONG
  44.           V(K+L1)=XVAL2*V1(K+L1)
  45.         ENDDO
  46.       ENDDO
  47.       ELSEIF(IKAS.EQ.3)THEN
  48.       DO L=1,NC2
  49.         L1=LONG*(L-1)
  50.         DO K=1,LONG
  51.           V(K+L1)=V1(K)*V2(K+L1)
  52.         ENDDO
  53.       ENDDO
  54.       ELSEIF(IKAS.EQ.4)THEN
  55.       DO L=1,NC2
  56.         L1=LONG*(L-1)
  57.         DO K=1,LONG
  58.           V(K+L1)=XVEC(L)*V2(K)
  59.         ENDDO
  60.       ENDDO
  61.       ELSEIF(IKAS.EQ.5)THEN
  62.       DO L=1,NC2
  63.         L1=LONG*(L-1)
  64.         DO K=1,LONG
  65.           V(K+L1)=XVEC(L)*V1(K)
  66.         ENDDO
  67.       ENDDO
  68.       ELSEIF(IKAS.EQ.6)THEN
  69.       DO L=1,NC2
  70.         L1=LONG*(L-1)
  71.         DO K=1,LONG
  72.           V(K+L1)=V1(K+L1)*V2(K+L1)
  73.         ENDDO
  74.       ENDDO
  75.       ENDIF
  76.       RETURN
  77.  
  78. C DIVI
  79.  22   CONTINUE
  80.  
  81.       IF(IKAS.EQ.1)THEN
  82.       DO 221 K=1,LONG
  83.         V(K)=XVAL1/V2(K)
  84.  221  CONTINUE
  85.       ELSEIF(IKAS.EQ.2)THEN
  86.          if (abs(xval2).le.xpetit) then
  87.            call erreur(908)
  88.            return
  89.          endif
  90.       DO 222 K=1,LONG
  91.         V(K)=V1(K)/XVAL2
  92.  222  CONTINUE
  93.       ELSE
  94.       DO 223 K=1,LONG
  95.         V(K)=V1(K)/V2(K)
  96.  223  CONTINUE
  97.       ENDIF
  98.       RETURN
  99.  
  100. C PSRN
  101.  23   CONTINUE
  102.  
  103.       N=NS*NC
  104.       XVAL1=DDOT(N,V1,1,V2,1)
  105.       RETURN
  106.  
  107. C PSCA
  108.  24   CONTINUE
  109.  
  110.       DO 244 K=1,NC
  111.       DO 243 I=1,NS
  112.         V(I)=V(I)+V1(I+(K-1)*NS)*V2(I+(K-1)*NS)
  113.  243  CONTINUE
  114.  244  CONTINUE
  115.       RETURN
  116.  
  117. C ET
  118.  25   CONTINUE
  119.       WRITE(6,*)' ET : Non operationnel pour l''instant'
  120.       RETURN
  121.  
  122. C '+'
  123.  26   CONTINUE
  124.  
  125.       IF(IKAS.EQ.1)THEN
  126.       DO 261 K=1,LONG
  127.         V(K)=XVAL1+V2(K)
  128.  261  CONTINUE
  129.       ELSEIF(IKAS.EQ.2)THEN
  130.       DO 262 K=1,LONG
  131.         V(K)=XVAL2+V1(K)
  132.  262  CONTINUE
  133.       ELSE
  134.       DO 263 K=1,LONG
  135.         V(K)=V1(K)+V2(K)
  136.  263  CONTINUE
  137.       ENDIF
  138.       RETURN
  139.  
  140. C '-'
  141.  27   CONTINUE
  142.  
  143.       IF(IKAS.EQ.1)THEN
  144.       DO 271 K=1,LONG
  145.         V(K)=XVAL1-V2(K)
  146.  271  CONTINUE
  147.       ELSEIF(IKAS.EQ.2)THEN
  148.       DO 272 K=1,LONG
  149.         V(K)=V1(K)-XVAL2
  150.  272  CONTINUE
  151.       ELSE
  152.       DO 273 K=1,LONG
  153.         V(K)=V1(K)-V2(K)
  154.  273  CONTINUE
  155.       ENDIF
  156.       RETURN
  157.  
  158.  
  159. C '|<'
  160.  28   CONTINUE
  161.  
  162.       IF(IKAS.EQ.1)THEN
  163.       DO 281 K=1,LONG
  164.         V(K)=XVAL1**V2(K)
  165.  281  CONTINUE
  166.       ELSEIF(IKAS.EQ.2)THEN
  167.       DO 282 K=1,LONG
  168.         V(K)=V1(K)**XVAL2
  169.  282  CONTINUE
  170.       ELSE
  171.       DO 283 K=1,LONG
  172.         V(K)=V1(K)**V2(K)
  173.  283  CONTINUE
  174.       ENDIF
  175.       RETURN
  176.  
  177. C '|<'
  178.  29   CONTINUE
  179.  
  180.       IF(IKAS.EQ.1)THEN
  181.       DO 291 K=1,LONG
  182.         V(K)= MAX(XVAL1,V2(K))
  183.  291  CONTINUE
  184.       ELSEIF(IKAS.EQ.2)THEN
  185.       DO 292 K=1,LONG
  186.         V(K)= MAX(V1(K),XVAL2)
  187.  292  CONTINUE
  188.       ELSE
  189.       DO 293 K=1,LONG
  190.         V(K)= MAX(V1(K),V2(K))
  191.  293  CONTINUE
  192.       ENDIF
  193.       RETURN
  194.  
  195. C '>|'
  196.  30   CONTINUE
  197.  
  198.       IF(IKAS.EQ.1)THEN
  199.       DO 301 K=1,LONG
  200.         V(K)=MIN(XVAL1,V2(K))
  201.  301  CONTINUE
  202.       ELSEIF(IKAS.EQ.2)THEN
  203.       DO 302 K=1,LONG
  204.         V(K)=MIN(V1(K),XVAL2)
  205.  302  CONTINUE
  206.       ELSE
  207.       DO 303 K=1,LONG
  208.         V(K)=MIN(V1(K),V2(K))
  209.  303  CONTINUE
  210.       ENDIF
  211.       RETURN
  212.  
  213. C 'GRAD'
  214.  31   CONTINUE
  215.       RETURN
  216.  
  217. C 'ROT'
  218.  32   CONTINUE
  219.       RETURN
  220.  
  221.       END
  222.  
  223.  
  224.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales