/[MITgcm]/MITgcm_contrib/darwin2/pkg/darwin/dic_write_pickup.F
ViewVC logotype

Annotation of /MITgcm_contrib/darwin2/pkg/darwin/dic_write_pickup.F

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


Revision 1.2 - (hide annotations) (download)
Mon Jan 14 16:50:46 2013 UTC (12 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt64h_20130528, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt64f_20130405, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt64e_20130305, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt64c_20130120, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt64d_20130219
Changes since 1.1: +6 -1 lines
- add missing value argument to S/R MDS_WR_METAFILES argument list

1 jmc 1.2 C $Header: $
2     C $Name: $
3    
4 jahn 1.1 #include "CPP_OPTIONS.h"
5     #include "PTRACERS_OPTIONS.h"
6     #include "DARWIN_OPTIONS.h"
7    
8     #ifdef ALLOW_PTRACERS
9     #ifdef ALLOW_DARWIN
10    
11     #ifdef ALLOW_CARBON
12    
13     CBOP
14     C !ROUTINE: DIC_WRITE_PICKUP
15    
16     C !INTERFACE: ==========================================================
17     SUBROUTINE DIC_WRITE_PICKUP( permPickup,
18     I suff, myTime, myIter, myThid )
19    
20     C !DESCRIPTION:
21     C Writes DIC arrays (needed for a restart) to a pickup file
22    
23     C !USES: ===============================================================
24     IMPLICIT NONE
25     C === Global variables ===
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "PARAMS.h"
29     #include "DARWIN_FLUX.h"
30    
31     C !INPUT PARAMETERS: ===================================================
32     C permPickup :: write a permanent pickup
33     C suff :: suffix for pickup file (eg. ckptA or 0000000010)
34     C myTime :: Current time in simulation
35     C myIter :: Current iteration number in simulation
36     C myThid :: My Thread Id number
37     LOGICAL permPickup
38     CHARACTER*(*) suff
39     _RL myTime
40     INTEGER myIter
41     INTEGER myThid
42     CEOP
43    
44     C !LOCAL VARIABLES:
45     C == Local variables ==
46     CHARACTER*(MAX_LEN_FNAM) fn
47     LOGICAL glf
48 jmc 1.2 _RL timList(1)
49 jahn 1.1 INTEGER prec, j, nj
50     INTEGER listDim, nWrFlds
51     PARAMETER( listDim = 2 )
52     CHARACTER*(8) wrFldList(listDim)
53     CHARACTER*(MAX_LEN_MBUF) msgBuf
54    
55     c IF ( DIC_pickup_write_mdsio ) THEN
56     prec = precFloat64
57     WRITE(fn,'(A,A)') 'pickup_dic.',suff
58     j = 0
59    
60     C Firstly, write 3-D fields as consecutive records,
61    
62     C- switch to 2-D fields:
63     nj = -j*Nr
64    
65     C record number < 0 : a hack not to write meta files now:
66     j = j + 1
67     nj = nj-1
68     CALL WRITE_REC_3D_RL( fn, prec, 1, pH, nj, myIter, myThid )
69     IF (j.LE.listDim) wrFldList(j) = 'DIC_pH2d'
70    
71     C--------------------------
72     nWrFlds = j
73     IF ( nWrFlds.GT.listDim ) THEN
74     WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
75     & 'trying to write ',nWrFlds,' fields'
76     CALL PRINT_ERROR( msgBuf, myThid )
77     WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
78     & 'field-list dimension (listDim=',listDim,') too small'
79     CALL PRINT_ERROR( msgBuf, myThid )
80     STOP 'ABNORMAL END: S/R DIC_WRITE_PICKUP (list-size Pb)'
81     ENDIF
82    
83     #ifdef ALLOW_MDSIO
84     C uses this specific S/R to write (with more informations) only meta
85     C files
86     j = 1
87     nj = ABS(nj)
88     IF ( nWrFlds*Nr .EQ. nj ) THEN
89     j = Nr
90     nj = nWrFlds
91     ENDIF
92     glf = globalFiles
93 jmc 1.2 timList(1) = myTime
94 jahn 1.1 CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
95     & 0, 0, j, ' ',
96     & nWrFlds, wrFldList,
97 jmc 1.2 & 1, timList, oneRL,
98 jahn 1.1 & nj, myIter, myThid )
99     #endif /* ALLOW_MDSIO */
100     C--------------------------
101    
102     c ENDIF /* DIC_pickup_write_mdsio */
103    
104    
105     RETURN
106     END
107     #endif /*ALLOW_CARBON*/
108    
109     #endif /*DARWIN*/
110     #endif /*ALLOW_PTRACERS*/
111     c ==================================================================

  ViewVC Help
Powered by ViewVC 1.1.22