/[MITgcm]/MITgcm/pkg/bling/bling_write_pickup.F
ViewVC logotype

Annotation of /MITgcm/pkg/bling/bling_write_pickup.F

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


Revision 1.2 - (hide annotations) (download)
Wed May 25 03:53:41 2016 UTC (8 years ago) by mmazloff
Branch: MAIN
CVS Tags: checkpoint65x, checkpoint65y
Changes since 1.1: +2 -2 lines
fix benign typo

1 mmazloff 1.2 C $Header: /u/gcmpack/MITgcm/pkg/bling/bling_write_pickup.F,v 1.1 2016/05/19 20:29:26 mmazloff Exp $
2 mmazloff 1.1 C $Name: $
3    
4     #include "BLING_OPTIONS.h"
5    
6     CBOP
7     subroutine BLING_WRITE_PICKUP( permPickup,
8     I suff, myTime, myIter, myThid )
9    
10     C =================================================================
11     C | subroutine bling_write_pickup
12     C | o Writes BLING arrays (needed for a restart) to a pickup file
13     C =================================================================
14    
15     implicit none
16    
17     C === Global variables ===
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #include "BLING_VARS.h"
22    
23     C === Routine arguments ===
24     C permPickup :: write a permanent pickup
25     C suff :: suffix for pickup file (eg. ckptA or 0000000010)
26     C myTime :: Current time in simulation
27     C myIter :: Current iteration number in simulation
28     C myThid :: My Thread Id number
29     LOGICAL permPickup
30     CHARACTER*(*) suff
31     _RL myTime
32     INTEGER myIter
33     INTEGER myThid
34     CEOP
35    
36     #ifdef ALLOW_BLING
37    
38     C == Local variables ==
39     CHARACTER*(MAX_LEN_FNAM) fn
40     INTEGER prec
41     #ifndef USE_ATMOSCO2
42     INTEGER ioUnit
43     _RL tmpFld(2)
44     _RS dummyRS(1)
45     #endif
46     LOGICAL glf
47     _RL timList(1)
48     INTEGER j, nj
49     INTEGER listDim, nWrFlds
50     PARAMETER( listDim = 6 )
51     CHARACTER*(8) wrFldList(listDim)
52     CHARACTER*(MAX_LEN_MBUF) msgBuf
53    
54     prec = precFloat64
55    
56     WRITE(fn,'(A,A)') 'pickup_bling.',suff
57     j = 0
58    
59     C Firstly, write 3-D fields as consecutive records,
60    
61     C record number < 0 : a hack not to write meta files now:
62     j = j + 1
63     CALL WRITE_REC_3D_RL( fn, prec, Nr, pH, -j, myIter, myThid )
64     IF (j.LE.listDim) wrFldList(j) = 'BLG_pH3d'
65    
66     j = j + 1
67     CALL WRITE_REC_3D_RL( fn, prec, Nr, irr_mem,
68     & -j, myIter, myThid )
69     IF (j.LE.listDim) wrFldList(j) = 'BLG_irrm'
70    
71     j = j + 1
72     CALL WRITE_REC_3D_RL( fn, prec, Nr, chl, -j, myIter, myThid )
73     IF (j.LE.listDim) wrFldList(j) = 'BLG_chl '
74    
75     j = j + 1
76     CALL WRITE_REC_3D_RL( fn, prec, Nr, P_sm, -j, myIter, myThid )
77 mmazloff 1.2 IF (j.LE.listDim) wrFldList(j) = 'BLG_Psm '
78 mmazloff 1.1
79     j = j + 1
80     CALL WRITE_REC_3D_RL( fn, prec, Nr, P_lg, -j, myIter, myThid )
81     IF (j.LE.listDim) wrFldList(j) = 'BLG_Plg '
82    
83     j = j + 1
84     CALL WRITE_REC_3D_RL( fn, prec, Nr, P_diaz, -j, myIter, myThid )
85     IF (j.LE.listDim) wrFldList(j) = 'BLG_Pdia'
86    
87     C--------------------------
88     nWrFlds = j
89     IF ( nWrFlds.GT.listDim ) THEN
90     WRITE(msgBuf,'(2A,I5,A)') 'BLING_WRITE_PICKUP: ',
91     & 'trying to write ',nWrFlds,' fields'
92     CALL PRINT_ERROR( msgBuf, myThid )
93     WRITE(msgBuf,'(2A,I5,A)') 'BLING_WRITE_PICKUP: ',
94     & 'field-list dimension (listDim=',listDim,') too small'
95     CALL PRINT_ERROR( msgBuf, myThid )
96     STOP 'ABNORMAL END: S/R BLING_WRITE_PICKUP (list-size Pb)'
97     ENDIF
98    
99     #ifdef ALLOW_MDSIO
100     C uses this specific S/R to write (with more informations) only meta
101     C files
102     j = 1
103     glf = globalFiles
104     timList(1) = myTime
105     CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
106     & 0, 0, Nr, ' ',
107     & nWrFlds, wrFldList,
108     & 1, timList, oneRL,
109     & j, myIter, myThid )
110     #endif /* ALLOW_MDSIO */
111     C--------------------------
112    
113     #endif /* ALLOW_BLING */
114    
115     RETURN
116     END

  ViewVC Help
Powered by ViewVC 1.1.22