/[MITgcm]/MITgcm/pkg/offline/offline_fields_load.F
ViewVC logotype

Contents of /MITgcm/pkg/offline/offline_fields_load.F

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


Revision 1.26 - (show annotations) (download)
Sat Jul 18 21:47:08 2015 UTC (8 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65n, checkpoint65o, HEAD
Changes since 1.25: +39 -73 lines
- move setting of GM and KPP diffusivity out of OFFLINE_FIELDS_LOAD into new
  S/R OFFLINE_GET_DIFFUS that is called towards the end of DO_OCEANIC_PHYS;
- simplify rescaling of offline horiz. velocity with Non-Lin Free-Surf.

1 C $Header: /u/gcmpack/MITgcm/pkg/offline/offline_fields_load.F,v 1.25 2015/07/16 21:21:18 jmc Exp $
2 C $Name: $
3
4 #include "OFFLINE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: OFFLINE_FIELDS_LOAD
8 C !INTERFACE:
9 SUBROUTINE OFFLINE_FIELDS_LOAD( myTime, myIter, myThid )
10
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | SUBROUTINE OFFLINE_FIELDS_LOAD
14 C | o Control reading of fields from external source.
15 C *==========================================================*
16 C | Offline External source field loading routine.
17 C | This routine is called every time we want to
18 C | load a a set of external fields. The routine decides
19 C | which fields to load and then reads them in.
20 C | This routine needs to be customised for particular
21 C | experiments.
22 C | Notes
23 C | =====
24 C | currently the file names need to be specific lengths
25 C | would like to make this more flexible QQ
26 C *==========================================================*
27 C \ev
28
29 C !USES:
30 IMPLICIT NONE
31
32 C === Global variables ===
33 #include "SIZE.h"
34 #include "EEPARAMS.h"
35 #include "PARAMS.h"
36 c#include "GRID.h"
37 #include "SURFACE.h"
38 #include "DYNVARS.h"
39 #include "FFIELDS.h"
40 #ifdef ALLOW_GMREDI
41 #include "GMREDI.h"
42 #include "GMREDI_TAVE.h"
43 #endif
44 #ifdef ALLOW_KPP
45 #include "KPP.h"
46 #endif
47 #ifdef ALLOW_OFFLINE
48 #include "OFFLINE.h"
49 #endif
50
51 C !INPUT/OUTPUT PARAMETERS:
52 C === Routine arguments ===
53 C myTime :: Simulation time
54 C myIter :: Simulation timestep number
55 C myThid :: Thread no. that called this routine.
56 _RL myTime
57 INTEGER myIter
58 INTEGER myThid
59 CEOP
60
61 #ifdef ALLOW_OFFLINE
62 C !FUNCTIONS:
63 INTEGER IFNBLNK, ILNBLNK
64 EXTERNAL IFNBLNK, ILNBLNK
65
66 C !LOCAL VARIABLES:
67 C fn :: Temp. for building file name.
68 C msgBuf :: Informational/error message buffer
69 CHARACTER*(MAX_LEN_FNAM) fn
70 CHARACTER*(MAX_LEN_MBUF) msgBuf
71 INTEGER prec
72
73 INTEGER bi,bj,i,j,k
74 INTEGER intimeP, intime0, intime1
75 _RL aWght, bWght, locTime
76 INTEGER Ifprd
77 INTEGER I1, I2
78
79 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
80
81 prec = offlineLoadPrec
82
83 c IF ( offlinePeriodicExternalLoad ) THEN
84 IF ( .TRUE. ) THEN
85
86 C-- First call requires that we initialize everything to zero for safety
87 C <= already done in OFFLINE_INIT_VARIA
88
89 C-- Now calculate whether it is time to update the forcing arrays
90 locTime = myTime - offlineTimeOffset
91 CALL GET_PERIODIC_INTERVAL(
92 O intimeP, intime0, intime1, bWght, aWght,
93 I offlineForcingCycle, offlineForcingPeriod,
94 I deltaToffline, locTime, myThid )
95
96 bi = myBxLo(myThid)
97 bj = myByLo(myThid)
98 #ifdef ALLOW_DEBUG
99 IF ( debugLevel.GE.debLevB ) THEN
100 _BEGIN_MASTER(myThid)
101 WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
102 & ' OFFLINE_FIELDS_LOAD,', myIter,
103 & ' : iP,iLd,i0,i1=', intimeP, offlineLdRec(bi,bj),
104 & intime0,intime1, ' ; Wght=', bWght, aWght
105 _END_MASTER(myThid)
106 ENDIF
107 #endif /* ALLOW_DEBUG */
108
109 #ifdef ALLOW_AUTODIFF_TAMC
110 C- assuming that we call S/R OFFLINE_FIELDS_LOAD at each time-step and
111 C with increasing time, this will catch when we need to load new records;
112 C But with Adjoint run, this is not always the case => might end-up using
113 C the wrong time-records
114 IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
115 #else /* ALLOW_AUTODIFF_TAMC */
116 C- Make no assumption on sequence of calls to OFFLINE_FIELDS_LOAD ;
117 C This is the correct formulation (works in Adjoint run).
118 C Unfortunatly, produces many recomputations <== not used until it is fixed
119 IF ( intime1.NE.offlineLdRec(bi,bj) ) THEN
120 #endif /* ALLOW_AUTODIFF_TAMC */
121
122 Ifprd = NINT(offlineForcingPeriod/deltaToffline)
123 IF ( Ifprd*deltaToffline .NE. offlineForcingPeriod ) THEN
124 WRITE(msgBuf,'(2A,I5,A)') 'OFFLINE_FIELDS_LOAD: ',
125 & 'offlineForcingPeriod not multiple of deltaToffline'
126 CALL PRINT_ERROR( msgBuf, myThid )
127 STOP 'ABNORMAL END: S/R OFFLINE_FIELDS_LOAD'
128 ENDIF
129
130 C-- If the above condition is met then we need to read in
131 C data for the period ahead and the period behind myTime.
132 IF ( debugLevel.GE.debLevZero ) THEN
133 _BEGIN_MASTER(myThid)
134 WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
135 & ' OFFLINE_FIELDS_LOAD, it=', myIter,
136 & ' : Reading new data, i0,i1=', intime0, intime1,
137 & ' (prev=', intimeP, offlineLdRec(bi,bj), ' )'
138 _END_MASTER(myThid)
139 ENDIF
140
141 _BARRIER
142
143 #ifdef NOT_MODEL_FILES
144 C if reading own files setup reading here
145 #else
146
147 C-- Read in 3-D fields and apply EXCH
148
149 IF ( Uvelfile .NE. ' ' ) THEN
150 I1=IFNBLNK(Uvelfile)
151 I2=ILNBLNK(Uvelfile)
152 WRITE(fn,'(A,A,I10.10)') Uvelfile(I1:I2),'.',
153 & intime0*Ifprd +offlineIter0
154 c print*,'OFFLINE READ', fn
155 CALL READ_REC_3D_RS( fn, prec, Nr, uvel0, 1, myIter, myThid )
156 WRITE(fn,'(A,A,I10.10)') Uvelfile(I1:I2),'.',
157 & intime1*Ifprd +offlineIter0
158 c print*,'OFFLINE READ', fn
159 CALL READ_REC_3D_RS( fn, prec, Nr, uvel1, 1, myIter, myThid )
160 ENDIF
161 IF ( Vvelfile .NE. ' ' ) THEN
162 I1=IFNBLNK(Vvelfile)
163 I2=ILNBLNK(Vvelfile)
164 WRITE(fn,'(A,A,I10.10)') Vvelfile(I1:I2),'.',
165 & intime0*Ifprd +offlineIter0
166 CALL READ_REC_3D_RS( fn, prec, Nr, vvel0, 1, myIter, myThid )
167 WRITE(fn,'(A,A,I10.10)') Vvelfile(I1:I2),'.',
168 & intime1*Ifprd +offlineIter0
169 CALL READ_REC_3D_RS( fn, prec, Nr, vvel1, 1, myIter, myThid )
170 ENDIF
171 IF ( Uvelfile .NE. ' ' .OR. Vvelfile .NE. ' ' ) THEN
172 CALL EXCH_UV_XYZ_RS( uvel0, vvel0, .TRUE., myThid )
173 CALL EXCH_UV_XYZ_RS( uvel1, vvel1, .TRUE., myThid )
174 ENDIF
175
176 IF ( Wvelfile .NE. ' ' ) THEN
177 I1=IFNBLNK(Wvelfile)
178 I2=ILNBLNK(Wvelfile)
179 WRITE(fn,'(A,A,I10.10)') Wvelfile(I1:I2),'.',
180 & intime0*Ifprd +offlineIter0
181 CALL READ_REC_3D_RS( fn, prec, Nr, wvel0, 1, myIter, myThid )
182 WRITE(fn,'(A,A,I10.10)') Wvelfile(I1:I2),'.',
183 & intime1*Ifprd +offlineIter0
184 CALL READ_REC_3D_RS( fn, prec, Nr, wvel1, 1, myIter, myThid )
185 _EXCH_XYZ_RS(wvel0, myThid )
186 _EXCH_XYZ_RS(wvel1, myThid )
187 ENDIF
188
189 IF ( Thetfile .NE. ' ' ) THEN
190 I1=IFNBLNK(Thetfile)
191 I2=ILNBLNK(Thetfile)
192 WRITE(fn,'(A,A,I10.10)') Thetfile(I1:I2),'.',
193 & intime0*Ifprd +offlineIter0
194 CALL READ_REC_3D_RS( fn, prec, Nr, tave0, 1, myIter, myThid )
195 WRITE(fn,'(A,A,I10.10)') Thetfile(I1:I2),'.',
196 & intime1*Ifprd +offlineIter0
197 CALL READ_REC_3D_RS( fn, prec, Nr, tave1, 1, myIter, myThid )
198 _EXCH_XYZ_RS(tave0 , myThid )
199 _EXCH_XYZ_RS(tave1 , myThid )
200 ENDIF
201
202 IF ( Saltfile .NE. ' ' ) THEN
203 I1=IFNBLNK(Saltfile)
204 I2=ILNBLNK(Saltfile)
205 WRITE(fn,'(A,A,I10.10)') Saltfile(I1:I2),'.',
206 & intime0*Ifprd +offlineIter0
207 CALL READ_REC_3D_RS( fn, prec, Nr, save0, 1, myIter, myThid )
208 WRITE(fn,'(A,A,I10.10)') Saltfile(I1:I2),'.',
209 & intime1*Ifprd +offlineIter0
210 CALL READ_REC_3D_RS( fn, prec, Nr, save1, 1, myIter, myThid )
211 _EXCH_XYZ_RS(save0, myThid )
212 _EXCH_XYZ_RS(save1, myThid )
213 ENDIF
214
215 #ifdef ALLOW_GMREDI
216 IF ( GMwxFile .NE. ' ' ) THEN
217 I1=IFNBLNK(GMwxFile)
218 I2=ILNBLNK(GMwxFile)
219 WRITE(fn,'(A,A,I10.10)') GMwxFile(I1:I2),'.',
220 & intime0*Ifprd +offlineIter0
221 CALL READ_REC_3D_RS( fn, prec, Nr, gmkx0, 1, myIter, myThid )
222 WRITE(fn,'(A,A,I10.10)') GMwxFile(I1:I2),'.',
223 & intime1*Ifprd +offlineIter0
224 CALL READ_REC_3D_RS( fn, prec, Nr, gmkx1, 1, myIter, myThid )
225 ENDIF
226 IF ( GMwyFile .NE. ' ' ) THEN
227 I1=IFNBLNK(GMwyFile)
228 I2=ILNBLNK(GMwyFile)
229 WRITE(fn,'(A,A,I10.10)') GMwyFile(I1:I2),'.',
230 & intime0*Ifprd +offlineIter0
231 CALL READ_REC_3D_RS( fn, prec, Nr, gmky0, 1, myIter, myThid )
232 WRITE(fn,'(A,A,I10.10)') GMwyFile(I1:I2),'.',
233 & intime1*Ifprd +offlineIter0
234 CALL READ_REC_3D_RS( fn, prec, Nr, gmky1, 1, myIter, myThid )
235 ENDIF
236 IF ( GMwxFile .NE. ' ' .OR. GMwyFile .NE. ' ' ) THEN
237 CALL EXCH_UV_AGRID_3D_RS( gmkx0, gmky0, .FALSE., Nr, myThid )
238 CALL EXCH_UV_AGRID_3D_RS( gmkx1, gmky1, .FALSE., Nr, myThid )
239 ENDIF
240
241 IF ( GMwzFile .NE. ' ') THEN
242 I1=IFNBLNK(GMwzFile)
243 I2=ILNBLNK(GMwzFile)
244 WRITE(fn,'(A,A,I10.10)') GMwzFile(I1:I2),'.',
245 & intime0*Ifprd +offlineIter0
246 CALL READ_REC_3D_RS( fn, prec, Nr, gmkz0, 1, myIter, myThid )
247 WRITE(fn,'(A,A,I10.10)') GMwzFile(I1:I2),'.',
248 & intime1*Ifprd +offlineIter0
249 CALL READ_REC_3D_RS( fn, prec, Nr, gmkz1, 1, myIter, myThid )
250 _EXCH_XYZ_RS(gmkz0, myThid )
251 _EXCH_XYZ_RS(gmkz1, myThid )
252 ENDIF
253 #endif
254
255 IF ( ConvFile .NE. ' ' ) THEN
256 I1=IFNBLNK(ConvFile)
257 I2=ILNBLNK(ConvFile)
258 WRITE(fn,'(A,A,I10.10)') ConvFile(I1:I2),'.',
259 & intime0*Ifprd +offlineIter0
260 CALL READ_REC_3D_RS( fn, prec, Nr, conv0, 1, myIter, myThid )
261 WRITE(fn,'(A,A,I10.10)') ConvFile(I1:I2),'.',
262 & intime1*Ifprd +offlineIter0
263 CALL READ_REC_3D_RS( fn, prec, Nr, conv1, 1, myIter, myThid )
264 _EXCH_XYZ_RS(conv0, myThid )
265 _EXCH_XYZ_RS(conv1, myThid )
266 ENDIF
267
268 #ifdef ALLOW_KPP
269 IF ( KPP_DiffSFile .NE. ' ' ) THEN
270 I1=IFNBLNK(KPP_DiffSFile)
271 I2=ILNBLNK(KPP_DiffSFile)
272 WRITE(fn,'(A,A,I10.10)') KPP_DiffSFile(I1:I2),'.',
273 & intime0*Ifprd +offlineIter0
274 CALL READ_REC_3D_RS( fn, prec, Nr, kdfs0, 1, myIter, myThid )
275 WRITE(fn,'(A,A,I10.10)') KPP_DiffSFile(I1:I2),'.',
276 & intime1*Ifprd +offlineIter0
277 CALL READ_REC_3D_RS( fn, prec, Nr, kdfs1, 1, myIter, myThid )
278 _EXCH_XYZ_RS(kdfs0 , myThid )
279 _EXCH_XYZ_RS(kdfs1 , myThid )
280 ENDIF
281
282 IF ( KPP_ghatKFile .NE. ' ' ) THEN
283 C-- Note: assume that KPP_ghatKFile contains the product ghat*diffKzS
284 C even if, for convienience, it will be loaded into array KPPghat
285 I1=IFNBLNK(KPP_ghatKFile)
286 I2=ILNBLNK(KPP_ghatKFile)
287 WRITE(fn,'(A,A,I10.10)') KPP_ghatKFile(I1:I2),'.',
288 & intime0*Ifprd +offlineIter0
289 CALL READ_REC_3D_RS( fn, prec, Nr, kght0, 1, myIter, myThid )
290 WRITE(fn,'(A,A,I10.10)') KPP_ghatKFile(I1:I2),'.',
291 & intime1*Ifprd +offlineIter0
292 CALL READ_REC_3D_RS( fn, prec, Nr, kght1, 1, myIter, myThid )
293 _EXCH_XYZ_RS(kght0, myThid )
294 _EXCH_XYZ_RS(kght1, myThid )
295 ENDIF
296 #endif
297
298 C-- Read in 2-D fields and apply EXCH
299
300 c IF ( HFluxFile .NE. ' ' ) THEN
301 c I1=IFNBLNK(HFluxFile)
302 c I2=ILNBLNK(HFluxFile)
303 c WRITE(fn,'(A,A,I10.10)') HFluxFile(I1:I2),'.',
304 c & intime0*Ifprd +offlineIter0
305 c CALL READ_REC_3D_RS( fn, prec, 1, hflx0, 1, myIter, myThid )
306 c WRITE(fn,'(A,A,I10.10)') HFluxFile(I1:I2),'.',
307 c & intime1*Ifprd +offlineIter0
308 c CALL READ_REC_3D_RS( fn, prec, 1, hflx1, 1, myIter, myThid )
309 c _EXCH_XY_RS(hflx0 , myThid )
310 c _EXCH_XY_RS(hflx1 , myThid )
311 c ENDIF
312
313 IF ( SFluxFile .NE. ' ' ) THEN
314 I1=IFNBLNK(SFluxFile)
315 I2=ILNBLNK(SFluxFile)
316 WRITE(fn,'(A,A,I10.10)') SFluxFile(I1:I2),'.',
317 & intime0*Ifprd +offlineIter0
318 CALL READ_REC_3D_RS( fn, prec, 1, sflx0, 1, myIter, myThid )
319 WRITE(fn,'(A,A,I10.10)') SFluxFile(I1:I2),'.',
320 & intime1*Ifprd +offlineIter0
321 CALL READ_REC_3D_RS( fn, prec, 1, sflx1, 1, myIter, myThid )
322 _EXCH_XY_RS(sflx0, myThid )
323 _EXCH_XY_RS(sflx1, myThid )
324 ENDIF
325
326 c IF ( IceFile .NE. ' ' ) THEN
327 c I1=IFNBLNK(IceFile)
328 c I2=ILNBLNK(IceFile)
329 c WRITE(fn,'(A,A,I10.10)') IceFile(I1:I2),'.',
330 c & intime0*Ifprd +offlineIter0
331 c CALL READ_REC_3D_RS( fn, prec, 1, icem0, 1, myIter, myThid )
332 c WRITE(fn,'(A,A,I10.10)') IceFile(I1:I2),'.',
333 c & intime1*Ifprd +offlineIter0
334 c CALL READ_REC_3D_RS( fn, prec, 1, icem1, 1, myIter, myThid )
335 c _EXCH_XY_RS(icem0, myThid )
336 c _EXCH_XY_RS(icem1, myThid )
337 c ENDIF
338
339 #endif /* else NOT_MODEL_FILES */
340
341 C- save newly loaded time-record
342 DO bj = myByLo(myThid), myByHi(myThid)
343 DO bi = myBxLo(myThid), myBxHi(myThid)
344 offlineLdRec(bi,bj) = intime1
345 ENDDO
346 ENDDO
347
348 C-- end if-block for loading new time-records
349 ENDIF
350
351 C-- Save time-interpolation weights
352 DO bj = myByLo(myThid), myByHi(myThid)
353 DO bi = myBxLo(myThid), myBxHi(myThid)
354 offline_Wght(1,bi,bj) = bWght
355 offline_Wght(2,bi,bj) = aWght
356 ENDDO
357 ENDDO
358
359 C-- Interpolate State Variables: uvel, vvel, wvel
360 IF ( myIter.NE.nIter0 .OR. nonlinFreeSurf.LE.0 ) THEN
361 C Skip initial (nIter0) setting of state vars if loaded from pickup-files
362 C (as it is the case when using Non-Lin Free-Surf)
363 DO bj = myByLo(myThid), myByHi(myThid)
364 DO bi = myBxLo(myThid), myBxHi(myThid)
365
366 DO k=1,Nr
367 DO j=1-OLy,sNy+OLy
368 DO i=1-OLx,sNx+OLx
369 uVel(i,j,k,bi,bj) = bWght*uvel0(i,j,k,bi,bj)
370 & + aWght*uvel1(i,j,k,bi,bj)
371 vVel(i,j,k,bi,bj) = bWght*vvel0(i,j,k,bi,bj)
372 & + aWght*vvel1(i,j,k,bi,bj)
373 wVel(i,j,k,bi,bj) = bWght*wvel0(i,j,k,bi,bj)
374 & + aWght*wvel1(i,j,k,bi,bj)
375 theta(i,j,k,bi,bj)= bWght*tave0(i,j,k,bi,bj)
376 & + aWght*tave1(i,j,k,bi,bj)
377 salt(i,j,k,bi,bj) = bWght*save0(i,j,k,bi,bj)
378 & + aWght*save1(i,j,k,bi,bj)
379 ENDDO
380 ENDDO
381 ENDDO
382 #ifdef NONLIN_FRSURF
383 IF ( select_rStar.GT.0 ) THEN
384 DO k=1,Nr
385 DO j=1-OLy,sNy+OLy
386 DO i=1-OLx,sNx+OLx
387 uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)
388 & / rStarFacW(i,j,bi,bj)
389 vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)
390 & / rStarFacS(i,j,bi,bj)
391 ENDDO
392 ENDDO
393 ENDDO
394 ELSEIF ( nonlinFreeSurf.GT.0 ) THEN
395 STOP 'OFFLINE_FIELDS_LOAD: r-Coord NLFS code missing'
396 ENDIF
397 #endif /* NONLIN_FRSURF */
398
399 C-- end bi,bj loops
400 ENDDO
401 ENDDO
402 ENDIF
403
404 C-- Diagnostics
405 C IF (myThid.EQ.1 .AND. myTime.LT.62208000.) THEN
406 C write(*,'(a,1p5e12.4,3i6,2e12.4)')
407 C & 'time,U,V,W,i0,i1,a,b = ',
408 C & myTime,
409 C & Uvel(1,sNy,1,1,1),Vvel(1,sNy,1,1,1),
410 C & Wvel(1,sNy,1,1,1),
411 C & intime0,intime1,aWght,bWght
412 C write(*,'(a,1p4e12.4,2e12.4)')
413 C & 'time,uvel0,uvel1,U = ',
414 C & myTime,
415 C & uvel0(1,sNy,1,1,1),uvel1(1,sNy,1,1,1),Uvel(1,sNy,1,1,1),
416 C & aWght,bWght
417 C ENDIF
418
419 C endif for periodicForcing
420 ENDIF
421
422 #endif /* ALLOW_OFFLINE */
423
424 RETURN
425 END

  ViewVC Help
Powered by ViewVC 1.1.22