/[MITgcm]/MITgcm/model/src/external_fields_load.F
ViewVC logotype

Annotation of /MITgcm/model/src/external_fields_load.F

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


Revision 1.40 - (hide annotations) (download)
Fri Apr 4 20:56:32 2014 UTC (10 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64w, checkpoint64v, HEAD
Changes since 1.39: +27 -27 lines
- Replace ALLOW_AUTODIFF_TAMC by ALLOW_AUTODIFF (except for tape/storage
  which are specific to TAF/TAMC).

1 jmc 1.40 C $Header: /u/gcmpack/MITgcm/model/src/external_fields_load.F,v 1.39 2011/06/08 01:21:14 jmc Exp $
2 adcroft 1.7 C $Name: $
3 heimbach 1.1
4 edhill 1.13 #include "PACKAGES_CONFIG.h"
5 heimbach 1.1 #include "CPP_OPTIONS.h"
6 jmc 1.27
7 cnh 1.8 CBOP
8     C !ROUTINE: EXTERNAL_FIELDS_LOAD
9     C !INTERFACE:
10 heimbach 1.1 SUBROUTINE EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
11 jmc 1.39
12 cnh 1.8 C !DESCRIPTION: \bv
13     C *==========================================================*
14 jmc 1.27 C | SUBROUTINE EXTERNAL_FIELDS_LOAD
15     C | o Control reading of fields from external source.
16 cnh 1.8 C *==========================================================*
17 jmc 1.27 C | External source field loading routine.
18     C | This routine is called every time we want to
19     C | load a a set of external fields. The routine decides
20     C | which fields to load and then reads them in.
21     C | This routine needs to be customised for particular
22     C | experiments.
23     C | Notes
24     C | =====
25     C | Two-dimensional and three-dimensional I/O are handled in
26     C | the following way under MITgcmUV. A master thread
27     C | performs I/O using system calls. This threads reads data
28     C | into a temporary buffer. At present the buffer is loaded
29     C | with the entire model domain. This is probably OK for now
30     C | Each thread then copies data from the buffer to the
31     C | region of the proper array it is responsible for.
32     C | =====
33     C | Conversion of flux fields are described in FFIELDS.h
34 cnh 1.8 C *==========================================================*
35     C \ev
36    
37     C !USES:
38 heimbach 1.1 IMPLICIT NONE
39     C === Global variables ===
40     #include "SIZE.h"
41     #include "EEPARAMS.h"
42     #include "PARAMS.h"
43     #include "FFIELDS.h"
44     #include "GRID.h"
45 heimbach 1.3 #include "DYNVARS.h"
46 jmc 1.27
47 cnh 1.8 C !INPUT/OUTPUT PARAMETERS:
48 heimbach 1.1 C === Routine arguments ===
49 jmc 1.35 C myTime :: Simulation time
50     C myIter :: Simulation timestep number
51     C myThid :: Thread no. that called this routine.
52 heimbach 1.1 _RL myTime
53     INTEGER myIter
54 jmc 1.35 INTEGER myThid
55 jmc 1.27
56 jmc 1.29 #ifndef EXCLUDE_FFIELDS_LOAD
57    
58 cnh 1.8 C !LOCAL VARIABLES:
59 heimbach 1.1 C === Local arrays ===
60 cnh 1.8 C aWght, bWght :: Interpolation weights
61 jmc 1.35 INTEGER bi, bj, i, j
62     INTEGER intimeP, intime0, intime1
63     _RL aWght, bWght
64 cnh 1.8 CEOP
65 heimbach 1.1
66     IF ( periodicExternalForcing ) THEN
67    
68 jmc 1.35 C-- First call requires that we initialize everything to zero for safety
69     cph has been shifted to ini_forcing.F
70    
71     C-- Now calculate whether it is time to update the forcing arrays
72     CALL GET_PERIODIC_INTERVAL(
73     O intimeP, intime0, intime1, bWght, aWght,
74     I externForcingCycle, externForcingPeriod,
75 jmc 1.40 I deltaTClock, myTime, myThid )
76 jmc 1.35
77     bi = myBxLo(myThid)
78     bj = myByLo(myThid)
79 jmc 1.37 #ifdef ALLOW_DEBUG
80 jmc 1.39 IF ( debugLevel.GE.debLevB ) THEN
81 jmc 1.37 _BEGIN_MASTER(myThid)
82     WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
83     & ' EXTERNAL_FIELDS_LOAD,', myIter,
84     & ' : iP,iLd,i0,i1=', intimeP,loadedRec(bi,bj), intime0,intime1,
85     & ' ; Wght=', bWght, aWght
86     _END_MASTER(myThid)
87     ENDIF
88     #endif /* ALLOW_DEBUG */
89 jmc 1.40 #ifdef ALLOW_AUTODIFF
90 jmc 1.35 C- assuming that we call S/R EXTERNAL_FIELDS_LOAD at each time-step and
91     C with increasing time, this will catch when we need to load new records;
92     C But with Adjoint run, this is not always the case => might end-up using
93     C the wrong time-records
94 jmc 1.38 # ifndef STORE_LOADEDREC_TEST
95 jmc 1.35 IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
96 jmc 1.38 # else
97     IF ( intime1.NE.loadedRec(bi,bj) ) THEN
98     # endif
99 jmc 1.40 #else /* ALLOW_AUTODIFF */
100 jmc 1.35 C- Make no assumption on sequence of calls to EXTERNAL_FIELDS_LOAD ;
101     C This is the correct formulation (works in Adjoint run).
102     C Unfortunatly, produces many recomputations <== not used until it is fixed
103 jmc 1.37 IF ( intime1.NE.loadedRec(bi,bj) ) THEN
104 jmc 1.40 #endif /* ALLOW_AUTODIFF */
105 jmc 1.35
106     C-- If the above condition is met then we need to read in
107     C data for the period ahead and the period behind myTime.
108 jmc 1.39 IF ( debugLevel.GE.debLevZero ) THEN
109     _BEGIN_MASTER(myThid)
110     WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
111     & ' EXTERNAL_FIELDS_LOAD, it=', myIter,
112     & ' : Reading new data, i0,i1=', intime0, intime1,
113 jmc 1.37 & ' (prev=', intimeP, loadedRec(bi,bj), ' )'
114 jmc 1.39 _END_MASTER(myThid)
115     ENDIF
116 heimbach 1.1
117 jmc 1.35 IF ( zonalWindFile .NE. ' ' ) THEN
118     CALL READ_REC_XY_RS( zonalWindFile, taux0,
119     & intime0, myIter, myThid )
120     CALL READ_REC_XY_RS( zonalWindFile, taux1,
121     & intime1, myIter, myThid )
122     ENDIF
123     IF ( meridWindFile .NE. ' ' ) THEN
124     CALL READ_REC_XY_RS( meridWindFile, tauy0,
125     & intime0, myIter, myThid )
126     CALL READ_REC_XY_RS( meridWindFile, tauy1,
127     & intime1, myIter, myThid )
128     ENDIF
129     IF ( surfQFile .NE. ' ' ) THEN
130     CALL READ_REC_XY_RS( surfQFile, Qnet0,
131     & intime0, myIter, myThid )
132     CALL READ_REC_XY_RS( surfQFile, Qnet1,
133     & intime1, myIter, myThid )
134     ELSEIF ( surfQnetFile .NE. ' ' ) THEN
135     CALL READ_REC_XY_RS( surfQnetFile, Qnet0,
136     & intime0, myIter, myThid )
137     CALL READ_REC_XY_RS( surfQnetFile, Qnet1,
138     & intime1, myIter, myThid )
139     ENDIF
140     IF ( EmPmRfile .NE. ' ' ) THEN
141     CALL READ_REC_XY_RS( EmPmRfile, EmPmR0,
142     & intime0, myIter, myThid )
143     CALL READ_REC_XY_RS( EmPmRfile, EmPmR1,
144     & intime1, myIter, myThid )
145     c IF ( convertEmP2rUnit.EQ.mass2rUnit ) THEN
146     C- EmPmR is now (after c59h) expressed in kg/m2/s (fresh water mass flux)
147     DO bj = myByLo(myThid), myByHi(myThid)
148     DO bi = myBxLo(myThid), myBxHi(myThid)
149 jmc 1.40 DO j=1-OLy,sNy+OLy
150     DO i=1-OLx,sNx+OLx
151 jmc 1.35 EmPmR0(i,j,bi,bj) = EmPmR0(i,j,bi,bj)*rhoConstFresh
152     EmPmR1(i,j,bi,bj) = EmPmR1(i,j,bi,bj)*rhoConstFresh
153     ENDDO
154     ENDDO
155 jmc 1.30 ENDDO
156     ENDDO
157 jmc 1.35 c ENDIF
158     ENDIF
159     IF ( saltFluxFile .NE. ' ' ) THEN
160     CALL READ_REC_XY_RS( saltFluxFile, saltFlux0,
161     & intime0, myIter, myThid )
162     CALL READ_REC_XY_RS( saltFluxFile, saltFlux1,
163     & intime1, myIter, myThid )
164     ENDIF
165     IF ( thetaClimFile .NE. ' ' ) THEN
166     CALL READ_REC_XY_RS( thetaClimFile, SST0,
167     & intime0, myIter, myThid )
168     CALL READ_REC_XY_RS( thetaClimFile, SST1,
169     & intime1, myIter, myThid )
170     ENDIF
171     IF ( saltClimFile .NE. ' ' ) THEN
172     CALL READ_REC_XY_RS( saltClimFile, SSS0,
173     & intime0, myIter, myThid )
174     CALL READ_REC_XY_RS( saltClimFile, SSS1,
175     & intime1, myIter, myThid )
176     ENDIF
177 heimbach 1.12 #ifdef SHORTWAVE_HEATING
178 jmc 1.35 IF ( surfQswFile .NE. ' ' ) THEN
179     CALL READ_REC_XY_RS( surfQswFile, Qsw0,
180     & intime0, myIter, myThid )
181     CALL READ_REC_XY_RS( surfQswFile, Qsw1,
182     & intime1, myIter, myThid )
183     IF ( surfQFile .NE. ' ' ) THEN
184     C- Qnet is now (after c54) the net Heat Flux (including SW)
185     DO bj = myByLo(myThid), myByHi(myThid)
186     DO bi = myBxLo(myThid), myBxHi(myThid)
187 jmc 1.40 DO j=1-OLy,sNy+OLy
188     DO i=1-OLx,sNx+OLx
189 jmc 1.35 Qnet0(i,j,bi,bj) = Qnet0(i,j,bi,bj) + Qsw0(i,j,bi,bj)
190     Qnet1(i,j,bi,bj) = Qnet1(i,j,bi,bj) + Qsw1(i,j,bi,bj)
191     ENDDO
192     ENDDO
193 jmc 1.18 ENDDO
194     ENDDO
195 jmc 1.35 ENDIF
196     ENDIF
197 heimbach 1.12 #endif
198 mlosch 1.11 #ifdef ATMOSPHERIC_LOADING
199 jmc 1.35 IF ( pLoadFile .NE. ' ' ) THEN
200     CALL READ_REC_XY_RS( pLoadFile, pLoad0,
201     & intime0, myIter, myThid )
202     CALL READ_REC_XY_RS( pLoadFile, pLoad1,
203     & intime1, myIter, myThid )
204     ENDIF
205 heimbach 1.1 #endif
206    
207 jmc 1.27 C- thread synchronisation (barrier) is part of the EXCH S/R calls
208 jmc 1.35 _EXCH_XY_RS(SST0 , myThid )
209     _EXCH_XY_RS(SST1 , myThid )
210     _EXCH_XY_RS(SSS0 , myThid )
211     _EXCH_XY_RS(SSS1 , myThid )
212     CALL EXCH_UV_XY_RS(taux0,tauy0,.TRUE.,myThid)
213     CALL EXCH_UV_XY_RS(taux1,tauy1,.TRUE.,myThid)
214     _EXCH_XY_RS(Qnet0, myThid )
215     _EXCH_XY_RS(Qnet1, myThid )
216     _EXCH_XY_RS(EmPmR0, myThid )
217     _EXCH_XY_RS(EmPmR1, myThid )
218     _EXCH_XY_RS(saltFlux0, myThid )
219     _EXCH_XY_RS(saltFlux1, myThid )
220 heimbach 1.12 #ifdef SHORTWAVE_HEATING
221 jmc 1.35 _EXCH_XY_RS(Qsw0, myThid )
222     _EXCH_XY_RS(Qsw1, myThid )
223 heimbach 1.12 #endif
224 mlosch 1.11 #ifdef ATMOSPHERIC_LOADING
225 jmc 1.35 _EXCH_XY_RS(pLoad0, myThid )
226     _EXCH_XY_RS(pLoad1, myThid )
227 mlosch 1.11 #endif
228 jmc 1.27
229 jmc 1.35 C- save newly loaded time-record
230     DO bj = myByLo(myThid), myByHi(myThid)
231     DO bi = myBxLo(myThid), myBxHi(myThid)
232 jmc 1.37 loadedRec(bi,bj) = intime1
233 jmc 1.35 ENDDO
234     ENDDO
235    
236     C-- end if-block for loading new time-records
237 heimbach 1.1 ENDIF
238    
239 heimbach 1.12 C-- Interpolate fu,fv,Qnet,EmPmR,SST,SSS,Qsw
240 heimbach 1.1 DO bj = myByLo(myThid), myByHi(myThid)
241     DO bi = myBxLo(myThid), myBxHi(myThid)
242 jmc 1.25 IF ( thetaClimFile .NE. ' ' ) THEN
243 jmc 1.40 DO j=1-OLy,sNy+OLy
244     DO i=1-OLx,sNx+OLx
245 jmc 1.27 SST(i,j,bi,bj) = bWght*SST0(i,j,bi,bj)
246 jmc 1.25 & + aWght*SST1(i,j,bi,bj)
247     ENDDO
248     ENDDO
249     ENDIF
250     IF ( saltClimFile .NE. ' ' ) THEN
251 jmc 1.40 DO j=1-OLy,sNy+OLy
252     DO i=1-OLx,sNx+OLx
253 jmc 1.27 SSS(i,j,bi,bj) = bWght*SSS0(i,j,bi,bj)
254 jmc 1.25 & + aWght*SSS1(i,j,bi,bj)
255     ENDDO
256     ENDDO
257     ENDIF
258     IF ( zonalWindFile .NE. ' ' ) THEN
259 jmc 1.40 DO j=1-OLy,sNy+OLy
260     DO i=1-OLx,sNx+OLx
261 jmc 1.27 fu(i,j,bi,bj) = bWght*taux0(i,j,bi,bj)
262 jmc 1.25 & + aWght*taux1(i,j,bi,bj)
263     ENDDO
264     ENDDO
265     ENDIF
266     IF ( meridWindFile .NE. ' ' ) THEN
267 jmc 1.40 DO j=1-OLy,sNy+OLy
268     DO i=1-OLx,sNx+OLx
269 jmc 1.27 fv(i,j,bi,bj) = bWght*tauy0(i,j,bi,bj)
270 jmc 1.25 & + aWght*tauy1(i,j,bi,bj)
271     ENDDO
272     ENDDO
273     ENDIF
274     IF ( surfQnetFile .NE. ' '
275     & .OR. surfQFile .NE. ' ' ) THEN
276 jmc 1.40 DO j=1-OLy,sNy+OLy
277     DO i=1-OLx,sNx+OLx
278 jmc 1.25 Qnet(i,j,bi,bj) = bWght*Qnet0(i,j,bi,bj)
279     & + aWght*Qnet1(i,j,bi,bj)
280     ENDDO
281     ENDDO
282     ENDIF
283     IF ( EmPmRfile .NE. ' ' ) THEN
284 jmc 1.40 DO j=1-OLy,sNy+OLy
285     DO i=1-OLx,sNx+OLx
286 jmc 1.25 EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)
287     & + aWght*EmPmR1(i,j,bi,bj)
288     ENDDO
289     ENDDO
290     ENDIF
291     IF ( saltFluxFile .NE. ' ' ) THEN
292 jmc 1.40 DO j=1-OLy,sNy+OLy
293     DO i=1-OLx,sNx+OLx
294 jmc 1.25 saltFlux(i,j,bi,bj) = bWght*saltFlux0(i,j,bi,bj)
295     & + aWght*saltFlux1(i,j,bi,bj)
296     ENDDO
297     ENDDO
298     ENDIF
299     #ifdef SHORTWAVE_HEATING
300     IF ( surfQswFile .NE. ' ' ) THEN
301 jmc 1.40 DO j=1-OLy,sNy+OLy
302     DO i=1-OLx,sNx+OLx
303 jmc 1.25 Qsw(i,j,bi,bj) = bWght*Qsw0(i,j,bi,bj)
304     & + aWght*Qsw1(i,j,bi,bj)
305     ENDDO
306     ENDDO
307     ENDIF
308     #endif
309     #ifdef ATMOSPHERIC_LOADING
310     IF ( pLoadFile .NE. ' ' ) THEN
311 jmc 1.40 DO j=1-OLy,sNy+OLy
312     DO i=1-OLx,sNx+OLx
313 jmc 1.29 pLoad(i,j,bi,bj) = bWght*pLoad0(i,j,bi,bj)
314     & + aWght*pLoad1(i,j,bi,bj)
315 jmc 1.25 ENDDO
316     ENDDO
317     ENDIF
318     #endif
319 heimbach 1.1 ENDDO
320     ENDDO
321 heimbach 1.3
322 jmc 1.19 C-- Print for checking:
323 jmc 1.37 #ifdef ALLOW_DEBUG
324 jmc 1.39 IF ( debugLevel.GE.debLevC ) THEN
325 jmc 1.17 _BEGIN_MASTER( myThid )
326 jmc 1.37 WRITE(standardMessageUnit,'(A,1P4E12.4)')
327     & ' EXTERNAL_FIELDS_LOAD: (fu0,1),fu,fv=',
328     & taux0(1,sNy,1,1), taux1(1,sNy,1,1),
329     & fu(1,sNy,1,1), fv(1,sNy,1,1)
330     WRITE(standardMessageUnit,'(A,1P4E12.4)')
331     & ' EXTERNAL_FIELDS_LOAD: SST,SSS,Q,E-P=',
332     & SST(1,sNy,1,1), SSS(1,sNy,1,1),
333     & Qnet(1,sNy,1,1), EmPmR(1,sNy,1,1)
334 jmc 1.17 _END_MASTER( myThid )
335 heimbach 1.3 ENDIF
336 jmc 1.37 #endif /* ALLOW_DEBUG */
337 heimbach 1.1
338     C endif for periodicForcing
339     ENDIF
340 heimbach 1.12
341 jmc 1.29 #endif /* EXCLUDE_FFIELDS_LOAD */
342 jmc 1.16
343 heimbach 1.1 RETURN
344     END

  ViewVC Help
Powered by ViewVC 1.1.22