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

Annotation of /MITgcm/pkg/diagnostics/diagnostics_write_pickup.F

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

Revision 1.10 - (hide annotations) (download)
Thu Aug 27 18:00:01 2009 UTC (14 years, 9 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, checkpoint62, 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, checkpoint61v, checkpoint61w, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.9: +10 -22 lines 
use type specific (RL or RS) S/R from rw pkg instead of calling old S/R
 MDSREADFIELD,MDSWRITEFIELD from mdsio pkg.
1 jmc 1.10 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_write_pickup.F,v 1.9 2008/02/05 15:31:19 jmc Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP
8 jmc 1.9 C !ROUTINE: DIAGNOSTICS_WRITE_PICKUP
9 edhill 1.1 C !INTERFACE:
10     SUBROUTINE DIAGNOSTICS_WRITE_PICKUP(
11 jmc 1.9 I isPerm,
12     I suff,
13 edhill 1.1 I myTime,
14     I myIter,
15     I myThid )
16    
17     C !DESCRIPTION:
18     C Writes current state of the diagnostics package.
19    
20     C !USES:
21     IMPLICIT NONE
22    
23     C == Global variables ===
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26     #include "PARAMS.h"
27     #include "DIAGNOSTICS_SIZE.h"
28     #include "DIAGNOSTICS.h"
29    
30     C !INPUT/OUTPUT PARAMETERS:
31 edhill 1.8 C isPerm :: permanent checkpoint flag
32 edhill 1.1 C suff :: suffix for pickup file (eg. ckptA or 0000000010)
33     C myTime :: current time
34     C myIter :: time-step number
35     C myThid :: Number of this instance
36 edhill 1.8 LOGICAL isPerm
37 edhill 1.1 CHARACTER*(*) suff
38     _RL myTime
39     INTEGER myIter
40     INTEGER myThid
41    
42 edhill 1.5 #ifdef DIAGNOSTICS_HAS_PICKUP
43 edhill 1.1
44     C !LOCAL VARIABLES:
45     C fn :: character buffer for creating filename
46     C prec :: precision of pickup files
47     c INTEGER prec, iChar, lChar, k
48 jmc 1.10 INTEGER prec, lChar, sn
49 edhill 1.1 CHARACTER*(MAX_LEN_FNAM) fn
50    
51     INTEGER ILNBLNK
52     EXTERNAL ILNBLNK
53    
54 edhill 1.6 INTEGER dUnit, n, m
55 edhill 1.4
56 edhill 1.2 #ifdef ALLOW_MNC
57 jmc 1.10 INTEGER i, ii
58 edhill 1.2 CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
59     INTEGER CW_DIMS, NLEN
60     PARAMETER ( CW_DIMS = 10 )
61     PARAMETER ( NLEN = 80 )
62     INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
63     CHARACTER*(NLEN) dn(CW_DIMS)
64     CHARACTER*(NLEN) d_cw_name
65     CHARACTER*(NLEN) dn_blnk
66     #endif /* ALLOW_MNC */
67    
68 edhill 1.1 CEOP
69    
70     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
71    
72     IF (diag_pickup_write) THEN
73    
74 edhill 1.2 #ifdef ALLOW_MNC
75     IF (diag_pickup_write_mnc) THEN
76     DO i = 1,NLEN
77     dn_blnk(i:i) = ' '
78     ENDDO
79     DO i = 1,MAX_LEN_FNAM
80     diag_mnc_bn(i:i) = ' '
81     ENDDO
82 jmc 1.9
83 edhill 1.8 IF ( isPerm ) THEN
84     WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'
85     ELSE
86     ii = ILNBLNK(suff)
87     WRITE(diag_mnc_bn,'(A,A)')
88     & 'pickup_diagnostics.',suff(1:ii)
89     ENDIF
90    
91     CALL MNC_CW_SET_UDIM(fn, 0, myThid)
92     IF ( isPerm ) THEN
93     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
94     ELSE
95     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
96     ENDIF
97     C Then set the actual unlimited dimension
98     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
99 edhill 1.2
100     C Update the record dimension by writing the iteration number
101 edhill 1.7 CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)
102     CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
103 edhill 1.4
104     C Write the qdiag() array
105 edhill 1.2 d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
106     DO ii = 1,CW_DIMS
107     dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
108     ENDDO
109     d_cw_name(1:10) = 'diag_state'
110     dn(1)(1:3) = 'Xp1'
111     dim(1) = sNx + 2*OLx
112     ib(1) = OLx + 1
113     ie(1) = OLx + sNx + 1
114     dn(2)(1:3) = 'Yp1'
115     dim(2) = sNy + 2*OLy
116     ib(2) = OLy + 1
117     ie(2) = OLy + sNy + 1
118 edhill 1.4 dn(3)(1:2) = 'Nd'
119 jmc 1.9 dim(3) = numDiags
120 edhill 1.2 ib(3) = 1
121 jmc 1.9 ie(3) = numDiags
122 edhill 1.2 dn(4)(1:1) = 'T'
123     dim(4) = -1
124     ib(4) = 1
125     ie(4) = 1
126 jmc 1.9
127     CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
128 edhill 1.2 & dim, dn, ib, ie, myThid)
129 jmc 1.9 CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
130 edhill 1.2 & 4,5, myThid)
131     CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
132     & 'diagnostics state',myThid)
133 jmc 1.9
134 edhill 1.2 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
135     & d_cw_name, qdiag, myThid)
136 jmc 1.9
137 edhill 1.2 CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
138     CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
139 edhill 1.4
140     C Write the ndiag() array
141     d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
142     DO ii = 1,CW_DIMS
143     dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
144     ENDDO
145     d_cw_name(1:10) = 'diag_count'
146     dn(1)(1:2) = 'Nd'
147 jmc 1.9 dim(1) = numDiags
148 edhill 1.4 ib(1) = 1
149 jmc 1.9 ie(1) = numDiags
150 edhill 1.4 dn(2)(1:1) = 'T'
151     dim(2) = -1
152     ib(2) = 1
153     ie(2) = 1
154    
155 jmc 1.9 CALL MNC_CW_ADD_GNAME(d_cw_name, 2,
156 edhill 1.4 & dim, dn, ib, ie, myThid)
157 jmc 1.9 CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
158 edhill 1.4 & 4,5, myThid)
159     CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
160     & 'diagnostics state',myThid)
161 jmc 1.9
162 edhill 1.6 CALL MNC_CW_I_W('I',diag_mnc_bn,0,0,
163 edhill 1.4 & d_cw_name, ndiag, myThid)
164 jmc 1.9
165 edhill 1.4 CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
166     CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
167    
168    
169 edhill 1.2 ENDIF
170     #endif
171 jmc 1.9
172 edhill 1.1 IF (diag_pickup_write_mdsio) THEN
173 edhill 1.4
174     sn = ILNBLNK(suff)
175    
176     C Write qdiag()
177 jmc 1.10 WRITE(fn,'(a,a)') 'pickup_qdiag.', suff(1:sn)
178 edhill 1.4 prec = precFloat64
179 jmc 1.10 CALL WRITE_REC_3D_RL( fn, prec, numDiags, qdiag,
180     & 1, myIter, myThid )
181 edhill 1.4
182     C Write ndiag()
183 jmc 1.10 _BARRIER
184     _BEGIN_MASTER( myThid )
185 edhill 1.4 WRITE(fn,'(a,a)') 'pickup_ndiag.', suff(1:sn)
186     CALL MDSFINDUNIT( dUnit, mythid )
187     OPEN( dUnit, file=fn )
188 edhill 1.6 DO n = 1,nlists
189     DO m = 1,nfields(n)
190 jmc 1.10 WRITE(dUnit,'(I10)') ndiag(jdiag(m,n),1,1)
191 edhill 1.6 ENDDO
192 edhill 1.4 ENDDO
193     CLOSE( dUnit )
194     _END_MASTER( myThid )
195 jmc 1.10 _BARRIER
196 edhill 1.1 ENDIF
197    
198     ENDIF
199    
200 edhill 1.5 #endif /* DIAGNOSTICS_HAS_PICKUP */
201 edhill 1.1
202     RETURN
203     END
  ViewVC Help
Powered by ViewVC 1.1.22