pkg/diagnostics/diagnostics_write_pickup.F

C $Header:  $
C $Name:  $

#include "DIAG_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: DIAGNOSTICS_WRITE_PICKUP 
C     !INTERFACE:
      SUBROUTINE DIAGNOSTICS_WRITE_PICKUP(
     I     suff, 
     I     myTime,
     I     myIter,
     I     myThid )

C     !DESCRIPTION:
C     Writes current state of the diagnostics package.

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
C     myTime  :: current time
C     myIter  :: time-step number
C     myThid  :: Number of this instance
      CHARACTER*(*) suff
      _RL myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_DIAGNOSTICS

C     !LOCAL VARIABLES:
C     fn      :: character buffer for creating filename
C     prec    :: precision of pickup files
C     lgf     :: flag to write "global" files
c     INTEGER prec, iChar, lChar, k
      INTEGER prec, lChar, k, i
      CHARACTER*(MAX_LEN_FNAM) fn
      LOGICAL lgf

      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK

CEOP

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      IF (diag_pickup_write) THEN

        DO i = 1,MAX_LEN_FNAM
          fn(i:i) = ' '
        ENDDO
        lChar = ILNBLNK(suff)
        WRITE(fn,'(A,A)') 'pickup_diagnostics.',suff(1:lChar)
        prec = precFloat64
        lgf = globalFiles
        
#ifdef ALLOW_MNC
C       IF (useMNC .AND. diag_pickup_write_mnc) THEN
C       ENDIF
#endif
        
        IF (diag_pickup_write_mdsio) THEN
          CALL MDSWRITEFIELD(fn,prec,lgf,'RL',numdiags,qdiag,
     &         1,myIter,myThid)
        ENDIF

      ENDIF

#endif /* ALLOW_DIAGNOSTICS */

      RETURN
      END
1	C $Header: $
2	C $Name: $
3
4	#include "DIAG_OPTIONS.h"
5
6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	CBOP
8	C !ROUTINE: DIAGNOSTICS_WRITE_PICKUP
9	C !INTERFACE:
10	SUBROUTINE DIAGNOSTICS_WRITE_PICKUP(
11	I suff,
12	I myTime,
13	I myIter,
14	I myThid )
15
16	C !DESCRIPTION:
17	C Writes current state of the diagnostics package.
18
19	C !USES:
20	IMPLICIT NONE
21
22	C == Global variables ===
23	#include "SIZE.h"
24	#include "EEPARAMS.h"
25	#include "PARAMS.h"
26	#include "DIAGNOSTICS_SIZE.h"
27	#include "DIAGNOSTICS.h"
28
29	C !INPUT/OUTPUT PARAMETERS:
30	C suff :: suffix for pickup file (eg. ckptA or 0000000010)
31	C myTime :: current time
32	C myIter :: time-step number
33	C myThid :: Number of this instance
34	CHARACTER() suff
35	_RL myTime
36	INTEGER myIter
37	INTEGER myThid
38
39	#ifdef ALLOW_DIAGNOSTICS
40
41	C !LOCAL VARIABLES:
42	C fn :: character buffer for creating filename
43	C prec :: precision of pickup files
44	C lgf :: flag to write "global" files
45	c INTEGER prec, iChar, lChar, k
46	INTEGER prec, lChar, k, i
47	CHARACTER*(MAX_LEN_FNAM) fn
48	LOGICAL lgf
49
50	INTEGER ILNBLNK
51	EXTERNAL ILNBLNK
52
53	CEOP
54
55	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
56
57	IF (diag_pickup_write) THEN
58
59	DO i = 1,MAX_LEN_FNAM
60	fn(i:i) = ' '
61	ENDDO
62	lChar = ILNBLNK(suff)
63	WRITE(fn,'(A,A)') 'pickup_diagnostics.',suff(1:lChar)
64	prec = precFloat64
65	lgf = globalFiles
66
67	#ifdef ALLOW_MNC
68	C IF (useMNC .AND. diag_pickup_write_mnc) THEN
69	C ENDIF
70	#endif
71
72	IF (diag_pickup_write_mdsio) THEN
73	CALL MDSWRITEFIELD(fn,prec,lgf,'RL',numdiags,qdiag,
74	& 1,myIter,myThid)
75	ENDIF
76
77	ENDIF
78
79	#endif /* ALLOW_DIAGNOSTICS */
80
81	RETURN
82	END