/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_sum_levels.F
ViewVC logotype

Contents of /MITgcm/pkg/diagnostics/diagnostics_sum_levels.F

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

Revision 1.2 - (show annotations) (download)
Wed Jan 13 01:20:38 2010 UTC (14 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.1: +3 -3 lines 
fix for variables at corner location (Z-point)
1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_sum_levels.F,v 1.1 2010/01/11 19:42:32 jmc Exp $
2 C $Name: $
3
4 #include "DIAG_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP 0
8 C !ROUTINE: DIAGNOSTICS_SUM_LEVELS
9
10 C !INTERFACE:
11 SUBROUTINE DIAGNOSTICS_SUM_LEVELS(
12 I listId, md, ndId, ip, im, lm,
13 U fld3d,
14 I undef,
15 I myTime, myIter, myThid )
16
17 C !DESCRIPTION:
18 C Cumulate selected levels from a multi-level diagnostics field
19 C before writing to file this level integrated output
20 C (e.g., can be used to integrate vertically an Nr field).
21
22 C !USES:
23 IMPLICIT NONE
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "GRID.h"
28 #include "DIAGNOSTICS_SIZE.h"
29 #include "DIAGNOSTICS.h"
30
31 INTEGER NrMax
32 PARAMETER( NrMax = numLevels )
33
34 C !INPUT PARAMETERS:
35 C listId :: Diagnostics list number being written
36 C md :: field number in the list "listId".
37 C ndId :: diagnostics Id number (in available diagnostics list)
38 C ip :: diagnostics pointer to storage array
39 C im :: counter-mate pointer to storage array
40 C lm :: index in the averageCycle
41 C fld3d :: diagnostics field output array
42 C undef ::
43 C myTime :: current time of simulation (s)
44 C myIter :: current iteration number
45 C myThid :: my Thread Id number
46 INTEGER listId, md, ndId, ip, im, lm
47 _RL fld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
48 _RL undef
49 _RL myTime
50 INTEGER myIter, myThid
51 CEOP
52
53 C !FUNCTIONS:
54
55 C !LOCAL VARIABLES:
56 C i,j,k :: loop indices
57 INTEGER i, j, k
58 INTEGER bi, bj
59 INTEGER kLev
60 _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61 _RL tmpFac, hFacLoc
62 c CHARACTER*(MAX_LEN_MBUF) msgBuf
63 CHARACTER*(10) gcode
64
65 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66
67 IF (fflags(listId)(2:2).EQ.'I') THEN
68
69 gcode = gdiag(ndId)(1:10)
70
71 C-- start loops on tile indices bi,bj:
72 DO bj = myByLo(myThid), myByHi(myThid)
73 DO bi = myBxLo(myThid), myBxHi(myThid)
74
75 DO j = 1-OLy,sNy+OLy
76 DO i = 1-OLx,sNx+OLx
77 tmpFld(i,j) = 0. _d 0
78 ENDDO
79 ENDDO
80
81 IF ( gcode(3:3).EQ.' ' ) THEN
82 C-- Cumulate levels directly:
83
84 DO k = 1,nlevels(listId)
85 kLev = NINT(levs(k,listId))
86 DO j = 1-OLy,sNy+OLy
87 DO i = 1-OLx,sNx+OLx
88 tmpFld(i,j) = tmpFld(i,j) + fld3d(i,j,kLev,bi,bj)
89 ENDDO
90 ENDDO
91 ENDDO
92 DO j = 1-OLy,sNy+OLy
93 DO i = 1-OLx,sNx+OLx
94 fld3d(i,j,1,bi,bj) = tmpFld(i,j)
95 ENDDO
96 ENDDO
97
98 ELSEIF ( gcode(3:3).EQ.'r' ) THEN
99 C-- Cumulate the level-thickness product:
100
101 DO k = 1,nlevels(listId)
102 kLev = NINT(levs(k,listId))
103 IF ( gcode(9:9).EQ.'L' ) THEN
104 tmpFac = drC(kLev)
105 ELSE
106 tmpFac = drF(kLev)
107 ENDIF
108 DO j = 1-OLy,sNy+OLy
109 DO i = 1-OLx,sNx+OLx
110 tmpFld(i,j) = tmpFld(i,j)
111 & + tmpFac*fld3d(i,j,kLev,bi,bj)
112 ENDDO
113 ENDDO
114 ENDDO
115 DO j = 1-OLy,sNy+OLy
116 DO i = 1-OLx,sNx+OLx
117 fld3d(i,j,1,bi,bj) = tmpFld(i,j)
118 ENDDO
119 ENDDO
120
121 ELSEIF ( gcode(3:3).EQ.'R' ) THEN
122 C-- Cumulate the level-thickness & hFac product:
123
124 IF ( gcode(2:2).EQ.'M' ) THEN
125 DO k = 1,nlevels(listId)
126 kLev = NINT(levs(k,listId))
127 IF ( gcode(9:9).EQ.'L' ) THEN
128 tmpFac = drC(kLev)
129 ELSE
130 tmpFac = drF(kLev)
131 ENDIF
132 DO j = 1-OLy,sNy+OLy
133 DO i = 1-OLx,sNx+OLx
134 tmpFld(i,j) = tmpFld(i,j)
135 & + tmpFac*fld3d(i,j,kLev,bi,bj)
136 & *hFacC(i,j,kLev,bi,bj)
137 ENDDO
138 ENDDO
139 ENDDO
140 ELSEIF ( gcode(2:2).EQ.'U' ) THEN
141 DO k = 1,nlevels(listId)
142 kLev = NINT(levs(k,listId))
143 IF ( gcode(9:9).EQ.'L' ) THEN
144 tmpFac = drC(kLev)
145 ELSE
146 tmpFac = drF(kLev)
147 ENDIF
148 DO j = 1-OLy,sNy+OLy
149 DO i = 1-OLx,sNx+OLx
150 tmpFld(i,j) = tmpFld(i,j)
151 & + tmpFac*fld3d(i,j,kLev,bi,bj)
152 & *hFacW(i,j,kLev,bi,bj)
153 ENDDO
154 ENDDO
155 ENDDO
156 ELSEIF ( gcode(2:2).EQ.'V' ) THEN
157 DO k = 1,nlevels(listId)
158 kLev = NINT(levs(k,listId))
159 IF ( gcode(9:9).EQ.'L' ) THEN
160 tmpFac = drC(kLev)
161 ELSE
162 tmpFac = drF(kLev)
163 ENDIF
164 DO j = 1-OLy,sNy+OLy
165 DO i = 1-OLx,sNx+OLx
166 tmpFld(i,j) = tmpFld(i,j)
167 & + tmpFac*fld3d(i,j,kLev,bi,bj)
168 & *hFacS(i,j,kLev,bi,bj)
169 ENDDO
170 ENDDO
171 ENDDO
172 ELSEIF ( gcode(2:2).EQ.'Z' ) THEN
173 DO k = 1,nlevels(listId)
174 kLev = NINT(levs(k,listId))
175 IF ( gcode(9:9).EQ.'L' ) THEN
176 tmpFac = drC(kLev)
177 ELSE
178 tmpFac = drF(kLev)
179 ENDIF
180 DO j = 2-OLy,sNy+OLy
181 DO i = 2-OLx,sNx+OLx
182 hFacLoc = MIN(
183 & hFacW( i, j, kLev,bi,bj),
184 & hFacW( i,j-1,kLev,bi,bj),
185 & hFacS( i, j, kLev,bi,bj),
186 & hFacS(i-1,j, kLev,bi,bj)
187 & )
188 tmpFld(i,j) = tmpFld(i,j)
189 & + tmpFac*fld3d(i,j,kLev,bi,bj)
190 & *hFacLoc
191 ENDDO
192 ENDDO
193 ENDDO
194 ELSE
195 STOP 'DIAGNOSTICS_SUM_LEVELS: invalid gcode(2)'
196 ENDIF
197 DO j = 1-OLy,sNy+OLy
198 DO i = 1-OLx,sNx+OLx
199 fld3d(i,j,1,bi,bj) = tmpFld(i,j)
200 ENDDO
201 ENDDO
202
203 ELSE
204 STOP 'DIAGNOSTICS_SUM_LEVELS: Bad gcode(3) option'
205 ENDIF
206
207 C- end bi,bj loops
208 ENDDO
209 ENDDO
210
211 ENDIF
212
213 RETURN
214 END
  ViewVC Help
Powered by ViewVC 1.1.22