source:
trunk/NEMO/OPA_SRC/lib_cray.f90
@
145
Last change on this file since 145 was 88, checked in by opalod, 20 years ago | |
---|---|
|
|
File size: 1.6 KB |
Rev | Line | |
---|---|---|
[3] | 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 | !--------------------------------------------------------- | |
[88] | 11 | FUNCTION sdot( I, X, J, Y, K ) |
[3] | 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 | |
[88] | 17 | END FUNCTION sdot |
[3] | 18 | !--------------------------------------------------------- |
[88] | 19 | SUBROUTINE wheneq ( i, x, j, t, ind, nn ) |
[3] | 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 | ||
[88] | 37 | END SUBROUTINE wheneq |
[3] | 38 | !--------------------------------------------------------- |
[88] | 39 | SUBROUTINE saxpy( I, A, X, J, Y, K ) |
[3] | 40 | DIMENSION X(1),Y(1) |
[88] | 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 | |
[3] | 45 | !--------------------------------------------------------- |
[88] | 46 | FUNCTION isrchne( K, X, I, B ) |
[3] | 47 | DIMENSION X(1) |
[88] | 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.