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-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
294 |
|
|
295 |
CBOP 0 |
CBOP 0 |
296 |
C !ROUTINE: diagnostics_get_pointers |
C !ROUTINE: diagnostics_get_pointers |
297 |
C !INTERFACE: |
C !INTERFACE: |