/[MITgcm]/MITgcm/pkg/gmredi/gmredi_read_pickup.F
ViewVC logotype

Contents of /MITgcm/pkg/gmredi/gmredi_read_pickup.F

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

Revision 1.1 - (show annotations) (download)
Thu Jul 11 14:33:23 2013 UTC (10 years, 10 months ago) by m_bates
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint64n, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64k, checkpoint65, checkpoint64m, checkpoint64l 
Changes associated with the PV eddy closure (GM_K3D) include:
o To improve efficiency the call to solve for the eigenvectors only happen once every GM_K3D_vecFreq seconds.  This required the following changes:
  - read and write pickup files for the eigenvectors and deformation radius (gmredi_read_pickup.F and gmredi_write_pickup.F)
  - making the number of modes (GM_K3D_NModes) a parameter which must be specified at compile time in GMREDI.h
  - A new namelist variable, GM_K3D_vecFreq
  - Added modesC, modesW, modesS and Rdef to the common block
o If the CPP option use_lapack is undefined, then a WKB approximation to the eigenvectors and deformation radius is now used (although, it seems unstable; so for the moment an error is raised in gmredi_check if GM_K3D is defined but use_lapack is not).
o Changed gmredi_calc_eigs returns the deformation radius rather than the deformation wavenumber
o Fixed bug in calculation of tfluxX and tfluxY for the instance where the surface layer is the depth of the water column.
o Added warning messages if there are problems with calculating eigenmodes and eigenvectors
o Cleaned up code
o Improved documentation
o Rationalised diagnostics
o Added some extra startup checks (gmredi_check)
1 C $Header: /u/gcmpack/MITgcm/pkg/mypackage/mypackage_read_pickup.F,v 1.5 2012/04/03 00:20:14 jmc Exp $
2 C $Name: $
3
4 #include "GMREDI_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: MYPACKAGE_READ_PICKUP
9
10 C !INTERFACE:
11 SUBROUTINE GMREDI_READ_PICKUP( myIter, myThid )
12
13 C !DESCRIPTION:
14 C Reads current state of MYPACKAGE 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 "GMREDI.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 GM_K3D
30
31 C !LOCAL VARIABLES:
32 C fn :: character buffer for creating filename
33 C fp :: precision of pickup files
34 C filePrec :: pickup-file precision (read from meta file)
35 C nbFields :: number of fields in pickup file (read from meta file)
36 C missFldList :: List of missing fields (attempted to read but not found)
37 C missFldDim :: Dimension of missing fields list array: missFldList
38 C nMissing :: Number of missing fields (attempted to read but not found)
39 C j :: loop index
40 C nj :: record number
41 C ioUnit :: temp for writing msg unit
42 C msgBuf :: Informational/error message buffer
43 INTEGER fp
44 INTEGER filePrec, nbFields
45 INTEGER missFldDim, nMissing
46 INTEGER i,j,k,n,nm,ioUnit,bi,bj
47 PARAMETER( missFldDim = 12 )
48 CHARACTER*(MAX_LEN_FNAM) fn
49 CHARACTER*(8) missFldList(missFldDim)
50 CHARACTER*(MAX_LEN_MBUF) msgBuf
51 _RL vec(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
52 CHARACTER*(8) fieldname
53 CEOP
54
55 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
56
57 IF ( pickupSuff.EQ.' ' ) THEN
58 WRITE(fn,'(A,I10.10)') 'pickup_gmredi.',myIter
59 ELSE
60 WRITE(fn,'(A,A10)') 'pickup_gmredi.',pickupSuff
61 ENDIF
62 fp = precFloat64
63
64 CALL READ_MFLDS_SET(
65 I fn,
66 O nbFields, filePrec,
67 I Nr, myIter, myThid )
68 _BEGIN_MASTER( myThid )
69 c IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN
70 IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
71 WRITE(msgBuf,'(2A,I4)') 'GMREDI_READ_PICKUP: ',
72 & 'pickup-file binary precision do not match !'
73 CALL PRINT_ERROR( msgBuf, myThid )
74 WRITE(msgBuf,'(A,2(A,I4))') 'GMREDI_READ_PICKUP: ',
75 & 'file prec.=', filePrec, ' but expecting prec.=', fp
76 CALL PRINT_ERROR( msgBuf, myThid )
77 CALL ALL_PROC_DIE( 0 )
78 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP (data-prec Pb)'
79 ENDIF
80 _END_MASTER( myThid )
81
82 IF ( nbFields.LE.0 ) THEN
83 C- No meta-file or old meta-file without List of Fields
84 ioUnit = errorMessageUnit
85 IF ( pickupStrictlyMatch ) THEN
86 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
87 & 'no field-list found in meta-file',
88 & ' => cannot check for strick-matching'
89 CALL PRINT_ERROR( msgBuf, myThid )
90 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
91 & 'try with " pickupStrictlyMatch=.FALSE.,"',
92 & ' in file: "data", NameList: "PARM03"'
93 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
94 CALL ALL_PROC_DIE( myThid )
95 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP'
96 ELSE
97 WRITE(msgBuf,'(4A)') 'WARNING >> GMREDI_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 C- Old meta-file without List of Fields
107 c WRITE(msgBuf,'(4A)') 'WARNING >> ',
108 c & ' try to read pickup as it used to be written'
109 c CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
110 c WRITE(msgBuf,'(4A)') 'WARNING >> ',
111 c & ' until checkpoint59l (2007 Dec 17)'
112 c CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
113 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
114 & 'no field-list found in meta-file'
115 CALL PRINT_ERROR( msgBuf, myThid )
116 CALL ALL_PROC_DIE( myThid )
117 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP'
118 ENDIF
119 ENDIF
120 ENDIF
121
122 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
123
124 IF ( nbFields.EQ.0 ) THEN
125 C--- Old way to read pickup:
126
127 ELSE
128
129 nm = 0
130 C--- read GMREDI fields for restart
131
132 C Centre mode
133 fieldname='mode01C'
134 CALL READ_MFLDS_3D_RL( fieldname, vec,
135 & nm, fp, Nr, myIter, myThid )
136 CALL EXCH_3D_RL(vec, Nr, myThid)
137 DO bj=myByLo(myThid),myByHi(myThid)
138 DO bi=myBxLo(myThid),myBxHi(myThid)
139 DO k=1,Nr
140 DO j=1-Oly,sNy+Oly
141 DO i=1-Olx,sNx+Olx
142 modesC(1,i,j,k,bi,bj) = vec(i,j,k,bi,bj)
143 ENDDO
144 ENDDO
145 ENDDO
146 ENDDO
147 ENDDO
148
149 C Western Mode
150 DO n=1,GM_K3D_NModes
151 WRITE(fieldname, '(A,I2.2,A)') 'mode',n,'W'
152 CALL READ_MFLDS_3D_RL( fieldname, vec,
153 & nm, fp, Nr, myIter, myThid )
154 CALL EXCH_3D_RL(vec, Nr, myThid)
155 DO bj=myByLo(myThid),myByHi(myThid)
156 DO bi=myBxLo(myThid),myBxHi(myThid)
157 DO k=1,Nr
158 DO j=1-Oly,sNy+Oly
159 DO i=1-Olx,sNx+Olx
160 modesW(n,i,j,k,bi,bj) = vec(i,j,k,bi,bj)
161 ENDDO
162 ENDDO
163 ENDDO
164 ENDDO
165 ENDDO
166 ENDDO
167
168 C Southern Mode
169 DO n=1,GM_K3D_NModes
170 WRITE(fieldname, '(A,I2.2,A)') 'mode',n,'S'
171 CALL READ_MFLDS_3D_RL( fieldname, vec,
172 & nm, fp, Nr, myIter, myThid )
173 CALL EXCH_3D_RL(vec, Nr, myThid)
174 DO bj=myByLo(myThid),myByHi(myThid)
175 DO bi=myBxLo(myThid),myBxHi(myThid)
176 DO k=1,Nr
177 DO j=1-Oly,sNy+Oly
178 DO i=1-Olx,sNx+Olx
179 modesS(n,i,j,k,bi,bj) = vec(i,j,k,bi,bj)
180 ENDDO
181 ENDDO
182 ENDDO
183 ENDDO
184 ENDDO
185 ENDDO
186
187 nm = nm*Nr
188
189 C ---2D fields---
190 C Deformation radius
191 fieldname='Rdef'
192 CALL READ_MFLDS_3D_RL( fieldname, Rdef,
193 & nm, fp, 1, myIter, myThid )
194 CALL EXCH_XY_RL(Rdef, myThid)
195
196 C-- end: new way to read pickup file
197 ENDIF
198
199
200 C-- Check for missing fields:
201 nMissing = missFldDim
202 CALL READ_MFLDS_CHECK(
203 O missFldList,
204 U nMissing,
205 I myIter, myThid )
206 IF ( nMissing.GT.missFldDim ) THEN
207 WRITE(msgBuf,'(2A,I4)') 'GMREDI_READ_PICKUP: ',
208 & 'missing fields list has been truncated to', missFldDim
209 CALL PRINT_ERROR( msgBuf, myThid )
210 CALL ALL_PROC_DIE( myThid )
211 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP (list-size Pb)'
212 ENDIF
213 IF ( nMissing.GE.1 ) THEN
214 ioUnit = errorMessageUnit
215 DO j=1,nMissing
216 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
217 & 'cannot restart without field "',missFldList(nm),'"'
218 CALL PRINT_ERROR( msgBuf, myThid )
219 ENDDO
220 CALL ALL_PROC_DIE( myThid )
221 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP'
222 ENDIF
223
224 C-- Update overlap regions:
225 C CALL EXCH_3D_RL( myPa_StatScal1, Nr, myThid )
226 #endif /* GM_K3D */
227
228 RETURN
229 END
  ViewVC Help
Powered by ViewVC 1.1.22