/[MITgcm]/MITgcm/pkg/seaice/seaice_get_forcing.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/seaice_get_forcing.F

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


Revision 1.4 - (hide annotations) (download)
Sat Dec 28 10:11:11 2002 UTC (21 years, 4 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint47j_post, checkpoint48d_pre, checkpoint47f_post, checkpoint48d_post, checkpoint48a_post, checkpoint48e_post, checkpoint47h_post, checkpoint48c_post, checkpoint47i_post, checkpoint48, checkpoint47g_post, checkpoint48b_post, checkpoint48c_pre
Branch point for: c24_e25_ice, ecco-branch
Changes since 1.3: +178 -175 lines
checkpoint47f_post
Merging from release1_p10:
o modifications for using pkg/exf with pkg/seaice
  - pkg/seaice CPP options SEAICE_EXTERNAL_FORCING
    and SEAICE_EXTERNAL_FLUXES
  - pkg/exf CPP options EXF_READ_EVAP and
    EXF_NO_BULK_COMPUTATIONS
  - usage examples are Experiments 8 and 9 in
    verification/lab_sea/README
  - verification/lab_sea default experiment now uses
    pkg/gmredi, pkg/kpp, pkg/seaice, and pkg/exf

1 heimbach 1.2 C $Header:
2    
3     #include "SEAICE_OPTIONS.h"
4    
5     CStartOfInterface
6     SUBROUTINE SEAICE_GET_FORCING( myTime, myIter, myThid )
7     C /==========================================================\
8     C | SUBROUTINE SEAICE_GET_FORCING |
9 dimitri 1.4 C | o Load atmospheric state and runoff. |
10 heimbach 1.2 C |==========================================================|
11     C \==========================================================/
12     IMPLICIT NONE
13    
14     C === Global variables ===
15     #include "SIZE.h"
16     #include "EEPARAMS.h"
17     #include "PARAMS.h"
18     #include "FFIELDS.h"
19     #include "SEAICE_PARAMS.h"
20     #include "SEAICE_FFIELDS.h"
21    
22     C === Routine arguments ===
23     C myTime - Simulation time
24     C myIter - Simulation timestep number
25     C myThid - Thread no. that called this routine.
26     _RL myTime
27     INTEGER myIter
28     INTEGER myThid
29     CEndOfInterface
30    
31     INTEGER ILNBLNK
32     EXTERNAL ILNBLNK
33    
34     #ifdef ALLOW_SEAICE
35 dimitri 1.4 #ifndef SEAICE_EXTERNAL_FORCING
36 heimbach 1.2
37     C === Local arrays ===
38     COMMON /TDFIELDS_FLAGS/
39     & wind0_is_first, flux0_is_first,
40     & SSS0_is_first, SST0_is_first
41     LOGICAL wind0_is_first, flux0_is_first,
42     & SSS0_is_first, SST0_is_first
43    
44     C === Local variables ===
45     CHARACTER*(MAX_LEN_MBUF) msgBuf
46     INTEGER bi,bj,i,j,iRec,iEnd
47     _RL aWghtWind,bWghtWind,aWghtFlux,bWghtFlux,
48     & aWghtSSS,bWghtSSS,aWghtSST,bWghtSST
49     _RS initValue
50     _RL year, seconds, YearTime
51     INTEGER CurrentYear, CurrentYear2
52     logical done
53     CHARACTER*(MAX_LEN_MBUF) fName
54    
55     C-- Compute CurrentYear and YearTime
56     YearTime = myTime
57     done = .false.
58     do year = StartingYear, EndingYear
59     if( .not. done ) then
60     if( mod(year,4.) .eq. 0. ) then
61     seconds = 366.*24.*60.*60.
62     else
63     seconds = 365.*24.*60.*60.
64     endif
65     if( YearTime-seconds .ge. 0. ) then
66     YearTime = YearTime-seconds
67     else
68     CurrentYear = year
69     done = .true.
70     endif
71     endif
72     enddo
73     if( CurrentYear.ge.2000 ) then
74     CurrentYear2 = CurrentYear-2000
75     else
76     CurrentYear2 = CurrentYear-1900
77     endif
78    
79     C-- Check to see whether myTime is outside available forcing data
80     IF( CurrentYear.gt. EndingYear .or.
81     & YearTime .lt. WindForcingStart .or.
82     & YearTime .gt. WindForcingEnd .or.
83     & YearTime .lt. FluxForcingStart .or.
84     & YearTime .gt. FluxForcingEnd .or.
85     & YearTime .lt. SSTforcingStart .or.
86     & YearTime .gt. SSTforcingEnd .or.
87     & YearTime .lt. SSSforcingStart .or.
88     & YearTime .gt. SSSforcingEnd ) THEN
89     WRITE(msgBuf,'(A)') 'No Available Forcing Data'
90     CALL PRINT_ERROR( msgBuf , 1)
91     STOP 'ABNORMAL END: S/R SEAICE_GET_FORCING'
92     ENDIF
93    
94     C-- First call requires that we initialize everything for safety
95     IF ( myIter .EQ. nIter0 ) THEN
96 dimitri 1.3 initValue = ZERO
97 dimitri 1.4 CALL INIT_ARRAY_RS( uwind0 , initValue, myThid )
98     CALL INIT_ARRAY_RS( uwind1 , initValue, myThid )
99     CALL INIT_ARRAY_RS( vwind0 , initValue, myThid )
100     CALL INIT_ARRAY_RS( vwind1 , initValue, myThid )
101 dimitri 1.3 initValue = 283. _d 0
102 dimitri 1.4 CALL INIT_ARRAY_RS( atemp0 , initValue, myThid )
103     CALL INIT_ARRAY_RS( atemp1 , initValue, myThid )
104 dimitri 1.3 initValue = 0.005 _d 0
105 dimitri 1.4 CALL INIT_ARRAY_RS( aqh0 , initValue, myThid )
106     CALL INIT_ARRAY_RS( aqh1 , initValue, myThid )
107 dimitri 1.3 initValue = 300. _d 0
108 dimitri 1.4 CALL INIT_ARRAY_RS( lwflux0 , initValue, myThid )
109     CALL INIT_ARRAY_RS( lwflux1 , initValue, myThid )
110 dimitri 1.3 initValue = 200. _d 0
111 dimitri 1.4 CALL INIT_ARRAY_RS( swflux0 , initValue, myThid )
112     CALL INIT_ARRAY_RS( swflux1 , initValue, myThid )
113 dimitri 1.3 initValue = ZERO
114 dimitri 1.4 CALL INIT_ARRAY_RS( precip0 , initValue, myThid )
115     CALL INIT_ARRAY_RS( precip1 , initValue, myThid )
116     CALL INIT_ARRAY_RS( evap0 , initValue, myThid )
117     CALL INIT_ARRAY_RS( evap1 , initValue, myThid )
118     CALL INIT_ARRAY_RS( runoff0 , initValue, myThid )
119     CALL INIT_ARRAY_RS( runoff1 , initValue, myThid )
120 dimitri 1.3 initValue = 35. _d 0
121 dimitri 1.4 CALL INIT_ARRAY_RS( SSSsi0 , initValue, myThid )
122     CALL INIT_ARRAY_RS( SSSsi1 , initValue, myThid )
123 dimitri 1.3 initValue = 10. _d 0
124 dimitri 1.4 CALL INIT_ARRAY_RS( SSTsi0 , initValue, myThid )
125     CALL INIT_ARRAY_RS( SSTsi1 , initValue, myThid )
126 heimbach 1.2
127     wind0_is_first = .TRUE.
128     flux0_is_first = .TRUE.
129     SSS0_is_first = .TRUE.
130     SST0_is_first = .TRUE.
131    
132     _BEGIN_MASTER(myThid)
133     write(0,*)
134     & 'S/R SEAICE_GET_FORCING: initialize',myTime,myIter
135    
136     iRec = int((YearTime-WindForcingStart)/WindForcingPeriod) + 1
137 dimitri 1.4 IF ( uwindFile .NE. ' ' ) THEN
138     iEnd = ILNBLNK( uwindFile ) - 2
139     WRITE(fName,'(A,I2.2)') uwindFile(1:iEnd), CurrentYear2
140     CALL READ_REC_XY_RS( fName,uwind0,iRec ,myIter,myThid )
141     CALL READ_REC_XY_RS( fName,uwind1,iRec+1,myIter,myThid )
142     ENDIF
143     IF ( vwindFile .NE. ' ' ) THEN
144     iEnd = ILNBLNK( vwindFile ) - 2
145     WRITE(fName,'(A,I2.2)') vwindFile(1:iEnd), CurrentYear2
146     CALL READ_REC_XY_RS( fName,vwind0,iRec ,myIter,myThid )
147     CALL READ_REC_XY_RS( fName,vwind1,iRec+1,myIter,myThid )
148 heimbach 1.2 ENDIF
149    
150     iRec = int((YearTime-FluxForcingStart)/FluxForcingPeriod) + 1
151 dimitri 1.4 IF ( atempFile .NE. ' ' ) THEN
152     iEnd = ILNBLNK( atempFile ) - 4
153     WRITE(fName,'(A,I4.4)') atempFile(1:iEnd), CurrentYear
154     CALL READ_REC_XY_RS( fName,atemp0,iRec ,myIter,myThid )
155     CALL READ_REC_XY_RS( fName,atemp1,iRec+1,myIter,myThid )
156     ENDIF
157     IF ( aqhFile .NE. ' ' ) THEN
158     iEnd = ILNBLNK( aqhFile ) - 4
159     WRITE(fName,'(A,I4.4)') aqhFile(1:iEnd), CurrentYear
160     CALL READ_REC_XY_RS( fName,aqh0,iRec ,myIter,myThid )
161     CALL READ_REC_XY_RS( fName,aqh1,iRec+1,myIter,myThid )
162     ENDIF
163     IF ( lwfluxFile .NE. ' ' ) THEN
164     iEnd = ILNBLNK( lwfluxFile ) - 4
165     WRITE(fName,'(A,I4.4)') lwfluxFile(1:iEnd), CurrentYear
166     CALL READ_REC_XY_RS( fName,lwflux0,iRec ,myIter,myThid )
167     CALL READ_REC_XY_RS( fName,lwflux1,iRec+1,myIter,myThid )
168     ENDIF
169     IF ( swfluxFile .NE. ' ' ) THEN
170     iEnd = ILNBLNK( swfluxFile ) - 4
171     WRITE(fName,'(A,I4.4)') swfluxFile(1:iEnd), CurrentYear
172     CALL READ_REC_XY_RS( fName,swflux0,iRec ,myIter,myThid )
173     CALL READ_REC_XY_RS( fName,swflux1,iRec+1,myIter,myThid )
174     ENDIF
175     IF ( precipFile .NE. ' ' ) THEN
176     iEnd = ILNBLNK( precipFile ) - 4
177     WRITE(fName,'(A,I4.4)') precipFile(1:iEnd), CurrentYear
178     CALL READ_REC_XY_RS( fName,precip0,iRec ,myIter,myThid )
179     CALL READ_REC_XY_RS( fName,precip1,iRec+1,myIter,myThid )
180 heimbach 1.2 ENDIF
181     IF ( evapFile .NE. ' ' ) THEN
182     iEnd = ILNBLNK( evapFile ) - 4
183     WRITE(fName,'(A,I4.4)') evapFile(1:iEnd), CurrentYear
184     CALL READ_REC_XY_RS( fName,evap0,iRec ,myIter,myThid )
185     CALL READ_REC_XY_RS( fName,evap1,iRec+1,myIter,myThid )
186     ENDIF
187     IF ( runoffFile .NE. ' ' ) THEN
188     iEnd = ILNBLNK( runoffFile ) - 4
189     WRITE(fName,'(A,I4.4)') runoffFile(1:iEnd), CurrentYear
190     CALL READ_REC_XY_RS( fName,runoff0,iRec ,myIter,myThid )
191     CALL READ_REC_XY_RS( fName,runoff1,iRec+1,myIter,myThid )
192     ENDIF
193    
194     iRec = int((YearTime-SSTforcingStart)/SSTforcingPeriod) + 1
195     IF ( thetaClimFile .NE. ' ' ) THEN
196     iEnd = ILNBLNK( thetaClimFile ) - 2
197     WRITE(fName,'(A,I2.2)') thetaClimFile(1:iEnd), CurrentYear2
198     CALL READ_REC_XY_RS( fName,SSTsi0,iRec ,myIter,myThid )
199     CALL READ_REC_XY_RS( fName,SSTsi1,iRec+1,myIter,myThid )
200     ENDIF
201    
202     iRec = int((YearTime-SSSforcingStart)/SSSforcingPeriod) + 1
203     IF ( saltClimFile .NE. ' ' ) THEN
204     CALL READ_REC_XY_RS( saltClimFile,SSSsi0,iRec ,myIter,myThid )
205     CALL READ_REC_XY_RS( saltClimFile,SSSsi1,iRec+1,myIter,myThid )
206     ENDIF
207    
208     _END_MASTER(myThid)
209    
210 dimitri 1.4 _EXCH_XY_R4( uwind0, myThid )
211     _EXCH_XY_R4( uwind1, myThid )
212     _EXCH_XY_R4( vwind0, myThid )
213     _EXCH_XY_R4( vwind1, myThid )
214     _EXCH_XY_R4( atemp0, myThid )
215     _EXCH_XY_R4( atemp1, myThid )
216     _EXCH_XY_R4( aqh0, myThid )
217     _EXCH_XY_R4( aqh1, myThid )
218     _EXCH_XY_R4( lwflux0, myThid )
219     _EXCH_XY_R4( lwflux1, myThid )
220     _EXCH_XY_R4( swflux0, myThid )
221     _EXCH_XY_R4( swflux1, myThid )
222     _EXCH_XY_R4( precip0, myThid )
223     _EXCH_XY_R4( precip1, myThid )
224     _EXCH_XY_R4( evap0, myThid )
225     _EXCH_XY_R4( evap1, myThid )
226     _EXCH_XY_R4( runoff0, myThid )
227     _EXCH_XY_R4( runoff1, myThid )
228     _EXCH_XY_R4( SSTsi0, myThid )
229     _EXCH_XY_R4( SSTsi1, myThid )
230     _EXCH_XY_R4( SSSsi0, myThid )
231     _EXCH_XY_R4( SSSsi1, myThid )
232 heimbach 1.2
233     ENDIF
234    
235     C-- Now calculate whether if it is time to update wind speed arrays
236     iRec = int((YearTime-WindForcingStart)/WindForcingPeriod) + 2
237     aWghtWind = mod(YearTime-WindForcingStart,WindForcingPeriod) /
238     & WindForcingPeriod
239 dimitri 1.3 bWghtWind=ONE-aWghtWind
240 heimbach 1.2 IF ( aWghtWind .EQ. 0 ) THEN
241     _BEGIN_MASTER(myThid)
242     write(0,*)
243     & 'S/R SEAICE_GET_FORCING: reading winds',myTime,myIter
244 dimitri 1.4 IF ( uwindFile .NE. ' ' ) THEN
245     iEnd = ILNBLNK( uwindFile ) - 2
246     WRITE(fName,'(A,I2.2)') uwindFile(1:iEnd), CurrentYear2
247 heimbach 1.2 IF (wind0_is_first) THEN
248 dimitri 1.4 CALL READ_REC_XY_RS( fName,uwind0,iRec,myIter,myThid )
249 heimbach 1.2 ELSE
250 dimitri 1.4 CALL READ_REC_XY_RS( fName,uwind1,iRec,myIter,myThid )
251 heimbach 1.2 ENDIF
252     ENDIF
253 dimitri 1.4 IF ( vwindFile .NE. ' ' ) THEN
254     iEnd = ILNBLNK( vwindFile ) - 2
255     WRITE(fName,'(A,I2.2)') vwindFile(1:iEnd), CurrentYear2
256 heimbach 1.2 IF (wind0_is_first) THEN
257 dimitri 1.4 CALL READ_REC_XY_RS( fName,vwind0,iRec,myIter,myThid )
258 heimbach 1.2 ELSE
259 dimitri 1.4 CALL READ_REC_XY_RS( fName,vwind1,iRec,myIter,myThid )
260 heimbach 1.2 ENDIF
261     ENDIF
262     _END_MASTER(myThid)
263     IF (wind0_is_first) THEN
264 dimitri 1.4 _EXCH_XY_R4( uwind0, myThid )
265     _EXCH_XY_R4( vwind0, myThid )
266 heimbach 1.2 wind0_is_first=.FALSE.
267     ELSE
268 dimitri 1.4 _EXCH_XY_R4( uwind1, myThid )
269     _EXCH_XY_R4( vwind1, myThid )
270 heimbach 1.2 wind0_is_first=.TRUE.
271     ENDIF
272     ENDIF
273    
274     C-- Now calculate whether if it is time to update heat and freshwater flux
275     iRec = int((YearTime-FluxForcingStart)/FluxForcingPeriod) + 2
276     aWghtFlux = mod(YearTime-FluxForcingStart,FluxForcingPeriod) /
277     & FluxForcingPeriod
278 dimitri 1.3 bWghtFlux=ONE-aWghtFlux
279 heimbach 1.2 IF ( aWghtFlux .EQ. 0 ) THEN
280     _BEGIN_MASTER(myThid)
281     write(0,*)
282     & 'S/R SEAICE_GET_FORCING: reading fluxes',myTime,myIter
283 dimitri 1.4 IF ( atempFile .NE. ' ' ) THEN
284     iEnd = ILNBLNK( atempFile ) - 4
285     WRITE(fName,'(A,I4.4)') atempFile(1:iEnd), CurrentYear
286 heimbach 1.2 IF (flux0_is_first) THEN
287 dimitri 1.4 CALL READ_REC_XY_RS( fName,atemp0,iRec,myIter,myThid )
288 heimbach 1.2 ELSE
289 dimitri 1.4 CALL READ_REC_XY_RS( fName,atemp1,iRec,myIter,myThid )
290 heimbach 1.2 ENDIF
291     ENDIF
292 dimitri 1.4 IF ( aqhFile .NE. ' ' ) THEN
293     iEnd = ILNBLNK( aqhFile ) - 4
294     WRITE(fName,'(A,I4.4)') aqhFile(1:iEnd), CurrentYear
295 heimbach 1.2 IF (flux0_is_first) THEN
296 dimitri 1.4 CALL READ_REC_XY_RS( fName,aqh0,iRec,myIter,myThid )
297 heimbach 1.2 ELSE
298 dimitri 1.4 CALL READ_REC_XY_RS( fName,aqh1,iRec,myIter,myThid )
299 heimbach 1.2 ENDIF
300     ENDIF
301 dimitri 1.4 IF ( lwfluxFile .NE. ' ' ) THEN
302     iEnd = ILNBLNK( lwfluxFile ) - 4
303     WRITE(fName,'(A,I4.4)') lwfluxFile(1:iEnd), CurrentYear
304 heimbach 1.2 IF (flux0_is_first) THEN
305 dimitri 1.4 CALL READ_REC_XY_RS( fName,lwflux0,iRec,myIter,myThid )
306 heimbach 1.2 ELSE
307 dimitri 1.4 CALL READ_REC_XY_RS( fName,lwflux1,iRec,myIter,myThid )
308 heimbach 1.2 ENDIF
309     ENDIF
310 dimitri 1.4 IF ( swfluxFile .NE. ' ' ) THEN
311     iEnd = ILNBLNK( swfluxFile ) - 4
312     WRITE(fName,'(A,I4.4)') swfluxFile(1:iEnd), CurrentYear
313 heimbach 1.2 IF (flux0_is_first) THEN
314 dimitri 1.4 CALL READ_REC_XY_RS( fName,swflux0,iRec,myIter,myThid )
315 heimbach 1.2 ELSE
316 dimitri 1.4 CALL READ_REC_XY_RS( fName,swflux1,iRec,myIter,myThid )
317 heimbach 1.2 ENDIF
318     ENDIF
319 dimitri 1.4 IF ( precipFile .NE. ' ' ) THEN
320     iEnd = ILNBLNK( precipFile ) - 4
321     WRITE(fName,'(A,I4.4)') precipFile(1:iEnd), CurrentYear
322 heimbach 1.2 IF (flux0_is_first) THEN
323 dimitri 1.4 CALL READ_REC_XY_RS( fName,precip0,iRec,myIter,myThid )
324 heimbach 1.2 ELSE
325 dimitri 1.4 CALL READ_REC_XY_RS( fName,precip1,iRec,myIter,myThid )
326 heimbach 1.2 ENDIF
327     ENDIF
328     IF ( evapFile .NE. ' ' ) THEN
329     iEnd = ILNBLNK( evapFile ) - 4
330     WRITE(fName,'(A,I4.4)') evapFile(1:iEnd), CurrentYear
331     IF (flux0_is_first) THEN
332     CALL READ_REC_XY_RS( fName,evap0,iRec,myIter,myThid )
333     ELSE
334     CALL READ_REC_XY_RS( fName,evap1,iRec,myIter,myThid )
335     ENDIF
336     ENDIF
337     IF ( runoffFile .NE. ' ' ) THEN
338     iEnd = ILNBLNK( runoffFile ) - 4
339     WRITE(fName,'(A,I4.4)') runoffFile(1:iEnd), CurrentYear
340     IF (flux0_is_first) THEN
341     CALL READ_REC_XY_RS( fName,runoff0,iRec,myIter,myThid )
342     ELSE
343     CALL READ_REC_XY_RS( fName,runoff1,iRec,myIter,myThid )
344     ENDIF
345     ENDIF
346     _END_MASTER(myThid)
347     IF (flux0_is_first) THEN
348 dimitri 1.4 _EXCH_XY_R4(atemp0, myThid )
349     _EXCH_XY_R4(aqh0, myThid )
350     _EXCH_XY_R4(lwflux0, myThid )
351     _EXCH_XY_R4(swflux0, myThid )
352     _EXCH_XY_R4(precip0, myThid )
353     _EXCH_XY_R4(evap0, myThid )
354     _EXCH_XY_R4(runoff0, myThid )
355 heimbach 1.2 flux0_is_first=.FALSE.
356     ELSE
357 dimitri 1.4 _EXCH_XY_R4(atemp1, myThid )
358     _EXCH_XY_R4(aqh1, myThid )
359     _EXCH_XY_R4(lwflux1, myThid )
360     _EXCH_XY_R4(swflux1, myThid )
361     _EXCH_XY_R4(precip1, myThid )
362     _EXCH_XY_R4(evap1, myThid )
363     _EXCH_XY_R4(runoff1, myThid )
364 heimbach 1.2 flux0_is_first=.TRUE.
365     ENDIF
366     ENDIF
367    
368     C-- Now calculate whether if it is time to update SST array
369     iRec = int((YearTime-SSTforcingStart)/SSTforcingPeriod) + 2
370     aWghtSST = mod(YearTime-SSTforcingStart,SSTforcingPeriod) /
371     & SSTforcingPeriod
372 dimitri 1.3 bWghtSST=ONE-aWghtSST
373 heimbach 1.2 IF ( aWghtSST .EQ. 0 .AND. thetaClimFile .NE. ' ' ) THEN
374     _BEGIN_MASTER(myThid)
375 dimitri 1.3 write(0,*) 'S/R SEAICE_GET_FORCING: reading SST',myTime,myIter
376 heimbach 1.2 iEnd = ILNBLNK( thetaClimFile ) - 2
377     WRITE(fName,'(A,I2.2)') thetaClimFile(1:iEnd), CurrentYear2
378     IF (SST0_is_first) THEN
379     CALL READ_REC_XY_RS( fName,SSTsi0,iRec,myIter,myThid )
380     ELSE
381     CALL READ_REC_XY_RS( fName,SSTsi1,iRec,myIter,myThid )
382     ENDIF
383     _END_MASTER(myThid)
384     IF (SST0_is_first) THEN
385     _EXCH_XY_R4( SSTsi0, myThid )
386     SST0_is_first=.FALSE.
387     ELSE
388     _EXCH_XY_R4( SSTsi1, myThid )
389     SST0_is_first=.TRUE.
390     ENDIF
391     ENDIF
392    
393     C-- Now calculate whether if it is time to update SSS array
394     iRec = int((YearTime-SSSforcingStart)/SSSforcingPeriod) + 2
395     aWghtSSS = mod(YearTime-SSSforcingStart,SSSforcingPeriod) /
396     & SSSforcingPeriod
397 dimitri 1.3 bWghtSSS=ONE-aWghtSSS
398 heimbach 1.2 IF ( aWghtSSS .EQ. 0 .AND. saltClimFile .NE. ' ') THEN
399     _BEGIN_MASTER(myThid)
400 dimitri 1.3 write(0,*) 'S/R SEAICE_GET_FORCING: reading SSS',myTime,myIter
401 heimbach 1.2 IF (SSS0_is_first) THEN
402     CALL READ_REC_XY_RS( saltClimFile,SSSsi0,iRec,myIter,myThid )
403     ELSE
404     CALL READ_REC_XY_RS( saltClimFile,SSSsi1,iRec,myIter,myThid )
405     ENDIF
406     _END_MASTER(myThid)
407     IF (SSS0_is_first) THEN
408     _EXCH_XY_R4( SSSsi0, myThid )
409     SSS0_is_first=.FALSE.
410     ELSE
411     _EXCH_XY_R4( SSSsi1, myThid )
412     SSS0_is_first=.TRUE.
413     ENDIF
414     ENDIF
415    
416     C-- Time interpolation of wind forcing variables.
417     IF (wind0_is_first) THEN
418     DO bj = myByLo(myThid), myByHi(myThid)
419     DO bi = myBxLo(myThid), myBxHi(myThid)
420     DO j=1-Oly,sNy+Oly
421     DO i=1-Olx,sNx+Olx
422 dimitri 1.4 uwind(i,j,bi,bj) = bWghtWind * uwind0(i,j,bi,bj) +
423     & aWghtWind * uwind1(i,j,bi,bj)
424     vwind(i,j,bi,bj) = bWghtWind * vwind0(i,j,bi,bj) +
425     & aWghtWind * vwind1(i,j,bi,bj)
426 heimbach 1.2 ENDDO
427     ENDDO
428     ENDDO
429     ENDDO
430     ELSE
431     DO bj = myByLo(myThid), myByHi(myThid)
432     DO bi = myBxLo(myThid), myBxHi(myThid)
433     DO j=1-Oly,sNy+Oly
434     DO i=1-Olx,sNx+Olx
435 dimitri 1.4 uwind(i,j,bi,bj) = aWghtWind * uwind0(i,j,bi,bj) +
436     & bWghtWind * uwind1(i,j,bi,bj)
437     vwind(i,j,bi,bj) = aWghtWind * vwind0(i,j,bi,bj) +
438     & bWghtWind * vwind1(i,j,bi,bj)
439 heimbach 1.2 ENDDO
440     ENDDO
441     ENDDO
442     ENDDO
443     ENDIF
444    
445     C-- Time interpolation of flux forcing variables.
446     IF (flux0_is_first) THEN
447     DO bj = myByLo(myThid), myByHi(myThid)
448     DO bi = myBxLo(myThid), myBxHi(myThid)
449     DO j=1-Oly,sNy+Oly
450     DO i=1-Olx,sNx+Olx
451 dimitri 1.4 atemp(i,j,bi,bj) = bWghtFlux * atemp0(i,j,bi,bj) +
452     & aWghtFlux * atemp1(i,j,bi,bj)
453     aqh(i,j,bi,bj) = bWghtFlux * aqh0(i,j,bi,bj) +
454     & aWghtFlux * aqh1(i,j,bi,bj)
455     lwflux(i,j,bi,bj) = bWghtFlux * lwflux0(i,j,bi,bj) +
456     & aWghtFlux * lwflux1(i,j,bi,bj)
457     swflux(i,j,bi,bj) = bWghtFlux * swflux0(i,j,bi,bj) +
458     & aWghtFlux * swflux1(i,j,bi,bj)
459     precip(i,j,bi,bj) = bWghtFlux * precip0(i,j,bi,bj) +
460     & aWghtFlux * precip1(i,j,bi,bj)
461     evap(i,j,bi,bj) = bWghtFlux * evap0(i,j,bi,bj) +
462     & aWghtFlux * evap1(i,j,bi,bj)
463     runoff(i,j,bi,bj) = bWghtFlux * runoff0(i,j,bi,bj) +
464     & aWghtFlux * runoff1(i,j,bi,bj)
465 heimbach 1.2 ENDDO
466     ENDDO
467     ENDDO
468     ENDDO
469     ELSE
470     DO bj = myByLo(myThid), myByHi(myThid)
471     DO bi = myBxLo(myThid), myBxHi(myThid)
472     DO j=1-Oly,sNy+Oly
473     DO i=1-Olx,sNx+Olx
474 dimitri 1.4 atemp(i,j,bi,bj) = aWghtFlux * atemp0(i,j,bi,bj) +
475     & bWghtFlux * atemp1(i,j,bi,bj)
476     aqh(i,j,bi,bj) = aWghtFlux * aqh0(i,j,bi,bj) +
477     & bWghtFlux * aqh1(i,j,bi,bj)
478     lwflux(i,j,bi,bj) = aWghtFlux * lwflux0(i,j,bi,bj) +
479     & bWghtFlux * lwflux1(i,j,bi,bj)
480     swflux(i,j,bi,bj) = aWghtFlux * swflux0(i,j,bi,bj) +
481     & bWghtFlux * swflux1(i,j,bi,bj)
482     precip(i,j,bi,bj) = aWghtFlux * precip0(i,j,bi,bj) +
483     & bWghtFlux * precip1(i,j,bi,bj)
484     evap(i,j,bi,bj) = aWghtFlux * evap0(i,j,bi,bj) +
485     & bWghtFlux * evap1(i,j,bi,bj)
486     runoff(i,j,bi,bj) = aWghtFlux * runoff0(i,j,bi,bj) +
487     & bWghtFlux * runoff1(i,j,bi,bj)
488 heimbach 1.2 ENDDO
489     ENDDO
490     ENDDO
491     ENDDO
492     ENDIF
493    
494     C-- Time interpolation of SSS forcing variables.
495     IF (SSS0_is_first) THEN
496     DO bj = myByLo(myThid), myByHi(myThid)
497     DO bi = myBxLo(myThid), myBxHi(myThid)
498     DO j=1-Oly,sNy+Oly
499     DO i=1-Olx,sNx+Olx
500     SSS(i,j,bi,bj) = bWghtSSS * SSSsi0(i,j,bi,bj) +
501     & aWghtSSS * SSSsi1(i,j,bi,bj)
502     ENDDO
503     ENDDO
504     ENDDO
505     ENDDO
506     ELSE
507     DO bj = myByLo(myThid), myByHi(myThid)
508     DO bi = myBxLo(myThid), myBxHi(myThid)
509     DO j=1-Oly,sNy+Oly
510     DO i=1-Olx,sNx+Olx
511     SSS(i,j,bi,bj) = aWghtSSS * SSSsi0(i,j,bi,bj) +
512     & bWghtSSS * SSSsi1(i,j,bi,bj)
513     ENDDO
514     ENDDO
515     ENDDO
516     ENDDO
517     ENDIF
518    
519     C-- Time interpolation of SST forcing variables.
520     IF (SST0_is_first) THEN
521     DO bj = myByLo(myThid), myByHi(myThid)
522     DO bi = myBxLo(myThid), myBxHi(myThid)
523     DO j=1-Oly,sNy+Oly
524     DO i=1-Olx,sNx+Olx
525     SST(i,j,bi,bj) = bWghtSST * SSTsi0(i,j,bi,bj) +
526     & aWghtSST * SSTsi1(i,j,bi,bj)
527     ENDDO
528     ENDDO
529     ENDDO
530     ENDDO
531     ELSE
532     DO bj = myByLo(myThid), myByHi(myThid)
533     DO bi = myBxLo(myThid), myBxHi(myThid)
534     DO j=1-Oly,sNy+Oly
535     DO i=1-Olx,sNx+Olx
536     SST(i,j,bi,bj) = aWghtSST * SSTsi0(i,j,bi,bj) +
537     & bWghtSST * SSTsi1(i,j,bi,bj)
538     ENDDO
539     ENDDO
540     ENDDO
541     ENDDO
542     ENDIF
543    
544 dimitri 1.4 #endif SEAICE_EXTERNAL_FORCING
545 heimbach 1.2 #endif ALLOW_SEAICE
546    
547     RETURN
548     END
549    
550    
551     C=======================================================================
552    
553     SUBROUTINE INIT_ARRAY_RS( arr, initValue, myThid )
554     C This routine sets the RS array arr to initValue
555     IMPLICIT NONE
556     C === Global variables ===
557     #include "SIZE.h"
558     #include "EEPARAMS.h"
559     C === Arguments ===
560     _RS arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
561     _RS initValue
562     INTEGER myThid
563    
564     #ifdef ALLOW_SEAICE
565 dimitri 1.4 #ifndef SEAICE_EXTERNAL_FORCING
566 heimbach 1.2
567     C === Local variables ===
568     INTEGER i,j,bi,bj
569     C
570     DO bj = myByLo(myThid), myByHi(myThid)
571     DO bi = myBxLo(myThid), myBxHi(myThid)
572     DO j = 1-Oly,sNy+Oly
573     DO i = 1-Olx,sNx+Olx
574     arr(i,j,bi,bj) = initValue
575     ENDDO
576     ENDDO
577     ENDDO
578     ENDDO
579    
580 dimitri 1.4 #endif SEAICE_EXTERNAL_FORCING
581 heimbach 1.2 #endif ALLOW_SEAICE
582    
583     RETURN
584     END

  ViewVC Help
Powered by ViewVC 1.1.22