220 |
|
|
221 |
RETURN |
RETURN |
222 |
END |
END |
223 |
|
|
224 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
225 |
|
|
226 |
|
CBOP 0 |
227 |
|
C !ROUTINE: DIAGS_MK_TITLE |
228 |
|
|
229 |
|
C !INTERFACE: |
230 |
|
CHARACTER*80 FUNCTION DIAGS_MK_TITLE( |
231 |
|
I diagTitleInPieces, myThid ) |
232 |
|
|
233 |
|
C !DESCRIPTION: |
234 |
|
C *==========================================================* |
235 |
|
C | FUNCTION DIAGS_MK_TITLE |
236 |
|
C | o Return the diagnostic title string (80c) removing |
237 |
|
C | consecutive blanks from the input string |
238 |
|
C *==========================================================* |
239 |
|
|
240 |
|
C !USES: |
241 |
|
IMPLICIT NONE |
242 |
|
#include "EEPARAMS.h" |
243 |
|
|
244 |
|
C !INPUT PARAMETERS: |
245 |
|
C diagTitleInPieces :: string for diagnostic units: in several |
246 |
|
C pieces, with blanks in between |
247 |
|
C myThid :: my Thread Id number |
248 |
|
CHARACTER*(*) diagTitleInPieces |
249 |
|
INTEGER myThid |
250 |
|
CEOP |
251 |
|
|
252 |
|
C !LOCAL VARIABLES: |
253 |
|
CHARACTER*(MAX_LEN_MBUF) msgBuf |
254 |
|
LOGICAL flag |
255 |
|
INTEGER i,j,n |
256 |
|
|
257 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
258 |
|
|
259 |
|
DIAGS_MK_TITLE = ' ' |
260 |
|
& //' ' |
261 |
|
n = LEN(diagTitleInPieces) |
262 |
|
|
263 |
|
j = 0 |
264 |
|
flag = .FALSE. |
265 |
|
DO i=1,n |
266 |
|
IF (diagTitleInPieces(i:i) .NE. ' ' ) THEN |
267 |
|
IF ( flag ) THEN |
268 |
|
j = j+1 |
269 |
|
IF (j.LE.80) DIAGS_MK_TITLE(j:j) = ' ' |
270 |
|
ENDIF |
271 |
|
j = j+1 |
272 |
|
IF ( j.LE.80 ) DIAGS_MK_TITLE(j:j) = diagTitleInPieces(i:i) |
273 |
|
flag = .FALSE. |
274 |
|
ELSE |
275 |
|
flag = j.GE.1 |
276 |
|
ENDIF |
277 |
|
ENDDO |
278 |
|
|
279 |
|
IF ( j.GT.80 ) THEN |
280 |
|
WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ', |
281 |
|
& 'DIAGS_MK_TITLE: too long (',j,' >80) input string' |
282 |
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
283 |
|
& SQUEEZE_RIGHT , myThid) |
284 |
|
WRITE(msgBuf,'(3A)') '**WARNING** ', |
285 |
|
& 'DIAGS_MK_TITLE: input=', diagTitleInPieces |
286 |
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
287 |
|
& SQUEEZE_RIGHT , myThid) |
288 |
|
ENDIF |
289 |
|
|
290 |
|
RETURN |
291 |
|
END |
292 |
|
|
293 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
294 |
|
|
295 |
|
CBOP 0 |
296 |
|
C !ROUTINE: diagnostics_get_pointers |
297 |
|
C !INTERFACE: |
298 |
|
subroutine diagnostics_get_pointers(diagName,ipoint,jpoint,myThid) |
299 |
|
|
300 |
|
C !DESCRIPTION: |
301 |
|
C *==========================================================* |
302 |
|
C | subroutine diagnostics_get_pointers |
303 |
|
C | o Returns the idiag and jdiag pointers for a |
304 |
|
C | specified diagnostic - returns 0 if not active |
305 |
|
C *==========================================================* |
306 |
|
|
307 |
|
C !USES: |
308 |
|
IMPLICIT NONE |
309 |
|
#include "EEPARAMS.h" |
310 |
|
#include "SIZE.h" |
311 |
|
#include "DIAGNOSTICS_SIZE.h" |
312 |
|
#include "DIAGNOSTICS.h" |
313 |
|
|
314 |
|
C !INPUT PARAMETERS: |
315 |
|
C diagName :: diagnostic identificator name (8 characters long) |
316 |
|
C myThid :: my thread Id number |
317 |
|
C !OUTPUT PARAMETERS: |
318 |
|
C ipoint :: pointer value into qdiag array |
319 |
|
C jpoint :: pointer value into diagnostics list |
320 |
|
|
321 |
|
CHARACTER*8 diagName |
322 |
|
INTEGER ipoint, jpoint, myThid |
323 |
|
CEOP |
324 |
|
|
325 |
|
C !LOCAL VARIABLES: |
326 |
|
INTEGER n,m |
327 |
|
|
328 |
|
ipoint = 0 |
329 |
|
jpoint = 0 |
330 |
|
|
331 |
|
C- search for this diag. in the active 2D/3D diagnostics list |
332 |
|
DO n=1,nlists |
333 |
|
DO m=1,nActive(n) |
334 |
|
IF ( diagName.EQ.flds(m,n) .AND. idiag(m,n).NE.0 ) THEN |
335 |
|
ipoint = abs(idiag(m,n)) |
336 |
|
jpoint = jdiag(m,n) |
337 |
|
ENDIF |
338 |
|
ENDDO |
339 |
|
ENDDO |
340 |
|
|
341 |
|
RETURN |
342 |
|
END |