/[MITgcm]/MITgcm/eesupp/src/gsum.F
ViewVC logotype

Annotation of /MITgcm/eesupp/src/gsum.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.5 - (hide annotations) (download)
Sun Feb 4 14:38:43 2001 UTC (23 years, 3 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, checkpoint38, checkpoint40pre2, checkpoint40pre4, pre38tag1, c37_adj, pre38-close, checkpoint39, checkpoint37, checkpoint36, checkpoint35, checkpoint40pre5, checkpoint40
Branch point for: pre38
Changes since 1.4: +2 -0 lines 
Made sure each .F and .h file had
the CVS keywords Header and Name at its start.
Most had header but very few currently have Name, so
lots of changes!
1 cnh 1.5 C $Header: $
2     C $Name: $
3 cnh 1.1 #include "CPP_EEOPTIONS.h"
4    
5     SUBROUTINE GSUM_R8_INIT( myThid )
6 adcroft 1.3 IMPLICIT NONE
7 cnh 1.1 #include "SIZE.h"
8     #include "EEPARAMS.h"
9     #include "EESUPPORT.h"
10     C
11     COMMON /GS_R8_BUFFER_R/
12     & GSR8_value
13     Real*8 GSR8_value(lShare8,MAX_NO_THREADS)
14     #define _NOT_SET_ 1.23456D12
15     COMMON /GS_R8_BUFFER_I/
16     & GSR8_level
17     INTEGER GSR8_level
18     C
19     INTEGER myThid
20     INTEGER I
21     C
22     GSR8_level = 1
23     DO I = 1, lShare8
24     GSR8_value(I,myThid) = _NOT_SET_
25     ENDDO
26     C
27     RETURN
28     END
29     SUBROUTINE GSUM_R8( myPhi, answer, myThid )
30 adcroft 1.3 IMPLICIT NONE
31 cnh 1.1 #include "SIZE.h"
32     #include "EEPARAMS.h"
33     #include "EESUPPORT.h"
34     C
35     Real*8 myPhi
36     Real*8 answer
37     INTEGER myThid
38     #ifdef ALLOW_USE_MPI
39     Real*8 tmp, sumPhi
40     INTEGER mpiRc
41     #endif
42     C
43     INTEGER nDone
44     INTEGER I
45     INTEGER curLev, prevLev
46     C
47     COMMON /GS_R8_BUFFER_R/
48     & GSR8_value
49     Real*8 GSR8_value(lShare8,MAX_NO_THREADS)
50     #define _NOT_SET_ 1.23456D12
51     COMMON /GS_R8_BUFFER_I/
52     & GSR8_level
53     INTEGER GSR8_level
54    
55     C answer = 1.
56     C CALL BAR2(myThid)
57     C CALL BAR2(myThid)
58     C CALL BAR2(myThid)
59     C RETURN
60     C
61     IF ( myThid .NE. 1 ) THEN
62    
63     curLev = GSR8_level
64     GSR8_value(curLev,myThid) = myPhi
65     10 CONTINUE
66     IF ( GSR8_value(curLev,1) .NE. _NOT_SET_ ) GOTO 11
67     CALL FOOL_THE_COMPILER( GSR8_value )
68     GOTO 10
69     11 CONTINUE
70     GSR8_value(curLev,myThid) = _NOT_SET_
71     answer = GSR8_value(curLev,1)
72    
73     ELSE
74    
75     curLev = GSR8_level
76     prevLev = curLev+1
77     IF ( prevLev .GT. 2 ) prevLev = 1
78    
79     12 CONTINUE
80     CALL FOOL_THE_COMPILER( GSR8_value )
81     nDone = 1
82     DO I = 2, nThreads
83     IF ( GSR8_value(curLev,I) .NE. _NOT_SET_ ) nDone = nDone+1
84     ENDDO
85     IF ( nDone .LT. nThreads ) GOTO 12
86    
87     GSR8_level = prevLev
88     CALL FOOL_THE_COMPILER( GSR8_value )
89     GSR8_value(prevLev,1) = _NOT_SET_
90    
91     answer = myPhi
92     DO I = 2,nThreads
93     answer = answer+GSR8_value(curLev,I)
94     ENDDO
95    
96     #ifdef ALLOW_USE_MPI
97     #ifndef ALWAYS_USE_MPI
98     IF ( usingMPI ) THEN
99     #endif
100     tmp = answer
101     CALL MPI_Allreduce(tmp,sumPhi,1,MPI_DOUBLE_PRECISION,MPI_SUM,
102 adcroft 1.2 & MPI_COMM_MODEL,mpiRC)
103 cnh 1.1 answer = sumPhi
104     #ifndef ALWAYS_USE_MPI
105     ENDIF
106     #endif
107     #endif /* ALLOW_USE_MPI */
108    
109     GSR8_value(curLev,1) = answer
110    
111     ENDIF
112     C
113     RETURN
114     END
  ViewVC Help
Powered by ViewVC 1.1.22