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

Contents of /MITgcm_contrib/darwin2/pkg/darwin/darwin_read_pickup.F

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

Revision 1.1 - (show annotations) (download)
Wed Apr 13 18:56:24 2011 UTC (14 years, 6 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt63l_20120405, ctrb_darwin2_ckpt62v_20110413, ctrb_darwin2_ckpt64f_20130405, ctrb_darwin2_ckpt63f_20111201, ctrb_darwin2_ckpt64a_20121116, ctrb_darwin2_ckpt62y_20110526, ctrb_darwin2_ckpt62x_20110513, ctrb_darwin2_ckpt62w_20110426, ctrb_darwin2_ckpt63o_20120629, ctrb_darwin2_ckpt64e_20130305, ctrb_darwin2_ckpt63c_20111011, ctrb_darwin2_ckpt63i_20120124, ctrb_darwin2_ckpt63m_20120506, ctrb_darwin2_ckpt63s_20120908, ctrb_darwin2_ckpt63e_20111107, ctrb_darwin2_ckpt63b_20110830, ctrb_darwin2_ckpt63j_20120217, ctrb_darwin2_ckpt63r_20120817, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt63g_20111220, ctrb_darwin2_ckpt64c_20130120, ctrb_darwin2_ckpt63a_20110804, ctrb_darwin2_ckpt63h_20111230, ctrb_darwin2_ckpt63p_20120707, ctrb_darwin2_ckpt63d_20111107, ctrb_darwin2_ckpt63q_20120731, ctrb_darwin2_ckpt63_20110728, ctrb_darwin2_ckpt64b_20121224, ctrb_darwin2_ckpt64d_20130219, ctrb_darwin2_ckpt64_20121012, ctrb_darwin2_baseline, ctrb_darwin2_ckpt63n_20120604, ctrb_darwin2_ckpt63k_20120317, ctrb_darwin2_ckpt62z_20110622 
darwin2 initial checkin
1 C $Header$
2 C $Name$
3
4 #include "DARWIN_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: DARWIN_READ_PICKUP
9
10 C !INTERFACE:
11 SUBROUTINE DARWIN_READ_PICKUP( myIter, myThid )
12
13 C !DESCRIPTION:
14 C Reads current state of DARWIN from a pickup file
15
16 C !USES:
17 IMPLICIT NONE
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "DARWIN_SIZE.h"
22 #include "DARWIN_IO.h"
23
24 C !INPUT PARAMETERS:
25 C myIter :: time-step number
26 C myThid :: thread number
27 INTEGER myIter
28 INTEGER myThid
29
30 #ifdef ALLOW_DARWIN
31 C add more ALLOWs here for other fields in pickup
32 #ifdef ALLOW_PAR_DAY
33
34 C !LOCAL VARIABLES:
35 C fn :: character buffer for creating filename
36 C fp :: precision of pickup files
37 C filePrec :: pickup-file precision (read from meta file)
38 C nbFields :: number of fields in pickup file (read from meta file)
39 C missFldList :: List of missing fields (attempted to read but not found)
40 C missFldDim :: Dimension of missing fields list array: missFldList
41 C nMissing :: Number of missing fields (attempted to read but not found)
42 C j :: loop index
43 C nj :: record number
44 C ioUnit :: temp for writing msg unit
45 C msgBuf :: Informational/error message buffer
46 INTEGER fp
47 INTEGER filePrec, nbFields
48 INTEGER missFldDim, nMissing
49 INTEGER j, nj, ioUnit
50 PARAMETER( missFldDim = 12 )
51 CHARACTER*(MAX_LEN_FNAM) fn
52 CHARACTER*(8) missFldList(missFldDim)
53 CHARACTER*(MAX_LEN_MBUF) msgBuf
54 CEOP
55
56 _BARRIER
57
58 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
59
60 IF ( pickupSuff.EQ.' ' ) THEN
61 WRITE(fn,'(A,I10.10)') 'pickup_darwin.',myIter
62 ELSE
63 WRITE(fn,'(A,A10)') 'pickup_darwin.',pickupSuff
64 ENDIF
65 fp = precFloat64
66
67 CALL READ_MFLDS_SET(
68 I fn,
69 O nbFields, filePrec,
70 I Nr, myIter, myThid )
71 _BEGIN_MASTER( myThid )
72 IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
73 WRITE(msgBuf,'(2A,I4)') 'DARWIN_READ_PICKUP: ',
74 & 'pickup-file binary precision do not match !'
75 CALL PRINT_ERROR( msgBuf, myThid )
76 WRITE(msgBuf,'(A,2(A,I4))') 'DARWIN_READ_PICKUP: ',
77 & 'file prec.=', filePrec, ' but expecting prec.=', fp
78 CALL PRINT_ERROR( msgBuf, myThid )
79 STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP (data-prec Pb)'
80 ENDIF
81 _END_MASTER( myThid )
82
83 IF ( nbFields.LE.0 ) THEN
84 C- No meta-file or old meta-file without List of Fields
85 ioUnit = errorMessageUnit
86 IF ( pickupStrictlyMatch ) THEN
87 WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
88 & 'no field-list found in meta-file',
89 & ' => cannot check for strick-matching'
90 CALL PRINT_ERROR( msgBuf, myThid )
91 WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
92 & 'try with " pickupStrictlyMatch=.FALSE.,"',
93 & ' in file: "data", NameList: "PARM03"'
94 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
95 STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
96 ELSE
97 WRITE(msgBuf,'(4A)') 'WARNING >> DARWIN_READ_PICKUP: ',
98 & ' no field-list found'
99 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
100 IF ( nbFields.EQ.-1 ) THEN
101 C- No meta-file
102 WRITE(msgBuf,'(4A)') 'WARNING >> ',
103 & ' try to read pickup as currently written'
104 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
105 ELSE
106 WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
107 & 'no field-list found in meta-file'
108 CALL PRINT_ERROR( msgBuf, myThid )
109 STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
110 ENDIF
111 ENDIF
112 ENDIF
113
114 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115
116 IF ( nbFields.EQ.0 ) THEN
117 C--- Old way to read pickup not supported
118 WRITE(msgBuf,'(2A)') 'DARWIN_READ_PICKUP: ',
119 & 'please provide a meta file with a field list'
120 STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
121 ELSE
122 C--- New way to read DARWIN pickup:
123 nj = 0
124 C--- read DARWIN 3-D fields for restart
125 #ifdef ALLOW_PAR_DAY
126 CALL READ_MFLDS_3D_RL( 'PARday1 ', PARday(1-OLx,1-OLy,1,1,1,1),
127 & nj, fp, Nr, myIter, myThid )
128 CALL READ_MFLDS_3D_RL( 'PARday2 ', PARday(1-OLx,1-OLy,1,1,1,2),
129 & nj, fp, Nr, myIter, myThid )
130 #endif /* ALLOW_PAR_DAY */
131 C-- end: new way to read pickup file
132 ENDIF
133
134 C-- Check for missing fields:
135 nMissing = missFldDim
136 CALL READ_MFLDS_CHECK(
137 O missFldList,
138 U nMissing,
139 I myIter, myThid )
140 IF ( nMissing.GT.missFldDim ) THEN
141 WRITE(msgBuf,'(2A,I4)') 'DARWIN_READ_PICKUP: ',
142 & 'missing fields list has been truncated to', missFldDim
143 CALL PRINT_ERROR( msgBuf, myThid )
144 STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP (list-size Pb)'
145 ENDIF
146 IF ( nMissing.GE.1 ) THEN
147 ioUnit = errorMessageUnit
148 DO j=1,nMissing
149 WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
150 & 'cannot restart without field "',missFldList(nj),'"'
151 CALL PRINT_ERROR( msgBuf, myThid )
152 ENDDO
153 STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
154 ENDIF
155
156 C-- Update overlap regions:
157 #ifdef ALLOW_PAR_DAY
158 CALL EXCH_3D_RL( PARday(1-OLx,1-OLy,1,1,1,1), Nr, myThid )
159 CALL EXCH_3D_RL( PARday(1-OLx,1-OLy,1,1,1,2), Nr, myThid )
160 #endif /* ALLOW_PAR_DAY */
161
162 #endif /* ALLOW_PAR_DAY */
163 #endif /* ALLOW_DARWIN */
164
165 RETURN
166 END
  ViewVC Help
Powered by ViewVC 1.1.22