Esope source files

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