New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
lib_cray.f90 in trunk/NEMO/OPA_SRC – NEMO

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

CT : UPDATE057 : # General syntax, alignement, comments corrections

# l_ctl alone replace the set (l_ctl .AND. lwp)
# Add of diagnostics which are activated when using l_ctl logical

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
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.