/[MITgcm]/MITgcm/pkg/cheapaml/cheapaml_fields_load.F
ViewVC logotype

Contents of /MITgcm/pkg/cheapaml/cheapaml_fields_load.F

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


Revision 1.13 - (show annotations) (download)
Fri Jun 24 01:28:22 2011 UTC (12 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63d, checkpoint63e, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63
Changes since 1.12: +3 -3 lines
avoid character string left open over several lines (with continuation line)

1 C $Header: /u/gcmpack/MITgcm/pkg/cheapaml/cheapaml_fields_load.F,v 1.12 2011/06/07 21:01:01 jmc Exp $
2 C $Name: $
3
4 #include "CHEAPAML_OPTIONS.h"
5
6
7 C !ROUTINE: CHEAPAML_FIELDS_LOAD
8 C !INTERFACE:
9 SUBROUTINE CHEAPAML_FIELDS_LOAD( myTime, myIter, myThid )
10 C *==========================================================*
11 C | SUBROUTINE CHEAPAML_FIELDS_LOAD
12 C | o Control reading of fields from external source.
13 C *==========================================================*
14
15 C !USES:
16 IMPLICIT NONE
17 C === Global variables ===
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "FFIELDS.h"
22 c #include "GRID.h"
23 c #include "DYNVARS.h"
24 C #include "BULKF.h"
25 c#ifdef ALLOW_THSICE
26 c#include "THSICE_VARS.h"
27 c#endif
28 #include "CHEAPAML.h"
29
30 C !INPUT/OUTPUT PARAMETERS:
31 C === Routine arguments ===
32 C myThid - Thread no. that called this routine.
33 C myTime - Simulation time
34 C myIter - Simulation timestep number
35 C dsolms - Solar variation at Southern boundary
36 C dsolmn - Solar variation at Northern boundary
37 c xphaseinit - user input initial phase of year relative
38 c to mid winter. E.G. xphaseinit = pi implies time zero
39 c is mid summer.
40 INTEGER myThid
41 _RL myTime
42 _RL local
43 c _RL dsolms,dsolmn
44 c _RL xphaseinit
45 INTEGER myIter
46
47 C !LOCAL VARIABLES:
48 C === Local arrays ===
49 C trair[01] :: Relaxation temp. profile for air temperature
50 C qrair[01] :: Relaxation specific humidity profile for air
51 C solar[01] :: short wave flux
52 C uwind[01] :: zonal wind
53 C vwind[01] :: meridional wind
54 C CheaptracerR[01] :: Relaxation profile for passive tracer
55 C aWght, bWght :: Interpolation weights
56
57 COMMON /CHEAPAML_FIELDS_LOAD_I/ cheapaml_ldRec
58 COMMON /CHEAPAML_FIELDS_LOAD_RL/
59 & trair0, trair1,
60 & qrair0, qrair1,
61 & Solar0, Solar1,
62 & uwind0, uwind1,
63 & vwind0, vwind1,
64 & ustress0, ustress1,
65 & vstress0, vstress1,
66 & wavesh0, wavesh1,
67 & wavesp0, wavesp1,
68 & rair0, rair1,
69 & CheaptracerR0, CheaptracerR1
70
71 INTEGER cheapaml_ldRec(nSx,nSy)
72 _RL trair0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
73 _RL trair1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
74 _RL qrair0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
75 _RL qrair1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
76 _RL Solar0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
77 _RL Solar1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
78 _RL uwind0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
79 _RL uwind1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
80 _RL vwind0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
81 _RL vwind1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
82 _RL ustress0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
83 _RL ustress1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
84 _RL vstress0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
85 _RL vstress1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
86 _RL wavesh0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
87 _RL wavesh1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
88 _RL wavesp0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
89 _RL wavesp1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
90 _RL rair0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
91 _RL rair1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
92 _RL CheaptracerR0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
93 _RL CheaptracerR1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
94
95 INTEGER intimeP, intime0, intime1
96 INTEGER bi,bj,i,j
97 INTEGER iG,jG
98 _RL aWght,bWght,u
99 _RL ssq0,ssq1,ssq2,ssqa
100 c xsolph - phase of year, assuming time zero is mid winter
101 c xinxx - cos ( xsolph )
102 _RL xsolph,xinxx
103 c coefficients used to compute saturation specific humidity
104 DATA ssq0, ssq1, ssq2
105 & / 3.797915 _d 0 , 7.93252 _d -6 , 2.166847 _d -3 /
106
107 IF ( periodicExternalForcing_cheap ) THEN
108
109
110 c the objective here is to give cheapaml a default periodic forcing
111 c consisting only of annually varying solar forcing, and thus Trelaxation
112 c variation. everything else, relative humidity, wind, are fixed. This
113 c keys off of solardata. if a solar data file exists, the model will
114 c assume there are files to be read and interpolated between, as is standard
115 c for the MITGCM.
116
117 IF ( SolarFile .EQ. ' ' ) THEN
118 IF (useStressOption)then
119 write(*,*) ' stress option is turned on. this is not',
120 & 'consistent with the default time dependent forcing option'
121 stop
122 ENDIF
123 if ( myIter .EQ. nIter0 )then
124 WRITE(*,*)
125 & 'S/R Assuming Standard Annually Varying Solar Forcing'
126 endif
127 xsolph=myTime*2.d0*3.14159 _d 0/365. _d 0/86400. _d 0
128 xinxx=cos(xsolph+xphaseinit+3.14159 _d 0)
129 DO bj = myByLo(myThid), myByHi(myThid)
130 DO bi = myBxLo(myThid), myBxHi(myThid)
131 DO j=1,sNy
132 DO i=1,sNx
133 jG = myYGlobalLo-1+(bj-1)*sNy+j
134 local=225.d0+dsolms*xinxx-float((jg-1))/float((ny-1))*
135 & (37.5d0-dsolmn*xinxx)
136 Solar(i,j,bi,bj) = local
137 ENDDO
138 ENDDO
139 ENDDO
140 ENDDO
141 _EXCH_XY_RL(solar, mythid)
142 c relaxation temperature in radiative equilibrium
143 DO bj = myByLo(myThid), myByHi(myThid)
144 DO bi = myBxLo(myThid), myBxHi(myThid)
145 DO j=1,sNy
146 DO i=1,sNx
147 jG = myYGlobalLo-1+(bj-1)*sNy+j
148 local=solar(i,j,bi,bj)
149 local=(2.d0*local/stefan)**(0.25d0)-Celsius2K
150 TR(i,j,bi,bj) = local
151 ENDDO
152 ENDDO
153 ENDDO
154 ENDDO
155 _EXCH_XY_RL(TR, mythid)
156 c default specific humidity profile to 80% relative humidity
157 DO bj = myByLo(myThid), myByHi(myThid)
158 DO bi = myBxLo(myThid), myBxHi(myThid)
159 DO j=1,sNy
160 DO i=1,sNx
161 c jG = myYGlobalLo-1+(bj-1)*sNy+j
162 local = Tr(i,j,bi,bj)+Celsius2K
163 ssqa = ssq0*exp( lath*(ssq1-ssq2/local)) / p0
164 qr(i,j,bi,bj) = 0.8d0*ssqa
165 ENDDO
166 ENDDO
167 ENDDO
168 ENDDO
169 _EXCH_XY_RL(qr, mythid)
170 c u wind field
171 DO bj = myByLo(myThid), myByHi(myThid)
172 DO bi = myBxLo(myThid), myBxHi(myThid)
173 DO j=1,sNy
174 DO i=1,sNx
175 jG = myYGlobalLo-1+(bj-1)*sNy+j
176 local=-5.d0*cos(2.d0*pi*float(jg-1)/(float(ny-1)))
177 uwind(i,j,bi,bj) = local
178 ENDDO
179 ENDDO
180 ENDDO
181 ENDDO
182 _EXCH_XY_RL(uwind, mythid)
183 c v wind field
184 DO bj = myByLo(myThid), myByHi(myThid)
185 DO bi = myBxLo(myThid), myBxHi(myThid)
186 DO j=1,sNy
187 DO i=1,sNx
188 jG = myYGlobalLo-1+(bj-1)*sNy+j
189 vwind(i,j,bi,bj) = 0.d0
190 ENDDO
191 ENDDO
192 ENDDO
193 ENDDO
194 _EXCH_XY_RL(vwind, mythid)
195 C Tracer field
196 IF (useCheapTracer) THEN
197 DO bj = myByLo(myThid), myByHi(myThid)
198 DO bi = myBxLo(myThid), myBxHi(myThid)
199 DO j=1,sNy
200 DO i=1,sNx
201 jG = myYGlobalLo-1+(bj-1)*sNy+j
202 CheaptracerR(i,j,bi,bj) = 290. _d 0
203 ENDDO
204 ENDDO
205 ENDDO
206 ENDDO
207 ENDIF
208 _EXCH_XY_RL(CheaptracerR, mythid)
209
210 ELSE
211
212 c here for usual interpolative forcings
213 C First call requires that we initialize everything to zero for safety
214 IF ( myIter .EQ. nIter0 ) THEN
215 DO bj = myByLo(myThid), myByHi(myThid)
216 DO bi = myBxLo(myThid), myBxHi(myThid)
217 cheapaml_ldRec(bi,bj) = 0
218 DO j=1-OLy,sNy+OLy
219 DO i=1-OLx,sNx+OLx
220 trair0 (i,j,bi,bj) = 0.
221 trair1 (i,j,bi,bj) = 0.
222 qrair0 (i,j,bi,bj) = 0.
223 qrair1 (i,j,bi,bj) = 0.
224 solar0 (i,j,bi,bj) = 0.
225 solar1 (i,j,bi,bj) = 0.
226 uwind0 (i,j,bi,bj) = 0.
227 uwind1 (i,j,bi,bj) = 0.
228 vwind0 (i,j,bi,bj) = 0.
229 vwind1 (i,j,bi,bj) = 0.
230 ustress0(i,j,bi,bj) = 0.
231 ustress1(i,j,bi,bj) = 0.
232 vstress0(i,j,bi,bj) = 0.
233 vstress1(i,j,bi,bj) = 0.
234 wavesh0 (i,j,bi,bj) = 0.
235 wavesh1 (i,j,bi,bj) = 0.
236 wavesp0 (i,j,bi,bj) = 0.
237 wavesp1 (i,j,bi,bj) = 0.
238 rair0 (i,j,bi,bj) = 0.
239 rair1 (i,j,bi,bj) = 0.
240 CheaptracerR0 (i,j,bi,bj) = 0.
241 CheaptracerR1 (i,j,bi,bj) = 0.
242 ENDDO
243 ENDDO
244 ENDDO
245 ENDDO
246 ENDIF
247
248 C-- Now calculate whether it is time to update the forcing arrays
249 CALL GET_PERIODIC_INTERVAL(
250 O intimeP, intime0, intime1, bWght, aWght,
251 I externForcingCycle_cheap, externForcingPeriod_cheap,
252 I deltaTclock, myTime, myThid )
253
254 bi = myBxLo(myThid)
255 bj = myByLo(myThid)
256 #ifdef ALLOW_DEBUG
257 IF ( debugLevel.GE.debLevB ) THEN
258 _BEGIN_MASTER(myThid)
259 WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
260 & ' CHEAPAML_FIELDS_LOAD,', myIter,
261 & ' : iP,iLd,i0,i1=', intimeP,cheapaml_ldRec(bi,bj),
262 & intime0,intime1, ' ; Wght=', bWght, aWght
263 _END_MASTER(myThid)
264 ENDIF
265 #endif /* ALLOW_DEBUG */
266
267 C- Make no assumption on sequence of calls to CHEAPAML_FIELDS_LOAD ;
268 C This is the correct formulation (works in Adjoint run).
269 IF ( intime1.NE.cheapaml_ldRec(bi,bj) ) THEN
270
271 C-- If the above condition is met then we need to read in
272 C data for the period ahead and the period behind myTime.
273 IF ( debugLevel.GE.debLevZero ) THEN
274 _BEGIN_MASTER(myThid)
275 WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
276 & ' CHEAPAML_FIELDS_LOAD, it=', myIter,
277 & ' : Reading new data, i0,i1=', intime0, intime1,
278 & ' (prev=', intimeP, cheapaml_ldRec(bi,bj), ' )'
279 _END_MASTER(myThid)
280 ENDIF
281
282 IF ( SolarFile .NE. ' ' ) THEN
283 CALL READ_REC_XY_RL( SolarFile,solar0,intime0,
284 & myIter,myThid )
285 CALL READ_REC_XY_RL( SolarFile,solar1,intime1,
286 & myIter,myThid )
287 ENDIF
288 IF ( TrFile .NE. ' ' ) THEN
289 CALL READ_REC_XY_RL( TRFile,trair0,intime0,
290 & myIter,myThid )
291 CALL READ_REC_XY_RL( TRFile,trair1,intime1,
292 & myIter,myThid )
293 ENDIF
294 IF ( QrFile .NE. ' ' ) THEN
295 CALL READ_REC_XY_RL( QrFile,qrair0,intime0,
296 & myIter,myThid )
297 CALL READ_REC_XY_RL( QrFile,qrair1,intime1,
298 & myIter,myThid )
299 ENDIF
300 IF ( UWindFile .NE. ' ' ) THEN
301 CALL READ_REC_XY_RL( UWindFile,uwind0,intime0,
302 & myIter,myThid )
303 CALL READ_REC_XY_RL( UWindFile,uwind1,intime1,
304 & myIter,myThid )
305 ENDIF
306 IF ( VWindFile .NE. ' ' ) THEN
307 CALL READ_REC_XY_RL( VWindFile,vwind0,intime0,
308 & myIter,myThid )
309 CALL READ_REC_XY_RL( VWindFile,vwind1,intime1,
310 & myIter,myThid )
311 ENDIF
312 IF(useStressOption)THEN
313 IF ( UStressFile .NE. ' ' ) THEN
314 CALL READ_REC_XY_RL( UStressFile,ustress0,intime0,
315 & myIter,myThid )
316 CALL READ_REC_XY_RL( UStressFile,ustress1,intime1,
317 & myIter,myThid )
318 ENDIF
319 IF ( VStressFile .NE. ' ' ) THEN
320 CALL READ_REC_XY_RL( VStressFile,vstress0,intime0,
321 & myIter,myThid )
322 CALL READ_REC_XY_RL( VStressFile,vstress1,intime1,
323 & myIter,myThid )
324 ENDIF
325 ENDIF
326 IF ( FluxFormula.eq.'COARE3') THEN
327 IF ( WaveHFile .NE. ' ' ) THEN
328 CALL READ_REC_XY_RL( WaveHFile,wavesh0,intime0,
329 & myIter,myThid )
330 CALL READ_REC_XY_RL( WaveHFile,wavesh1,intime1,
331 & myIter,myThid )
332 ENDIF
333 IF ( WavePFile .NE. ' ' ) THEN
334 CALL READ_REC_XY_RL( WavePFile,wavesp0,intime0,
335 & myIter,myThid )
336 CALL READ_REC_XY_RL( WavePFile,wavesp1,intime1,
337 & myIter,myThid )
338 ENDIF
339 ENDIF
340 IF (useCheapTracer) THEN
341 IF ( TracerRFile .NE. ' ' ) THEN
342 CALL READ_REC_XY_RL( TracerRFile,CheaptracerR0,intime0,
343 & myIter,myThid )
344 CALL READ_REC_XY_RL( TracerRFile,CheaptracerR1,intime1,
345 & myIter,myThid )
346 ENDIF
347 ENDIF
348 _EXCH_XY_RL(trair0 , myThid )
349 _EXCH_XY_RL(qrair0 , myThid )
350 _EXCH_XY_RL(solar0 , myThid )
351 _EXCH_XY_RL(uwind0 , myThid )
352 _EXCH_XY_RL(vwind0 , myThid )
353 _EXCH_XY_RL(trair1 , myThid )
354 _EXCH_XY_RL(qrair1 , myThid )
355 _EXCH_XY_RL(solar1 , myThid )
356 _EXCH_XY_RL(uwind1 , myThid )
357 _EXCH_XY_RL(vwind1 , myThid )
358 IF(useStressOption)THEN
359 _EXCH_XY_RL(uwind0 , myThid )
360 _EXCH_XY_RL(vwind0 , myThid )
361 _EXCH_XY_RL(uwind1 , myThid )
362 _EXCH_XY_RL(vwind1 , myThid )
363 ENDIF
364 IF(FluxFormula.EQ.'COARE3') THEN
365 _EXCH_XY_RL(wavesp0 , myThid )
366 _EXCH_XY_RL(wavesp1 , myThid )
367 _EXCH_XY_RL(wavesh0 , myThid )
368 _EXCH_XY_RL(wavesh1 , myThid )
369 ENDIF
370 IF(useCheapTracer) THEN
371 _EXCH_XY_RL(CheaptracerR0 , myThid )
372 _EXCH_XY_RL(CheaptracerR1, myThid )
373 ENDIF
374
375 C- save newly loaded time-record
376 DO bj = myByLo(myThid), myByHi(myThid)
377 DO bi = myBxLo(myThid), myBxHi(myThid)
378 cheapaml_ldRec(bi,bj) = intime1
379 ENDDO
380 ENDDO
381
382 C end of loading new fields block
383 ENDIF
384
385 C-- Interpolate TR, QR, SOLAR
386 DO bj = myByLo(myThid), myByHi(myThid)
387 DO bi = myBxLo(myThid), myBxHi(myThid)
388 DO j=1-OLy,sNy+OLy
389 DO i=1-OLx,sNx+OLx
390 TR(i,j,bi,bj) = bWght*trair0(i,j,bi,bj)
391 & +aWght*trair1(i,j,bi,bj) !+273.15
392 qr(i,j,bi,bj) = bWght*qrair0(i,j,bi,bj)
393 & +aWght*qrair1(i,j,bi,bj)
394 uwind(i,j,bi,bj) = bWght*uwind0(i,j,bi,bj)
395 & +aWght*uwind1(i,j,bi,bj)
396 vwind(i,j,bi,bj) = bWght*vwind0(i,j,bi,bj)
397 & +aWght*vwind1(i,j,bi,bj)
398 solar(i,j,bi,bj) = bWght*solar0(i,j,bi,bj)
399 & +aWght*solar1(i,j,bi,bj)
400 IF(useStressOption)THEN
401 ustress(i,j,bi,bj) = bWght*ustress0(i,j,bi,bj)
402 & +aWght*ustress1(i,j,bi,bj)
403 vstress(i,j,bi,bj) = bWght*vstress0(i,j,bi,bj)
404 & +aWght*vstress1(i,j,bi,bj)
405 ENDIF
406 IF(useCheapTracer)THEN
407 CheaptracerR(i,j,bi,bj) = bWght*CheaptracerR0(i,j,bi,bj)
408 & +aWght*CheaptracerR1(i,j,bi,bj)
409 ENDIF
410 IF(FluxFormula.eq.'COARE3')THEN
411 IF(WaveHFile.ne.' ')THEN
412 wavesh(i,j,bi,bj) = bWght*wavesh0(i,j,bi,bj)
413 & +aWght*wavesh1(i,j,bi,bj)
414 ENDIF
415 IF(WavePFile.ne.' ')THEN
416 wavesp(i,j,bi,bj) = bWght*wavesp0(i,j,bi,bj)
417 & +aWght*wavesp1(i,j,bi,bj)
418 ENDIF
419 ELSE
420 u=uwind(i,j,bi,bj)**2+vwind(i,j,bi,bj)**2
421 u=dsqrt(u)
422 wavesp(i,j,bi,bj)=0.729 _d 0 * u
423 wavesh(i,j,bi,bj)=0.018 _d 0 * u*u*(1. _d 0 + .015 _d 0 *u)
424 ENDIF
425 ENDDO
426 ENDDO
427 ENDDO
428 ENDDO
429
430 c end if solarFile is empty
431 ENDIF
432
433 c end of periodic forcing options, on to steady option
434
435 ELSE
436
437 IF ( myIter .EQ. nIter0 ) THEN
438 IF ( SolarFile .NE. ' ' ) THEN
439 CALL READ_FLD_XY_RS( SolarFile,' ',solar,0,myThid )
440 ELSE
441 DO bj = myByLo(myThid), myByHi(myThid)
442 DO bi = myBxLo(myThid), myBxHi(myThid)
443 DO j=1,sNy
444 DO i=1,sNx
445 jG = myYGlobalLo-1+(bj-1)*sNy+j
446 local=225.d0-float((jg-1))/float((ny-1))*37.5d0
447 Solar(i,j,bi,bj) = local
448 ENDDO
449 ENDDO
450 ENDDO
451 ENDDO
452 ENDIF
453 _EXCH_XY_RS(solar, mythid)
454 IF ( TrFile .NE. ' ' ) THEN
455 CALL READ_FLD_XY_RL( TrFile,' ',tr,0,myThid )
456 ELSE
457 DO bj = myByLo(myThid), myByHi(myThid)
458 DO bi = myBxLo(myThid), myBxHi(myThid)
459 DO j=1,sNy
460 DO i=1,sNx
461 jG = myYGlobalLo-1+(bj-1)*sNy+j
462 local=solar(i,j,bi,bj)
463 local=(2.d0*local/stefan)**(0.25d0)-273.16
464 TR(i,j,bi,bj) = local
465 ENDDO
466 ENDDO
467 ENDDO
468 ENDDO
469 ENDIF
470
471 _EXCH_XY_RL(TR, mythid)
472 c do specific humidity
473 IF ( QrFile .NE. ' ') THEN
474 CALL READ_FLD_XY_RL( QrFile,' ',qr,0,myThid )
475 ELSE
476 c default specific humidity profile to 80% relative humidity
477 DO bj = myByLo(myThid), myByHi(myThid)
478 DO bi = myBxLo(myThid), myBxHi(myThid)
479 DO j=1,sNy
480 DO i=1,sNx
481 c jG = myYGlobalLo-1+(bj-1)*sNy+j
482 local = Tr(i,j,bi,bj)+273.16d0
483 ssqa = ssq0*exp( lath*(ssq1-ssq2/local)) / p0
484 qr(i,j,bi,bj) = 0.8d0*ssqa
485 ENDDO
486 ENDDO
487 ENDDO
488 ENDDO
489 ENDIF
490 _EXCH_XY_RL(qr, mythid)
491 IF ( UWindFile .NE. ' ' ) THEN
492 CALL READ_FLD_XY_RL( UWindFile,' ',uwind,0,myThid )
493 ELSE
494 DO bj = myByLo(myThid), myByHi(myThid)
495 DO bi = myBxLo(myThid), myBxHi(myThid)
496 DO j=1,sNy
497 DO i=1,sNx
498 jG = myYGlobalLo-1+(bj-1)*sNy+j
499 c mod for debug
500 c to return to original code, uncomment following line
501 c comment out 2nd line
502 local=-5.d0*cos(2.d0*pi*float(jg-1)/(float(ny-1)))
503 c local=0.d0*cos(2.d0*pi*float(jg-1)/(float(ny-1)))
504 uwind(i,j,bi,bj) = local
505 ENDDO
506 ENDDO
507 ENDDO
508 ENDDO
509 ENDIF
510 _EXCH_XY_RL(uwind, mythid)
511 IF ( VWindFile .NE. ' ' ) THEN
512 CALL READ_FLD_XY_RL( VWindFile,' ',vwind,0,myThid )
513 ELSE
514 DO bj = myByLo(myThid), myByHi(myThid)
515 DO bi = myBxLo(myThid), myBxHi(myThid)
516 DO j=1,sNy
517 DO i=1,sNx
518 jG = myYGlobalLo-1+(bj-1)*sNy+j
519 vwind(i,j,bi,bj) = 0.d0
520 ENDDO
521 ENDDO
522 ENDDO
523 ENDDO
524 ENDIF
525 _EXCH_XY_RL(vwind, mythid)
526 IF(useStressOption)THEN
527 IF ( UStressFile .NE. ' ' ) THEN
528 CALL READ_FLD_XY_RL( UStressFile,' ',ustress,0,myThid )
529 ELSE
530 write(*,*)' U Stress File absent with stress option'
531 stop
532 ENDIF
533 IF ( VStressFile .NE. ' ' ) THEN
534 CALL READ_FLD_XY_RL( VStressFile,' ',vstress,0,myThid )
535 ELSE
536 write(*,*)' V Stress File absent with stress option'
537 stop
538 ENDIF
539 _EXCH_XY_RL(ustress, mythid)
540 _EXCH_XY_RL(vstress, mythid)
541 ENDIF
542 IF(useCheapTracer)THEN
543 IF ( TracerRFile .NE. ' ' ) THEN
544 CALL READ_FLD_XY_RL( TracerRFile,' ',CheaptracerR,0,myThid )
545 ELSE
546 DO bj = myByLo(myThid), myByHi(myThid)
547 DO bi = myBxLo(myThid), myBxHi(myThid)
548 DO j=1,sNy
549 DO i=1,sNx
550 CheaptracerR(i,j,bi,bj)=290. _d 0
551 ENDDO
552 ENDDO
553 ENDDO
554 ENDDO
555 ENDIF
556 _EXCH_XY_RL(CheaptracerR, mythid)
557 ENDIF
558 IF (FluxFormula.eq.'COARE3')THEN
559 IF (WaveHFile.NE.' ')THEN
560 CALL READ_FLD_XY_RL( WaveHFile,' ',wavesh,0,myThid )
561 ENDIF
562 IF (WavePFile.NE.' ')THEN
563 CALL READ_FLD_XY_RL( WavePFile,' ',wavesp,0,myThid )
564 ELSE
565 DO bj = myByLo(myThid), myByHi(myThid)
566 DO bi = myBxLo(myThid), myBxHi(myThid)
567 DO j=1,sNy
568 DO i=1,sNx
569 u=uwind(i,j,bi,bj)**2+vwind(i,j,bi,bj)**2
570 u=dsqrt(u)
571 wavesp(i,j,bi,bj)=0.729 _d 0 * u
572 wavesh(i,j,bi,bj)=0.018 _d 0 * u*u*(1. _d 0 + .015 _d 0 *u)
573 ENDDO
574 ENDDO
575 ENDDO
576 ENDDO
577 ENDIF
578 _EXCH_XY_RL(wavesp, mythid)
579 _EXCH_XY_RL(wavesh, mythid)
580 ENDIF
581 ENDIF
582
583
584 C endif for Steady Option
585 ENDIF
586
587 C fill in outer edges
588
589 DO bj = myByLo(myThid), myByHi(myThid)
590 DO bi = myBxLo(myThid), myBxHi(myThid)
591 do j=1-oly,sny+oly
592 jG = myYGlobalLo-1+(bj-1)*sNy+j
593 do i=1-olx,snx+olx
594 iG=myXGlobalLo-1+(bi-1)*sNx+i
595 if(iG.lt.1)then
596 Tr(i,j,bi,bj)=Tr(1,j,bi,bj)
597 qr(i,j,bi,bj)=qr(1,j,bi,bj)
598 uwind(i,j,bi,bj)=uwind(1,j,bi,bj)
599 vwind(i,j,bi,bj)=vwind(1,j,bi,bj)
600 Solar(i,j,bi,bj)=Solar(1,j,bi,bj)
601
602 IF(useStressOption)THEN
603 ustress(i,j,bi,bj)=ustress(1,j,bi,bj)
604 vstress(i,j,bi,bj)=vstress(1,j,bi,bj)
605 ENDIF
606
607 IF(useCheapTracer)THEN
608 CheaptracerR(i,j,bi,bj)=CheaptracerR(1,j,bi,bj)
609 ENDIF
610
611 if(FluxFormula.eq.'COARE3')then
612 wavesp(i,j,bi,bj)=wavesp(1,j,bi,bj)
613 wavesh(i,j,bi,bj)=wavesh(1,j,bi,bj)
614 endif
615
616 elseif(iG.gt.Nx)then
617 Tr(i,j,bi,bj)=Tr(sNx,j,bi,bj)
618 qr(i,j,bi,bj)=qr(sNx,j,bi,bj)
619 uwind(i,j,bi,bj)=uwind(sNx,j,bi,bj)
620 vwind(i,j,bi,bj)=vwind(sNx,j,bi,bj)
621 Solar(i,j,bi,bj)=Solar(sNx,j,bi,bj)
622
623 if(UseStressOption)then
624 ustress(i,j,bi,bj)=ustress(sNx,j,bi,bj)
625 vstress(i,j,bi,bj)=vstress(sNx,j,bi,bj)
626 endif
627
628 IF(useCheapTracer)THEN
629 CheaptracerR(i,j,bi,bj)=CheaptracerR(sNx,j,bi,bj)
630 ENDIF
631
632 if(FluxFormula.eq.'COARE3')then
633 wavesp(i,j,bi,bj)=wavesp(sNx,j,bi,bj)
634 wavesh(i,j,bi,bj)=wavesh(sNx,j,bi,bj)
635 endif
636
637 elseif(jG.lt.1)then
638 Tr(i,j,bi,bj)=Tr(i,1,bi,bj)
639 qr(i,j,bi,bj)=qr(i,1,bi,bj)
640 uwind(i,j,bi,bj)=uwind(i,1,bi,bj)
641 vwind(i,j,bi,bj)=vwind(i,1,bi,bj)
642 Solar(i,j,bi,bj)=Solar(i,1,bi,bj)
643
644 if(UseStressOption)then
645 ustress(i,j,bi,bj)=ustress(i,1,bi,bj)
646 vstress(i,j,bi,bj)=vstress(i,1,bi,bj)
647 endif
648
649 IF(useCheapTracer)THEN
650 CheaptracerR(i,j,bi,bj)=CheaptracerR(i,1,bi,bj)
651 ENDIF
652
653 if(FluxFormula.eq.'COARE3')then
654 wavesp(i,j,bi,bj)=wavesp(i,1,bi,bj)
655 wavesh(i,j,bi,bj)=wavesh(i,1,bi,bj)
656 endif
657
658 elseif(jG.gt.Ny)then
659 Tr(i,j,bi,bj)=Tr(i,sNy,bi,bj)
660 qr(i,j,bi,bj)=qr(i,sNy,bi,bj)
661 uwind(i,j,bi,bj)=uwind(i,sNy,bi,bj)
662 vwind(i,j,bi,bj)=vwind(i,sNy,bi,bj)
663 Solar(i,j,bi,bj)=Solar(i,sNy,bi,bj)
664
665 if(UseStressOption)then
666 ustress(i,j,bi,bj)=ustress(i,sNy,bi,bj)
667 vstress(i,j,bi,bj)=vstress(i,sNy,bi,bj)
668 endif
669
670 IF(useCheapTracer)THEN
671 CheaptracerR(i,j,bi,bj)=CheaptracerR(i,sNy,bi,bj)
672 ENDIF
673
674 if(FluxFormula.eq.'COARE3')then
675 wavesp(i,j,bi,bj)=wavesp(i,sNy,bi,bj)
676 wavesh(i,j,bi,bj)=wavesh(i,sNy,bi,bj)
677 endif
678
679 endif
680 ENDDO
681 ENDDO
682 ENDDO
683 ENDDO
684 RETURN
685 END

  ViewVC Help
Powered by ViewVC 1.1.22