Télécharger kops1.eso

Retour à la liste

Numérotation des lignes :

  1. C KOPS1 SOURCE CB215821 17/11/30 21:16:42 9639
  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
  79. call erreur(908)
  80. return
  81. endif
  82. DO 222 K=1,LONG
  83. V(K)=V1(K)/XVAL2
  84. 222 CONTINUE
  85. ELSE
  86. DO 223 K=1,LONG
  87. V(K)=V1(K)/V2(K)
  88. 223 CONTINUE
  89. ENDIF
  90. RETURN
  91.  
  92. C PSRN
  93. 23 CONTINUE
  94.  
  95. N=NS*NC
  96. XVAL1=SDOT(N,V1,1,V2,1)
  97. RETURN
  98.  
  99. C PSCA
  100. 24 CONTINUE
  101.  
  102. DO 244 K=1,NC
  103. DO 243 I=1,NS
  104. V(I)=V(I)+V1(I+(K-1)*NS)*V2(I+(K-1)*NS)
  105. 243 CONTINUE
  106. 244 CONTINUE
  107. RETURN
  108.  
  109. C ET
  110. 25 CONTINUE
  111. WRITE(6,*)' ET : Non operationnel pour l''instant'
  112. RETURN
  113.  
  114. C '+'
  115. 26 CONTINUE
  116.  
  117. IF(IKAS.EQ.1)THEN
  118. DO 261 K=1,LONG
  119. V(K)=XVAL1+V2(K)
  120. 261 CONTINUE
  121. ELSEIF(IKAS.EQ.2)THEN
  122. DO 262 K=1,LONG
  123. V(K)=XVAL2+V1(K)
  124. 262 CONTINUE
  125. ELSE
  126. DO 263 K=1,LONG
  127. V(K)=V1(K)+V2(K)
  128. 263 CONTINUE
  129. ENDIF
  130. RETURN
  131.  
  132. C '-'
  133. 27 CONTINUE
  134.  
  135. IF(IKAS.EQ.1)THEN
  136. DO 271 K=1,LONG
  137. V(K)=XVAL1-V2(K)
  138. 271 CONTINUE
  139. ELSEIF(IKAS.EQ.2)THEN
  140. DO 272 K=1,LONG
  141. V(K)=V1(K)-XVAL2
  142. 272 CONTINUE
  143. ELSE
  144. DO 273 K=1,LONG
  145. V(K)=V1(K)-V2(K)
  146. 273 CONTINUE
  147. ENDIF
  148. RETURN
  149.  
  150.  
  151. C '|<'
  152. 28 CONTINUE
  153.  
  154. IF(IKAS.EQ.1)THEN
  155. DO 281 K=1,LONG
  156. V(K)=XVAL1**V2(K)
  157. 281 CONTINUE
  158. ELSEIF(IKAS.EQ.2)THEN
  159. DO 282 K=1,LONG
  160. V(K)=V1(K)**XVAL2
  161. 282 CONTINUE
  162. ELSE
  163. DO 283 K=1,LONG
  164. V(K)=V1(K)**V2(K)
  165. 283 CONTINUE
  166. ENDIF
  167. RETURN
  168.  
  169. C '|<'
  170. 29 CONTINUE
  171.  
  172. IF(IKAS.EQ.1)THEN
  173. DO 291 K=1,LONG
  174. V(K)= MAX(XVAL1,V2(K))
  175. 291 CONTINUE
  176. ELSEIF(IKAS.EQ.2)THEN
  177. DO 292 K=1,LONG
  178. V(K)= MAX(V1(K),XVAL2)
  179. 292 CONTINUE
  180. ELSE
  181. DO 293 K=1,LONG
  182. V(K)= MAX(V1(K),V2(K))
  183. 293 CONTINUE
  184. ENDIF
  185. RETURN
  186.  
  187. C '>|'
  188. 30 CONTINUE
  189.  
  190. IF(IKAS.EQ.1)THEN
  191. DO 301 K=1,LONG
  192. V(K)=MIN(XVAL1,V2(K))
  193. 301 CONTINUE
  194. ELSEIF(IKAS.EQ.2)THEN
  195. DO 302 K=1,LONG
  196. V(K)=MIN(V1(K),XVAL2)
  197. 302 CONTINUE
  198. ELSE
  199. DO 303 K=1,LONG
  200. V(K)=MIN(V1(K),V2(K))
  201. 303 CONTINUE
  202. ENDIF
  203. RETURN
  204.  
  205. C 'GRAD'
  206. 31 CONTINUE
  207. RETURN
  208.  
  209. C 'ROT'
  210. 32 CONTINUE
  211. RETURN
  212.  
  213. END
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  

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