/[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.2 - (show annotations) (download)
Fri Sep 3 18:07:29 2004 UTC (19 years, 9 months ago) by stephd
Branch: MAIN
CVS Tags: checkpoint55c_post, checkpoint55d_pre, checkpoint55h_post, checkpoint55b_post, checkpoint55, checkpoint54f_post, checkpoint55g_post, checkpoint55f_post, checkpoint55e_post, checkpoint55a_post, checkpoint55d_post
Changes since 1.1: +109 -32 lines
o include surface forcing as files read in by offline code,
  make filenames (slightly) more general for reading in

1
2 #include "CPP_OPTIONS.h"
3 #include "OFFLINE_OPTIONS.h"
4
5 C !ROUTINE: OFFLINE_FIELDS_LOAD
6 C !INTERFACE:
7 SUBROUTINE OFFLINE_FIELDS_LOAD( myTime, myIter, myThid )
8 C *==========================================================*
9 C | SUBROUTINE OFFLINE_FIELDS_LOAD
10 C | o Control reading of fields from external source.
11 C *==========================================================*
12 C | Offline External source field loading routine.
13 C | This routine is called every time we want to
14 C | load a a set of external fields. The routine decides
15 C | which fields to load and then reads them in.
16 C | This routine needs to be customised for particular
17 C | experiments.
18 C | Notes
19 C | =====
20 C | currently the file names need to be specific lengths
21 C | would like to make this more flexible QQ
22 C *==========================================================*
23
24 C !USES:
25 IMPLICIT NONE
26 C === Global variables ===
27 #include "SIZE.h"
28 #include "EEPARAMS.h"
29 #include "PARAMS.h"
30 #include "FFIELDS.h"
31 #include "GRID.h"
32 #include "DYNVARS.h"
33 #ifdef ALLOW_GMREDI
34 #include "GMREDI.h"
35 #include "GMREDI_DIAGS.h"
36 #endif
37 #ifdef ALLOW_OFFLINE
38 #include "OFFLINE.h"
39 #endif
40
41 LOGICAL DIFFERENT_MULTIPLE
42 EXTERNAL DIFFERENT_MULTIPLE
43
44 C !INPUT/OUTPUT PARAMETERS:
45 C === Routine arguments ===
46 C myThid - Thread no. that called this routine.
47 C myTime - Simulation time
48 C myIter - Simulation timestep number
49 INTEGER myThid
50 _RL myTime
51 INTEGER myIter
52
53 c fn :: Temp. for building file name.
54 CHARACTER*(MAX_LEN_FNAM) fn
55 CHARACTER*18 fn2
56 CHARACTER*15 fn3
57 CHARACTER*19 fn4
58 INTEGER prec
59
60
61
62 C !LOCAL VARIABLES:
63 C === Local arrays ===
64 C uvel[01] :: Temp. for u
65 C vvel[01] :: Temp. for v
66 C wvel[01] :: Temp. for w
67 c conv[01] :: Temp for Convection Count
68 C [01] :: End points for interpolation
69 C Above use static heap storage to allow exchange.
70 C aWght, bWght :: Interpolation weights
71 COMMON /OFFLINEFFIELDS/
72 & uvel0, vvel0, wvel0, tave0, save0,
73 & conv0, gmkx0, gmky0, gmkz0, hflx0,
74 & sflx0,
75 & uvel1, vvel1, wvel1, tave1, save1,
76 & conv1, gmkx1, gmky1, gmkz1, hflx1,
77 & sflx1
78 _RS uvel0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
79 _RS uvel1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
80 _RS vvel0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
81 _RS vvel1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
82 _RS wvel0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
83 _RS wvel1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
84 _RS tave0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
85 _RS tave1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
86 _RS save0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
87 _RS save1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
88 _RS conv0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
89 _RS conv1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
90 _RS gmkx0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
91 _RS gmkx1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
92 _RS gmky0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
93 _RS gmky1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
94 _RS gmkz0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
95 _RS gmkz1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
96 _RS hflx0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
97 _RS hflx1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
98 _RS sflx0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
99 _RS sflx1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
100 c _RS tmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
101 _RL tmp
102 _RL sfac (1-OLy:sNy+OLy,nSy)
103
104
105 INTEGER bi,bj,i,j,k,intime0,intime1
106 _RL aWght,bWght,rdt, KGM
107 INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
108
109 #ifdef ALLOW_OFFLINE
110 CALL TIMER_START('OFFLINE_FIELDS_LOAD [I/O]', myThid)
111 prec = precFloat32
112 KGM=1.d0
113
114 IF ( periodicExternalForcing ) THEN
115
116 C First call requires that we initialize everything to zero for safety
117 IF ( myIter .EQ. nIter0 ) THEN
118 CALL LEF_ZERO3( uvel0 ,myThid )
119 CALL LEF_ZERO3( vvel0 ,myThid )
120 CALL LEF_ZERO3( wvel0 ,myThid )
121 CALL LEF_ZERO3( tave0 ,myThid )
122 CALL LEF_ZERO3( save0 ,myThid )
123 CALL LEF_ZERO3( conv0 ,myThid )
124 CALL LEF_ZERO3( gmkx0 ,myThid )
125 CALL LEF_ZERO3( gmky0 ,myThid )
126 CALL LEF_ZERO3( gmkz0 ,myThid )
127 CALL LEF_ZERO2( hflx0 ,myThid )
128 CALL LEF_ZERO2( sflx0 ,myThid )
129 CALL LEF_ZERO3( uvel1 ,myThid )
130 CALL LEF_ZERO3( vvel1 ,myThid )
131 CALL LEF_ZERO3( wvel1 ,myThid )
132 CALL LEF_ZERO3( tave1 ,myThid )
133 CALL LEF_ZERO3( save1 ,myThid )
134 CALL LEF_ZERO3( conv1 ,myThid )
135 CALL LEF_ZERO3( gmkx1 ,myThid )
136 CALL LEF_ZERO3( gmky1 ,myThid )
137 CALL LEF_ZERO3( gmkz1 ,myThid )
138 CALL LEF_ZERO2( hflx1 ,myThid )
139 CALL LEF_ZERO2( sflx1 ,myThid )
140 ENDIF
141
142 C Now calculate whether it is time to update the forcing arrays
143 rdt=1. _d 0 / deltaTclock
144 nForcingPeriods=int(offlineForcingCycle/offlineForcingPeriod+0.5)
145 Imytm=int(myTime*rdt+0.5)
146 Ifprd=int(offlineForcingPeriod*rdt+0.5)
147 Ifcyc=int(offlineForcingCycle*rdt+0.5)
148 Iftm=mod( Imytm+Ifcyc-Ifprd/2 ,Ifcyc)
149
150 intime0=int(Iftm/Ifprd)
151 intime1=mod(intime0+1,nForcingPeriods)
152 aWght=float( Iftm-Ifprd*intime0 )/float( Ifprd )
153 bWght=1.-aWght
154
155 intime0=intime0+1
156 INTIME1=intime1+1
157
158 IF (
159 & Iftm-Ifprd*(intime0-1) .EQ. 0
160 & .OR. myIter .EQ. nIter0
161 & ) THEN
162
163 _BEGIN_MASTER(myThid)
164
165 C If the above condition is met then we need to read in
166 C data for the period ahead and the period behind myTime.
167 WRITE(*,*)
168 & 'S/R OFFLINE_FIELDS_LOAD: Reading new data',myTime,myIter
169 & , nIter0, intime0,intime1
170
171 #ifdef NOT_MODEL_FILES
172 c if reading own files setup reading here
173 #else
174 c
175 IF ( Uvelfile .NE. ' ' ) THEN
176 WRITE(fn2,'(A)') Uvelfile
177 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
178 CALL MDSREADFIELD(fn,prec,'RL',Nr,uvel0, 1,myThid)
179 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
180 CALL MDSREADFIELD(fn,prec,'RL',Nr,uvel1, 1,myThid)
181 ENDIF
182 c
183 IF ( Vvelfile .NE. ' ' ) THEN
184 WRITE(fn2,'(A)') Vvelfile
185 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
186 CALL MDSREADFIELD(fn,prec,'RL',Nr,vvel0, 1,myThid)
187 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
188 CALL MDSREADFIELD(fn,prec,'RL',Nr,vvel1, 1,myThid)
189 ENDIF
190 c
191 IF (Wvelfile .NE. ' ' ) THEN
192 WRITE(fn2,'(A)') Wvelfile
193 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
194 CALL MDSREADFIELD(fn,prec,'RL',Nr,wvel0, 1,myThid)
195 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
196 CALL MDSREADFIELD(fn,prec,'RL',Nr,wvel1, 1,myThid)
197 ENDIF
198
199 IF (Thetfile .NE. ' ' ) THEN
200 WRITE(fn3,'(A)') Thetfile
201 WRITE(fn,'(A,A,I10.10)') fn3,'.',intime0*Ifprd+offlineIter0
202 CALL MDSREADFIELD(fn,prec,'RL',Nr,tave0, 1,myThid)
203 WRITE(fn,'(A,A,I10.10)') fn3,'.',intime1*Ifprd+offlineIter0
204 CALL MDSREADFIELD(fn,prec,'RL',Nr,tave1, 1,myThid)
205 ENDIF
206
207 IF (Saltfile .NE. ' ' ) THEN
208 WRITE(fn3,'(A)') Saltfile
209 WRITE(fn,'(A,A,I10.10)') fn3,'.',intime0*Ifprd+offlineIter0
210 CALL MDSREADFIELD(fn,prec,'RL',Nr,save0, 1,myThid)
211 WRITE(fn,'(A,A,I10.10)') fn3,'.',intime1*Ifprd+offlineIter0
212 CALL MDSREADFIELD(fn,prec,'RL',Nr,save1, 1,myThid)
213 ENDIF
214
215 IF (ConvFile .NE. ' ' ) THEN
216 WRITE(fn2,'(A)') ConvFile
217 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
218 CALL MDSREADFIELD(fn,prec,'RL',Nr,conv0, 1,myThid)
219 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
220 CALL MDSREADFIELD(fn,prec,'RL',Nr,conv1, 1,myThid)
221 ENDIF
222 c
223
224 IF (GMwxFile .NE. ' ' ) THEN
225 WRITE(fn2,'(A)') GMwxFile
226 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
227 CALL MDSREADFIELD(fn,prec,'RL',Nr,gmkx0, 1,myThid)
228 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
229 CALL MDSREADFIELD(fn,prec,'RL',Nr,gmkx1, 1,myThid)
230 ENDIF
231
232 IF (GMwyFile .NE. ' ') THEN
233 WRITE(fn2,'(A)') GMwyFile
234 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
235 CALL MDSREADFIELD(fn,prec,'RL',Nr,gmky0, 1,myThid)
236 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
237 CALL MDSREADFIELD(fn,prec,'RL',Nr,gmky1, 1,myThid)
238 ENDIF
239 c
240 IF (GMwzFile .NE. ' ') THEN
241 WRITE(fn2,'(A)') GMwzFile
242 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime0*Ifprd+offlineIter0
243 CALL MDSREADFIELD(fn,prec,'RL',Nr,gmkz0, 1,myThid)
244 WRITE(fn,'(A,A,I10.10)') fn2,'.',intime1*Ifprd+offlineIter0
245 CALL MDSREADFIELD(fn,prec,'RL',Nr,gmkz1, 1,myThid)
246 ENDIF
247 c
248 IF (HFluxFile .NE. ' ') THEN
249 WRITE(fn4,'(A)') HFluxFile
250 WRITE(fn,'(A,A,I10.10)') fn4,'.',intime0*Ifprd+offlineIter0
251 CALL MDSREADFIELD(fn,prec,'RL',1,hflx0, 1,myThid)
252 WRITE(fn,'(A,A,I10.10)') fn4,'.',intime1*Ifprd+offlineIter0
253 CALL MDSREADFIELD(fn,prec,'RL',1,hflx1, 1,myThid)
254 ENDIF
255 c
256 IF (SFluxFile .NE. ' ') THEN
257 WRITE(fn4,'(A)') SFluxFile
258 WRITE(fn,'(A,A,I10.10)') fn4,'.',intime0*Ifprd+offlineIter0
259 CALL MDSREADFIELD(fn,prec,'RL',1,sflx0, 1,myThid)
260 WRITE(fn,'(A,A,I10.10)') fn4,'.',intime1*Ifprd+offlineIter0
261 CALL MDSREADFIELD(fn,prec,'RL',1,sflx1, 1,myThid)
262 ENDIF
263 c
264 #endif /* else NOT_MODEL_FILES */
265
266 _END_MASTER(myThid)
267
268 C
269 _EXCH_XYZ_R4(uvel0 , myThid )
270 _EXCH_XYZ_R4(uvel1 , myThid )
271 _EXCH_XYZ_R4(vvel0 , myThid )
272 _EXCH_XYZ_R4(vvel1 , myThid )
273 _EXCH_XYZ_R4(wvel0, myThid )
274 _EXCH_XYZ_R4(wvel1, myThid )
275 _EXCH_XYZ_R4(tave0 , myThid )
276 _EXCH_XYZ_R4(tave1 , myThid )
277 _EXCH_XYZ_R4(save0, myThid )
278 _EXCH_XYZ_R4(save1, myThid )
279 _EXCH_XYZ_R4(conv0, myThid )
280 _EXCH_XYZ_R4(conv1, myThid )
281 _EXCH_XYZ_R4(gmkx0, myThid )
282 _EXCH_XYZ_R4(gmkx1, myThid )
283 _EXCH_XYZ_R4(gmky0 , myThid )
284 _EXCH_XYZ_R4(gmky1 , myThid )
285 _EXCH_XYZ_R4(gmkz0, myThid )
286 _EXCH_XYZ_R4(gmkz1, myThid )
287 _EXCH_XY_R4(hflx0 , myThid )
288 _EXCH_XY_R4(hflx1 , myThid )
289 _EXCH_XY_R4(sflx0, myThid )
290 _EXCH_XY_R4(sflx1, myThid )
291
292
293 c
294 ENDIF
295 c
296
297 C-- Interpolate uvel, vvel, wvel
298 DO bj = myByLo(myThid), myByHi(myThid)
299 DO bi = myBxLo(myThid), myBxHi(myThid)
300 do k=1,Nr
301 DO j=1-Oly,sNy+Oly
302 DO i=1-Olx,sNx+Olx
303 Uvel(i,j,k,bi,bj) = bWght*uvel0(i,j,k,bi,bj)
304 & +aWght*uvel1(i,j,k,bi,bj)
305 Vvel(i,j,k,bi,bj) = bWght*vvel0(i,j,k,bi,bj)
306 & +aWght*vvel1(i,j,k,bi,bj)
307 Wvel(i,j,k,bi,bj) = bWght*wvel0(i,j,k,bi,bj)
308 & +aWght*wvel1(i,j,k,bi,bj)
309 theta(i,j,k,bi,bj) = bWght*tave0(i,j,k,bi,bj)
310 & +aWght*tave1(i,j,k,bi,bj)
311 salt(i,j,k,bi,bj) = bWght*save0(i,j,k,bi,bj)
312 & +aWght*save1(i,j,k,bi,bj)
313 ConvectCount(i,j,k,bi,bj) = bWght*conv0(i,j,k,bi,bj)
314 & +aWght*conv1(i,j,k,bi,bj)
315 IVDConvCount(i,j,k,bi,bj) = bWght*conv0(i,j,k,bi,bj)
316 & +aWght*conv1(i,j,k,bi,bj)
317 #ifdef ALLOW_GMREDI
318 Kwx(i,j,k,bi,bj) = bWght*gmkx0(i,j,k,bi,bj)
319 & +aWght*gmkx1(i,j,k,bi,bj)
320 Kwy(i,j,k,bi,bj) = bWght*gmky0(i,j,k,bi,bj)
321 & +aWght*gmky1(i,j,k,bi,bj)
322 Kwz(i,j,k,bi,bj) = bWght*gmkz0(i,j,k,bi,bj)
323 & +aWght*gmkz1(i,j,k,bi,bj)
324 #endif
325 surfaceForcingT(i,j,bi,bj) = bWght*hflx0(i,j,bi,bj)
326 & +aWght*hflx1(i,j,bi,bj)
327 surfaceForcingT(i,j,bi,bj) = surfaceForcingT(i,j,bi,bj)/
328 & (HeatCapacity_Cp*recip_horiVertRatio*rhoConst)
329 surfaceForcingS(i,j,bi,bj) = bWght*sflx0(i,j,bi,bj)
330 & +aWght*sflx1(i,j,bi,bj)
331 surfaceForcingS(i,j,bi,bj) = surfaceForcingS(i,j,bi,bj)/
332 & (recip_horiVertRatio*rhoConst)
333 ENDDO
334 ENDDO
335 ENDDO
336 ENDDO
337 ENDDO
338
339 CC-- Diagnostics
340 C IF (myThid.EQ.1 .AND. myTime.LT.62208000.) THEN
341 C write(*,'(a,1p5e12.4,3i6,2e12.4)')
342 C & 'time,U,V,W,i0,i1,a,b = ',
343 C & myTime,
344 C & Uvel(1,sNy,1,1,1),Vvel(1,sNy,1,1,1),
345 C & Wvel(1,sNy,1,1,1),
346 C & intime0,intime1,aWght,bWght
347 C write(*,'(a,1p4e12.4,2e12.4)')
348 C & 'time,uvel0,uvel1,U = ',
349 C & myTime,
350 C & uvel0(1,sNy,1,1,1),uvel1(1,sNy,1,1,1),Uvel(1,sNy,1,1,1),
351 C & aWght,bWght
352 C ENDIF
353
354 C endif for periodicForcing
355 ENDIF
356
357 #endif
358 c! ALLOW_OFFLINE
359
360 RETURN
361 END
362
363 C !ROUTINE: LEF_ZERO3
364 C !INTERFACE:
365 SUBROUTINE LEF_ZERO3( arr ,myThid )
366 C !DESCRIPTION: \bv
367 C This routine simply sets the argument array to zero
368 C Used only by EXTERNAL_FIELDS_LOAD
369 C \ev
370 C !USES:
371 IMPLICIT NONE
372 C === Global variables ===
373 #include "SIZE.h"
374 #include "EEPARAMS.h"
375 C !INPUT/OUTPUT PARAMETERS:
376 C === Arguments ===
377 _RS arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
378 INTEGER myThid
379 C !LOCAL VARIABLES:
380 C === Local variables ===
381 INTEGER i,j,bi,bj,k
382 CEOP
383
384 DO bj = myByLo(myThid), myByHi(myThid)
385 DO bi = myBxLo(myThid), myBxHi(myThid)
386 do k=1,Nr
387 DO j=1-Oly,sNy+Oly
388 DO i=1-Olx,sNx+Olx
389 arr(i,j,k,bi,bj)=0.
390 ENDDO
391 ENDDO
392 enddo
393 ENDDO
394 ENDDO
395 CALL TIMER_STOP ('OFFLINE_FIELDS_LOAD [I/O]', myThid)
396
397 RETURN
398 END
399
400 C !ROUTINE: LEF_ZERO2
401 C !INTERFACE:
402 SUBROUTINE LEF_ZERO2( arr ,myThid )
403 C !DESCRIPTION: \bv
404 C This routine simply sets the argument array to zero
405 C Used only by EXTERNAL_FIELDS_LOAD
406 C \ev
407 C !USES:
408 IMPLICIT NONE
409 C === Global variables ===
410 #include "SIZE.h"
411 #include "EEPARAMS.h"
412 C !INPUT/OUTPUT PARAMETERS:
413 C === Arguments ===
414 _RS arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
415 INTEGER myThid
416 C !LOCAL VARIABLES:
417 C === Local variables ===
418 INTEGER i,j,bi,bj
419 CEOP
420 DO bj = myByLo(myThid), myByHi(myThid)
421 DO bi = myBxLo(myThid), myBxHi(myThid)
422 DO j=1-Oly,sNy+Oly
423 DO i=1-Olx,sNx+Olx
424 arr(i,j,bi,bj)=0.
425 ENDDO
426 ENDDO
427 ENDDO
428 ENDDO
429 CALL TIMER_STOP ('OFFLINE_FIELDS_LOAD [I/O]', myThid)
430
431 RETURN
432 END
433

  ViewVC Help
Powered by ViewVC 1.1.22