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

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

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


Revision 1.2 - (hide annotations) (download)
Thu Jun 5 21:26:26 2014 UTC (11 years, 1 month ago) by mmazloff
Branch: MAIN
Changes since 1.1: +21 -17 lines
cleaning and updating

1 mmazloff 1.2 C $Header: /u/gcmpack/MITgcm_contrib/bling/pkg/bling_write_pickup.F,v1.1 2014/05/23 17:33:43 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 mmazloff 1.2 PARAMETER( listDim = 4 )
51 mmazloff 1.1 CHARACTER*(8) wrFldList(listDim)
52     CHARACTER*(MAX_LEN_MBUF) msgBuf
53    
54     prec = precFloat64
55    
56 mmazloff 1.2 WRITE(fn,'(A,A)') 'pickup_bling.',suff
57 mmazloff 1.1 j = 0
58    
59     C Firstly, write 3-D fields as consecutive records,
60    
61 mmazloff 1.2 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, P_sm, -j, myIter, myThid )
73     IF (j.LE.listDim) wrFldList(j) = 'BLG_Plg '
74 mmazloff 1.1
75     j = j + 1
76 mmazloff 1.2 CALL WRITE_REC_3D_RL( fn, prec, Nr, P_lg, -j, myIter, myThid )
77     IF (j.LE.listDim) wrFldList(j) = 'BLG_Plg '
78 mmazloff 1.1
79     C--------------------------
80     nWrFlds = j
81     IF ( nWrFlds.GT.listDim ) THEN
82     WRITE(msgBuf,'(2A,I5,A)') 'BLING_WRITE_PICKUP: ',
83     & 'trying to write ',nWrFlds,' fields'
84     CALL PRINT_ERROR( msgBuf, myThid )
85     WRITE(msgBuf,'(2A,I5,A)') 'BLING_WRITE_PICKUP: ',
86     & 'field-list dimension (listDim=',listDim,') too small'
87     CALL PRINT_ERROR( msgBuf, myThid )
88     STOP 'ABNORMAL END: S/R BLING_WRITE_PICKUP (list-size Pb)'
89     ENDIF
90    
91     #ifdef ALLOW_MDSIO
92     C uses this specific S/R to write (with more informations) only meta
93     C files
94     j = 1
95     glf = globalFiles
96     timList(1) = myTime
97     CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
98 mmazloff 1.2 & 0, 0, Nr, ' ',
99 mmazloff 1.1 & nWrFlds, wrFldList,
100 mmazloff 1.2 & 1, timList, oneRL,
101     & j, myIter, myThid )
102 mmazloff 1.1 #endif /* ALLOW_MDSIO */
103     C--------------------------
104    
105     #endif /* ALLOW_BLING */
106    
107     RETURN
108     END

  ViewVC Help
Powered by ViewVC 1.1.22