/[MITgcm]/MITgcm_contrib/dgoldberg/streamice/streamice_read_pickup.F
ViewVC logotype

Contents of /MITgcm_contrib/dgoldberg/streamice/streamice_read_pickup.F

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


Revision 1.1 - (show annotations) (download)
Wed Aug 27 19:29:14 2014 UTC (10 years, 10 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
updating contrib streamice repo with latest files, and separated out convergence checks; and parameterised maximum iteration counts and interface w shelfice for coupling

1 C $Header: /u/gcmpack/MITgcm/pkg/streamice/streamice_read_pickup.F,v 1.3 2014/03/30 18:00:23 jmc Exp $
2 C $Name: $
3
4 #include "STREAMICE_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: STREAMICE_READ_PICKUP
9
10 C !INTERFACE:
11 SUBROUTINE STREAMICE_READ_PICKUP( myThid )
12
13 C !DESCRIPTION:
14 C Reads current state of STREAMICE 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 "STREAMICE.h"
22
23 C !INPUT PARAMETERS:
24 C myIter :: time-step number
25 C myThid :: thread number
26 INTEGER myIter
27 INTEGER myThid
28
29 #ifdef ALLOW_STREAMICE
30 C !LOCAL VARIABLES:
31 C fn :: character buffer for creating filename
32 C fp :: precision of pickup files
33 C filePrec :: pickup-file precision (read from meta file)
34 C nbFields :: number of fields in pickup file (read from meta file)
35 C missFldList :: List of missing fields (attempted to read but not found)
36 C missFldDim :: Dimension of missing fields list array: missFldList
37 C nMissing :: Number of missing fields (attempted to read but not found)
38 C j :: loop index
39 C nj :: record number
40 C ioUnit :: temp for writing msg unit
41 C msgBuf :: Informational/error message buffer
42 INTEGER fp
43 INTEGER filePrec, nbFields
44 INTEGER missFldDim, nMissing
45 INTEGER j, nj, ioUnit
46 PARAMETER( missFldDim = 12 )
47 CHARACTER*(MAX_LEN_FNAM) fn
48 CHARACTER*(8) missFldList(missFldDim)
49 CHARACTER*(MAX_LEN_MBUF) msgBuf
50 CEOP
51
52 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
53
54 IF ( pickupSuff.EQ.' ' ) THEN
55 WRITE(fn,'(A,I10.10)') 'pickup_streamice.',nIter0
56 ELSE
57 WRITE(fn,'(A,A10)') 'pickup_streamice.',pickupSuff
58 ENDIF
59 fp = precFloat64
60
61 CALL READ_MFLDS_SET(
62 I fn,
63 O nbFields, filePrec,
64 I Nr, nIter0, myThid )
65
66 _BEGIN_MASTER( myThid )
67 IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
68 WRITE(msgBuf,'(2A,I4)') 'STREAMICE_READ_PICKUP: ',
69 & 'pickup-file binary precision do not match !'
70 CALL PRINT_ERROR( msgBuf, myThid )
71 WRITE(msgBuf,'(A,2(A,I4))') 'STREAMICE_READ_PICKUP: ',
72 & 'file prec.=', filePrec, ' but expecting prec.=', fp
73 CALL PRINT_ERROR( msgBuf, myThid )
74 CALL ALL_PROC_DIE( 0 )
75 STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP (data-prec Pb)'
76 ENDIF
77 _END_MASTER( myThid )
78
79 IF ( nbFields.LE.0 ) THEN
80 C- No meta-file or old meta-file without List of Fields
81 ioUnit = errorMessageUnit
82 IF ( pickupStrictlyMatch ) THEN
83 WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
84 & 'no field-list found in meta-file',
85 & ' => cannot check for strick-matching'
86 CALL PRINT_ERROR( msgBuf, myThid )
87 WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
88 & 'try with " pickupStrictlyMatch=.FALSE.,"',
89 & ' in file: "data", NameList: "PARM03"'
90 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
91 CALL ALL_PROC_DIE( myThid )
92 STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP'
93 ELSE
94 WRITE(msgBuf,'(4A)') 'WARNING >> STREAMICE_READ_PICKUP: ',
95 & ' no field-list found'
96 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
97 IF ( nbFields.EQ.-1 ) THEN
98 C- No meta-file
99 WRITE(msgBuf,'(4A)') 'WARNING >> ',
100 & ' try to read pickup as currently written'
101 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
102 ELSE
103 C- Old meta-file without List of Fields
104 c WRITE(msgBuf,'(4A)') 'WARNING >> ',
105 c & ' try to read pickup as it used to be written'
106 c CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
107 c WRITE(msgBuf,'(4A)') 'WARNING >> ',
108 c & ' until checkpoint59l (2007 Dec 17)'
109 c CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
110 WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
111 & 'no field-list found in meta-file'
112 CALL PRINT_ERROR( msgBuf, myThid )
113 CALL ALL_PROC_DIE( myThid )
114 STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP'
115 ENDIF
116 ENDIF
117 ENDIF
118
119 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
120
121 IF ( nbFields.EQ.0 ) THEN
122 C--- Old way to read pickup:
123
124 ELSE
125 C--- New way to read STREAMICE pickup:
126 nj = 0
127 C--- read STREAMICE 3-D fields for restart
128 #ifdef STREAMICE_HYBRID_STRESS
129 CALL READ_MFLDS_3D_RL( 'visc3d ', visc_streamice_full,
130 & nj, fp, Nr, myIter, myThid )
131 #endif /* STREAMICE_HYBRID_STRESS */
132 nj = nj*Nr
133 C--- read STREAMICE 2-D fields for restart
134
135 CALL READ_MFLDS_3D_RL( 'SI_area ', area_shelf_streamice,
136 & nj, fp, 1 , myIter, myThid )
137 CALL READ_MFLDS_LEV_RS('SI_hmask', STREAMICE_hmask,
138 & nj, fp, 1, 1, 1, myIter, myThid )
139 CALL READ_MFLDS_3D_RL( 'SI_uvel ', U_streamice,
140 & nj, fp, 1 , myIter, myThid )
141 CALL READ_MFLDS_3D_RL( 'SI_vvel ', V_streamice,
142 & nj, fp, 1 , myIter, myThid )
143 CALL READ_MFLDS_3D_RL( 'SI_thick', H_streamice,
144 & nj, fp, 1 , myIter, myThid )
145 CALL READ_MFLDS_3D_RL( 'SI_betaF', tau_beta_eff_streamice,
146 & nj, fp, 1 , myIter, myThid )
147 CALL READ_MFLDS_3D_RL( 'SI_visc ', visc_streamice,
148 & nj, fp, 1 , myIter, myThid )
149
150 #ifdef STREAMICE_HYBRID_STRESS
151 CALL READ_MFLDS_3D_RL( 'SI_taubx', streamice_taubx,
152 & nj, fp, 1 , myIter, myThid )
153 CALL READ_MFLDS_3D_RL( 'SI_tauby', streamice_tauby,
154 & nj, fp, 1 , myIter, myThid )
155 #endif
156
157 C-- end: new way to read pickup file
158 ENDIF
159
160 C-- Check for missing fields:
161 nMissing = missFldDim
162 CALL READ_MFLDS_CHECK(
163 O missFldList,
164 U nMissing,
165 I myIter, myThid )
166 IF ( nMissing.GT.missFldDim ) THEN
167 WRITE(msgBuf,'(2A,I4)') 'STREAMICE_READ_PICKUP: ',
168 & 'missing fields list has been truncated to', missFldDim
169 CALL PRINT_ERROR( msgBuf, myThid )
170 CALL ALL_PROC_DIE( myThid )
171 STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP (list-size Pb)'
172 ENDIF
173 IF ( nMissing.GE.1 ) THEN
174 ioUnit = errorMessageUnit
175 DO j=1,nMissing
176 WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
177 & 'cannot restart without field "',missFldList(nj),'"'
178 CALL PRINT_ERROR( msgBuf, myThid )
179 ENDDO
180 CALL ALL_PROC_DIE( myThid )
181 STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP'
182 ENDIF
183
184 C-- Update overlap regions:
185 #ifdef STREAMICE_HYBRID_STRESS
186 CALL EXCH_3D_RL( visc_streamice_full, Nr, myThid )
187 #endif /* STREAMICE_HYBRID_STRESS */
188 CALL EXCH_XY_RL( area_shelf_streamice, myThid )
189 CALL EXCH_XY_RL( h_streamice, myThid )
190 CALL EXCH_XY_RL( u_streamice, myThid )
191 CALL EXCH_XY_RL( v_streamice, myThid )
192 CALL EXCH_XY_RS( streamice_hmask, myThid )
193 CALL EXCH_XY_RL( tau_beta_eff_streamice, myThid )
194 CALL EXCH_XY_RL( visc_streamice, myThid )
195
196 c CALL EXCH_XY_RL( myPa_Surf2, myThid )
197
198 #endif /* ALLOW_STREAMICE */
199
200 RETURN
201 END

  ViewVC Help
Powered by ViewVC 1.1.22