source:
tags/nemo_dev_x6/NEMO/OPA_SRC/lib_cray.f90
@
9319
Last change on this file since 9319 was 88, checked in by opalod, 20 years ago | |
---|---|
|
|
File size: 1.6 KB |
Line | |
---|---|
1 | ! Cray subroutines or functions used by OPA model and possibly |
2 | ! not found on other platforms. |
3 | ! |
4 | ! check their existence |
5 | ! |
6 | ! sdot |
7 | ! wheneq |
8 | ! saxpy |
9 | ! isrchne |
10 | !--------------------------------------------------------- |
11 | FUNCTION sdot( I, X, J, Y, K ) |
12 | DIMENSION X(1), Y(1) |
13 | SDOT = 0. |
14 | DO N = 1, I |
15 | SDOT = SDOT + X(1+(N-1)*J) * Y(1+(N-1)*K) |
16 | END DO |
17 | END FUNCTION sdot |
18 | !--------------------------------------------------------- |
19 | SUBROUTINE wheneq ( i, x, j, t, ind, nn ) |
20 | IMPLICIT NONE |
21 | |
22 | INTEGER , INTENT ( in ) :: i, j |
23 | INTEGER , INTENT ( out ) :: nn |
24 | REAL , INTENT ( in ), DIMENSION (1+(i-1)*j) :: x |
25 | REAL , INTENT ( in ) :: t |
26 | INTEGER , INTENT ( out ), DIMENSION (1+(i-1)*j) :: ind |
27 | INTEGER :: n, k |
28 | nn = 0 |
29 | DO n = 1, i |
30 | k = 1 + (n-1) * j |
31 | IF ( x ( k) == t ) THEN |
32 | nn = nn + 1 |
33 | ind (nn) = k |
34 | ENDIF |
35 | END DO |
36 | |
37 | END SUBROUTINE wheneq |
38 | !--------------------------------------------------------- |
39 | SUBROUTINE saxpy( I, A, X, J, Y, K ) |
40 | DIMENSION X(1),Y(1) |
41 | DO N = 1, I |
42 | Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K) |
43 | END DO |
44 | END SUBROUTINE saxpy |
45 | !--------------------------------------------------------- |
46 | FUNCTION isrchne( K, X, I, B ) |
47 | DIMENSION X(1) |
48 | DO N = 1, K |
49 | IF( X(1+(N-1)*I) /= B ) THEN |
50 | ISRCHNE = N |
51 | RETURN |
52 | ELSE |
53 | ISRCHNE = N + 1 |
54 | ENDIF |
55 | END DO |
56 | END FUNCTION isrchne |
Note: See TracBrowser
for help on using the repository browser.