source:
tags/nemo_dev_x1/NEMO/OPA_SRC/lib_cray.f90
@
1512
Last change on this file since 1512 was 46, checked in by cvs2svn, 20 years ago | |
---|---|
|
|
File size: 1.5 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 | !--------------------------------------------------------- | |
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 1 N=1,I | |
42 | Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K) | |
43 | 1 CONTINUE | |
44 | RETURN | |
45 | END | |
46 | !--------------------------------------------------------- | |
47 | FUNCTION ISRCHNE(K,X,I,B) | |
48 | DIMENSION X(1) | |
49 | DO 1 N=1,K | |
50 | IF(X(1+(N-1)*I) /= B)THEN | |
51 | ISRCHNE=N | |
52 | RETURN | |
53 | ELSE | |
54 | ISRCHNE=N+1 | |
55 | ENDIF | |
56 | 1 CONTINUE | |
57 | RETURN | |
58 | END |
Note: See TracBrowser
for help on using the repository browser.