/[MITgcm]/MITgcm/pkg/fizhi/update_ocean_exports.F
ViewVC logotype

Annotation of /MITgcm/pkg/fizhi/update_ocean_exports.F

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


Revision 1.22 - (hide annotations) (download)
Sat May 7 14:35:18 2005 UTC (19 years, 1 month ago) by molod
Branch: MAIN
CVS Tags: checkpoint57h_done, checkpoint57h_pre, checkpoint57h_post
Changes since 1.21: +3 -3 lines
Bug fix

1 molod 1.22 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/update_ocean_exports.F,v 1.21 2005/05/04 22:13:46 molod Exp $
2 molod 1.1 C $Name: $
3    
4 molod 1.13 #include "FIZHI_OPTIONS.h"
5 molod 1.1 subroutine update_ocean_exports (myTime, myIter, myThid)
6     c----------------------------------------------------------------------
7     c Subroutine update_ocean_exports - 'Wrapper' routine to update
8     c the fields related to the ocean's surface that are needed
9 molod 1.3 c by fizhi (sst and sea ice extent).
10 molod 1.1 c
11     c Call: getsst (Return the current sst field-read dataset if needed)
12     c getsice (Return the current sea ice field-read data if needed)
13     c-----------------------------------------------------------------------
14     implicit none
15     #include "SIZE.h"
16     #include "GRID.h"
17 molod 1.2 #include "fizhi_ocean_coms.h"
18 molod 1.1 #include "EEPARAMS.h"
19 molod 1.3 #include "chronos.h"
20 molod 1.20 #ifdef ALLOW_EXCH2
21     #include "W2_EXCH2_TOPOLOGY.h"
22     #include "W2_EXCH2_PARAMS.h"
23     #endif /* ALLOW_EXCH2 */
24 molod 1.1
25 molod 1.14 integer myIter, myThid
26     _RL myTime
27 molod 1.1
28 molod 1.20 integer i, j, bi, bj, bislot, bjslot
29 molod 1.1 integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
30 molod 1.20 integer xsize, ysize
31 molod 1.3 integer ksst,kice
32 molod 1.6 _RL sstmin
33 molod 1.3 parameter ( sstmin = 273.16 )
34 molod 1.1
35 molod 1.20 #if defined(ALLOW_EXCH2)
36     PARAMETER ( xsize = exch2_domain_nxt * sNx )
37     PARAMETER ( ysize = exch2_domain_nyt * sNy )
38     #else
39     PARAMETER ( xsize = Nx )
40     PARAMETER ( ysize = Ny )
41     #endif
42     _RL sst1(xsize,ysize),sst2(xsize,ysize)
43     _RL sice1(xsize,ysize),sice2(xsize,ysize)
44    
45     save sst1, sst2, sice1, sice2
46    
47 molod 1.4 idim1 = 1-OLx
48     idim2 = sNx+OLx
49     jdim1 = 1-OLy
50     jdim2 = sNy+OLy
51     im1 = 1
52     im2 = sNx
53     jm1 = 1
54     jm2 = sNy
55    
56     call mdsfindunit( ksst, myThid )
57     call mdsfindunit( kice, myThid )
58    
59     C***********************************************************************
60 molod 1.3
61 molod 1.4 DO BJ = myByLo(myThid),myByHi(myThid)
62     DO BI = myBxLo(myThid),myBxHi(myThid)
63 molod 1.20 #if defined(ALLOW_EXCH2)
64     bislot = exch2_txglobalo(W2_myTileList(bi))-1
65     bjslot = exch2_tyglobalo(W2_myTileList(bi))-1
66     #else
67     bislot = myXGlobalLo-1+(bi-1)*sNx
68     bjslot = myYGlobalLo-1+(bj-1)*sNy
69     #endif
70 molod 1.4
71     call getsst(ksst,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,
72 molod 1.20 . nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,sst1,sst2,sst)
73 molod 1.4 call getsice(kice,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,
74 molod 1.20 . nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,sice1,sice2,sice)
75 molod 1.3
76     c Check for Minimum Open-Water SST
77     c --------------------------------
78 molod 1.4 do j=jm1,jm2
79     do i=im1,im2
80     if(sice(i,j,bi,bj).eq.0.0 .and. sst(i,j,bi,bj).lt.sstmin)
81     . sst(i,j,bi,bj) = sstmin
82 molod 1.1 enddo
83     enddo
84    
85 molod 1.4 ENDDO
86     ENDDO
87 molod 1.22 _EXCH_XY_R8(sst,myThid)
88     _EXCH_XY_R8(sice,myThid)
89 molod 1.4
90 molod 1.1 return
91     end
92 molod 1.3
93 molod 1.4 subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
94 molod 1.20 . nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
95     . sicebc1,sicebc2,sice)
96     C***********************************************************************
97 molod 1.3 C
98     C!ROUTINE: GETSICE
99     C!DESCRIPTION: GETSICE returns the sea ice depth.
100     C! This routine is adaptable for any frequency
101     C! data upto a daily frequency.
102     C! note: for diurnal data ndmax should be increased.
103     C
104     C!INPUT PARAMETERS:
105 molod 1.4 C! iunit Unit number assigned to the sice data file
106     C! idim1 Start dimension in x-direction
107     C! idim2 End dimension in x-direction
108     C! jdim1 Start dimension in y-direction
109     C! jdim2 End dimension in y-direction
110     C! im1 Begin of x-direction span for filling sice
111     C! im2 End of x-direction span for filling sice
112     C! jm1 Begin of y-direction span for filling sice
113     C! jm2 End of y-direction span for filling sice
114 molod 1.11 C! nSumx Number of processors in x-direction (local processor)
115     C! nSumy Number of processors in y-direction (local processor)
116 molod 1.20 C! xsize Number of processors in x-direction (global)
117     C! ysize Number of processors in y-direction (global)
118 molod 1.4 C! bi Processor number in x-direction (local to processor)
119     C! bj Processor number in y-direction (local to processor)
120 molod 1.20 C! bislot Processor number in x-direction (global)
121     C! bjslot Processor number in y-direction (global)
122 molod 1.4 C! nymd YYMMDD of the current model timestep
123     C! nhms HHMMSS of the model time
124 molod 1.3 C
125     C!OUTPUT PARAMETERS:
126 molod 1.11 C! sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea ice depth in meters
127 molod 1.3 C
128     C!ROUTINES CALLED:
129     C
130 molod 1.4 C! bcdata Reads the data for a given unit number
131     C! bcheader Reads the header info for a given unit number
132     C! interp_time Returns weights for linear interpolation
133 molod 1.3 C
134     C--------------------------------------------------------------------------
135    
136     implicit none
137 molod 1.11 #include "SIZE.h"
138 molod 1.4
139 molod 1.11 integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
140 molod 1.20 integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms
141 molod 1.4
142 molod 1.20 _RL sicebc1(xsize,ysize)
143     _RL sicebc2(xsize,ysize)
144 molod 1.11 _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
145 molod 1.3
146 molod 1.4 C Maximum number of dates in one year for the data
147     integer ndmax
148 molod 1.3 parameter (ndmax = 370)
149    
150 molod 1.4 character*8 cname
151     character*80 cdscrip
152 molod 1.15 character*40 sicedata
153 molod 1.13 _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
154 molod 1.4 logical first, found, error
155 molod 1.20 integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
156 molod 1.5 integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
157 molod 1.4 integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
158 molod 1.3
159    
160     C--------- Variable Initialization ---------------------------------
161    
162     data first /.true./
163     data error /.false./
164    
165     c save header info
166 molod 1.20 save imbc,jmbc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
167 molod 1.11 save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
168     save first
169 molod 1.3
170     c this only works for between 1950-2050
171     if (nymd .lt. 500101) then
172     nymdmod = 20000000 + nymd
173     else if (nymd .le. 991231) then
174     nymdmod = 19000000 + nymd
175     else
176     nymdmod = nymd
177     endif
178    
179 molod 1.16 sicedata='sice19232.weekly.clim'
180    
181 molod 1.3 c initialize so that first time through they have values for the check
182     c these vaules make the iyear .ne. iyearbc true anyways for
183     c for the first time so first isnt checked below.
184    
185     if (first) then
186     nymdbc(2) = 0
187     nymdbc1 = 0
188     nymdbc2 = 0
189     nhmsbc1 = 0
190     nhmsbc2 = 0
191 molod 1.20 c first = .false.
192 molod 1.3 endif
193    
194     C---------- Read in Header file ----------------------------------
195    
196     iyear = nymdmod/10000
197     iyearbc = nymdbc(2)/10000
198    
199     if( iyear.ne.iyearbc ) then
200    
201 molod 1.15 open (iunit,file=sicedata,form='unformatted',access='direct',
202 molod 1.20 . recl=xsize*ysize*4)
203 molod 1.5 nrec = 1
204     call bcheader (iunit, ndmax, nrec,
205 molod 1.20 . cname, cdscrip, imbc, jmbc, lat0, lon0,
206 molod 1.5 . ndatebc, nymdbc, nhmsbc, undef, error)
207 molod 1.3
208     C--------- Check data for Compatibility ------------------------------
209    
210     C Check for correct data in boundary condition file
211     if (.not.error .and. cname.ne.'SICE') then
212 molod 1.4 write(6,*)'Wrong data in SICE boundary condition file => ',cname
213     error = .true.
214 molod 1.3 endif
215    
216     C Check Horizontal Resolution
217 molod 1.20 if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
218 molod 1.4 write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
219 molod 1.20 write(6,*) ' B.C. Resolution: ',imbc*jmbc
220     write(6,*) 'Model Resolution: ',xsize*ysize
221 molod 1.4 error = .true.
222 molod 1.3 endif
223    
224     C Check Year
225     iyearbc = nymdbc(2)/10000
226     if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
227 molod 1.5 write(6,*)' B.C. Year DOES NOT match REQUESTED Year!'
228     write(6,*)' B.C. Year: ', iyearbc
229     write(6,*)'Requested Year: ', iyear
230 molod 1.4 error = .true.
231 molod 1.3 endif
232    
233 molod 1.4 if (.not.error) then
234 molod 1.3 C if climatology, fill dates for data with current model year
235 molod 1.4 if (iyearbc.eq.0) then
236     write(6,*)
237     write(6,*) 'Climatological Dataset is being used.'
238     write(6,*) 'Current model year to be used to fill Header Dates'
239     do n = 2, ndatebc-1
240     nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
241     enddo
242 molod 1.3 C For the first date subtract 1 year from the current model NYMD
243 molod 1.4 n = 1
244     nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
245 molod 1.3 C For the last date add 1 year to the current model NYMD
246 molod 1.4 n = ndatebc
247     nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
248     endif
249 molod 1.3
250     C Write out header info
251 molod 1.4 write(6,*) ' Updated boundary condition data'
252     write(6,*) ' ---------------------------------'
253     write(6,*) ' Variable: ',cname
254     write(6,*) ' Description: ',cdscrip
255     write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,
256     . ' Undefined value = ',undef
257     write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
258     write(6,*) ' Data valid at these times: '
259     ndby3 = ndatebc/3
260     do n = 1, ndby3*3,3
261     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
262     1000 format(3(2x,i3,':',i8,2x,i8))
263     enddo
264     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
265     endif
266 molod 1.3
267 molod 1.4 endif
268 molod 1.3
269     C---------- Read sice data if necessary -------------------------------
270    
271 molod 1.4 found = .false.
272     nd = 2
273 molod 1.3
274     c If model time is not within the times of saved sice data
275     c from previous call to getsice then read new data
276    
277 molod 1.4 timemod = float(nymdmod) + float(nhms) /1000000
278     timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
279     timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
280    
281     if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
282    
283     do while (.not.found .and. nd .le. ndatebc)
284     timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
285     if (timebc2 .gt. timemod) then
286 molod 1.5 nymdbc1 = nymdbc(nd-1)
287     nymdbc2 = nymdbc(nd)
288     nhmsbc1 = nhmsbc(nd-1)
289     nhmsbc2 = nhmsbc(nd)
290 molod 1.20 call bcdata (iunit,imbc,jmbc,nd,nd+1,sicebc1,sicebc2)
291 molod 1.5 found = .true.
292 molod 1.4 else
293 molod 1.5 nd = nd + 1
294 molod 1.4 endif
295     enddo
296 molod 1.3
297     c Otherwise the data from the last time in getsice surrounds the
298     c current model time.
299    
300 molod 1.4 else
301     found = .true.
302     endif
303    
304     if (.not.found) then
305     print *, 'STOP: Could not find SICE dates for model time.'
306     call my_finalize
307     call my_exit (101)
308     endif
309 molod 1.3
310     C---------- Interpolate sice data ------------------------------------
311    
312 molod 1.4 call interp_time(nymdmod,nhms,nymdbc1,nhmsbc1,nymdbc2,nhmsbc2,
313     . fac1,fac2)
314 molod 1.3
315 molod 1.4 do j = jm1,jm2
316     do i = im1,im2
317 molod 1.20 sice(i,j,bi,bj) = sicebc1(i+bislot,j+bjslot)*fac1
318     . + sicebc2(i+bislot,j+bjslot)*fac2
319 molod 1.3 c average to 0 or 1
320     c -----------------
321 molod 1.4 if (sice(i,j,bi,bj) .ge. 0.5) then
322     sice(i,j,bi,bj) = 1.
323     else
324     sice(i,j,bi,bj) = 0.
325     endif
326     enddo
327     enddo
328 molod 1.3
329     C---------- Fill sice with depth of ice ------------------------------------
330 molod 1.4 do j = jm1,jm2
331     do i = im1,im2
332     if (sice(i,j,bi,bj) .eq. 1.) then
333     sice(i,j,bi,bj) = 3.
334     endif
335     enddo
336     enddo
337 molod 1.3 C---------------------------------------------------------------------------
338 molod 1.21 close(iunit)
339 molod 1.3
340     return
341     end
342 molod 1.5 subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
343 molod 1.20 . nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
344     . sstbc1,sstbc2,sst)
345     C***********************************************************************
346 molod 1.3 C
347     C!ROUTINE: GETSST
348     C!DESCRIPTION: GETSST gets the SST data.
349     C! This routine is adaptable for any frequency
350     C! data upto a daily frequency.
351     C! note: for diurnal data ndmax should be increased.
352     C
353     C!INPUT PARAMETERS:
354 molod 1.5 C! iunit Unit number assigned to the sice data file
355     C! idim1 Start dimension in x-direction
356     C! idim2 End dimension in x-direction
357     C! jdim1 Start dimension in y-direction
358     C! jdim2 End dimension in y-direction
359 molod 1.20 C! im1 Begin of x-direction span for filling sst
360     C! im2 End of x-direction span for filling sst
361     C! jm1 Begin of y-direction span for filling sst
362     C! jm2 End of y-direction span for filling sst
363 molod 1.11 C! nSumx Number of processors in x-direction (local processor)
364     C! nSumy Number of processors in y-direction (local processor)
365 molod 1.20 C! xsize x-dimension of global array
366     C! ysize y-dimension of global array
367 molod 1.5 C! bi Processor number in x-direction (local to processor)
368     C! bj Processor number in y-direction (local to processor)
369 molod 1.20 C! bislot Slot number into global array in x-direction (global)
370     C! bjslot Slot number into global array in y-direction (global)
371 molod 1.5 C! nymd YYMMDD of the current model timestep
372     C! nhms HHMMSS of the model time
373 molod 1.3 C
374     C!OUTPUT PARAMETERS:
375 molod 1.11 C! sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea surface temperature (K)
376 molod 1.3 C
377     C!ROUTINES CALLED:
378     C
379     C! bcdata Reads the data for a given unit number
380     C! bcheader Reads the header info for a given unit number
381 molod 1.20 C! interp_time Returns weights for linear interpolation
382 molod 1.3 C
383     C--------------------------------------------------------------------------
384    
385     implicit none
386 molod 1.11 #include "SIZE.h"
387 molod 1.5
388 molod 1.11 integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
389 molod 1.20 integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms
390 molod 1.3
391 molod 1.20 _RL sstbc1(xsize,ysize)
392     _RL sstbc2(xsize,ysize)
393 molod 1.11 _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
394 molod 1.3
395 molod 1.5 C Maximum number of dates in one year for the data
396     integer ndmax
397 molod 1.3 parameter (ndmax = 370)
398    
399 molod 1.5 character*8 cname
400     character*80 cdscrip
401 molod 1.17 character*20 sstdata
402 molod 1.13 _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
403 molod 1.5 logical first, found, error
404 molod 1.20 integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
405 molod 1.5 integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
406     integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
407    
408 molod 1.3
409     C--------- Variable Initialization ---------------------------------
410    
411     data first /.true./
412     data error /.false./
413    
414     c save header info
415 molod 1.20 save imbc,jmbc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
416 molod 1.11 save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
417     save first
418 molod 1.3
419     c this only works for between 1950-2050
420     if (nymd .lt. 500101) then
421     nymdmod = 20000000 + nymd
422     else if (nymd .le. 991231) then
423     nymdmod = 19000000 + nymd
424     else
425     nymdmod = nymd
426     endif
427    
428 molod 1.16 sstdata='sst19232.weekly.clim'
429    
430 molod 1.3 c initialize so that first time through they have values for the check
431     c these vaules make the iyear .ne. iyearbc true anyways for
432     c for the first time so first isnt checked below.
433     if (first) then
434     nymdbc(2) = 0
435     nymdbc1 = 0
436     nymdbc2 = 0
437     nhmsbc1 = 0
438     nhmsbc2 = 0
439 molod 1.20 c first = .false.
440 molod 1.3 endif
441    
442     C---------- Read in Header file ----------------------------------
443    
444     iyear = nymdmod/10000
445     iyearbc = nymdbc(2)/10000
446    
447     if( iyear.ne.iyearbc ) then
448    
449 molod 1.15 open (iunit,file=sstdata,form='unformatted',access='direct',
450 molod 1.20 . recl=xsize*ysize*4)
451 molod 1.5 nrec = 1
452     call bcheader (iunit, ndmax, nrec,
453 molod 1.20 . cname, cdscrip, imbc, jmbc, lat0, lon0,
454 molod 1.5 . ndatebc, nymdbc, nhmsbc, undef, error)
455 molod 1.3
456     C--------- Check data for Compatibility
457    
458     C Check for correct data in boundary condition file
459     if (.not.error .and. cname.ne.'SST') then
460 molod 1.5 write(6,*)'Wrong data in SST boundary condition file => ',cname
461     error = .true.
462 molod 1.3 endif
463    
464     C Check Horizontal Resolution
465 molod 1.20 if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
466 molod 1.5 write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
467 molod 1.20 write(6,*) ' B.C. Resolution: ',imbc*jmbc
468     write(6,*) 'Model Resolution: ',xsize*ysize
469 molod 1.5 error = .true.
470 molod 1.3 endif
471    
472     C Check Year
473     iyearbc = nymdbc(2)/10000
474     if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
475 molod 1.5 write(6,*)' B.C. Year DOES NOT match REQUESTED Year!'
476     write(6,*)' B.C. Year: ', iyearbc
477     write(6,*)'Requested Year: ', iyear
478     error = .true.
479 molod 1.3 endif
480    
481     if (.not.error) then
482     C if climatology, fill dates for data with current model year
483 molod 1.5 if (iyearbc.eq.0) then
484     write(6,*)
485 molod 1.9 write(6,*)'Climatological Dataset is being used.'
486     write(6,*)'Current model year is used to fill Header Dates'
487 molod 1.5 do n = 2, ndatebc-1
488     nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
489     enddo
490 molod 1.3 C For the first date subtract 1 year from the current model NYMD
491 molod 1.5 n = 1
492     nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
493 molod 1.3 C For the last date add 1 year to the current model NYMD
494 molod 1.5 n = ndatebc
495     nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
496     endif
497 molod 1.3
498     C Write out header info
499 molod 1.5 write(6,*) ' Updated boundary condition data'
500     write(6,*) ' ---------------------------------'
501     write(6,*) ' Variable: ',cname
502     write(6,*) ' Description: ',cdscrip
503     write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,
504     . ' Undefined value = ',undef
505     write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
506     write(6,*) ' Data valid at these times: '
507     ndby3 = ndatebc/3
508     do n = 1, ndby3*3,3
509     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
510     1000 format(3(2x,i3,':',i8,2x,i8))
511     enddo
512     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
513 molod 1.8 endif
514 molod 1.3
515     if( error ) call my_exit (101)
516    
517 molod 1.8 endif
518 molod 1.3
519     C---------- Read SST data if necessary -------------------------------
520    
521 molod 1.5 found = .false.
522     nd = 2
523 molod 1.3
524     c If model time is not within the times of saved sst data
525     c from previous call to getsst then read new data
526    
527 molod 1.5 timemod = float(nymdmod) + float(nhms) /1000000
528     timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
529     timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
530     if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
531    
532     do while (.not.found .and. nd .le. ndatebc)
533     timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
534     if (timebc2 .gt. timemod) then
535     nymdbc1 = nymdbc(nd-1)
536     nymdbc2 = nymdbc(nd)
537     nhmsbc1 = nhmsbc(nd-1)
538     nhmsbc2 = nhmsbc(nd)
539 molod 1.20 call bcdata (iunit,imbc,jmbc,nd,nd+1,sstbc1,sstbc2)
540 molod 1.5 found = .true.
541     else
542     nd = nd + 1
543     endif
544     enddo
545 molod 1.3
546     c Otherwise the data from the last time in getsst surrounds the
547     c current model time.
548    
549 molod 1.5 else
550     found = .true.
551     endif
552 molod 1.3
553 molod 1.5 if (.not.found) then
554     print *, 'STOP: Could not find SST dates for model time.'
555     call my_finalize
556     call my_exit (101)
557     endif
558 molod 1.3
559     C---------- Interpolate SST data ------------------------------------
560    
561 molod 1.5 call interp_time(nymdmod,nhms,nymdbc1,nhmsbc1,nymdbc2,nhmsbc2,
562     . fac1,fac2)
563 molod 1.3
564 molod 1.5 do j = jm1,jm2
565     do i = im1,im2
566 molod 1.20 sst(i,j,bi,bj) = sstbc1(i+bislot,j+bjslot)*fac1
567     . + sstbc2(i+bislot,j+bjslot)*fac2
568 molod 1.5 enddo
569     enddo
570 molod 1.3
571 molod 1.21 close(iunit)
572    
573 molod 1.3 return
574     end
575    
576 molod 1.20 subroutine bcdata (iunit,im,jm,nrec1,nrec2,field1,field2)
577 molod 1.3 C************************************************************************
578     C
579 molod 1.5 C!ROUTINE: BCDATA
580     C!DESCRIPTION: BCDATA reads the data from the file assigned to the
581     C! passed unit number and returns data from the two times
582     C! surrounding the current model time. The two record
583     C! postitions are not assumed to be next to each other.
584 molod 1.3 C
585     C!INPUT PARAMETERS:
586 molod 1.5 C! im number of x points
587     C! im number of x points
588     C! nrec1 record number of the time before the model time
589     C! nrec2 record number of the time after the model time
590 molod 1.3 C
591     C!OUTPUT PARAMETERS:
592 molod 1.20 C! field1(im,jm) data field before the model time
593     C! field2(im,jm) data field after the model time
594 molod 1.3 C
595     C--------------------------------------------------------------------------
596 molod 1.5 implicit none
597 molod 1.3
598 molod 1.20 integer iunit,im,jm,nrec1,nrec2
599 molod 1.3
600 molod 1.20 _RL field1(im,jm)
601     _RL field2(im,jm)
602 molod 1.3
603 molod 1.20 integer i,j
604     real*4 f1(im,jm), f2(im,jm)
605 molod 1.3
606     C--------- Read file -----------------------------------------------
607     read(iunit,rec=nrec1) f1
608     read(iunit,rec=nrec2) f2
609    
610 molod 1.12 #ifdef _BYTESWAPIO
611 molod 1.20 call MDS_BYTESWAPR4( im*jm, f1)
612     call MDS_BYTESWAPR4( im*jm, f2)
613 molod 1.12 #endif
614 molod 1.3 do j=1,jm
615     do i=1,im
616 molod 1.20 field1(i,j) = f1(i,j)
617     field2(i,j) = f2(i,j)
618 molod 1.3 enddo
619     enddo
620    
621     return
622     end
623     subroutine bcheader (iunit, ndmax, nrec,
624 molod 1.20 . cname, cdscrip, im, jm, lat0, lon0, ndatebc,
625 molod 1.5 . nymdbc, nhmsbc, undef, error)
626 molod 1.3 C************************************************************************
627     C
628 molod 1.5 C!ROUTINE: BCHEADER
629     C!DESCRIPTION: BCHEADER reads the header from a file and returns the info.
630 molod 1.3 C
631     C!INPUT PARAMETERS:
632 molod 1.5 C! iunit unit number assigned to the data file
633     C! ndmax maximum number of date/times of the data
634     C! nrec record number of the header info (or assume 1??)
635 molod 1.3 C
636     C!OUTPUT PARAMETERS:
637 molod 1.5 C! cname name of the data in the file header
638     C! cdscrip description of the data in the file header
639     C! im number of x points
640     C! jm number of y points
641     C! lat0 starting latitude for the data grid
642     C! lon0 starting longitude for the data grid
643     C! ndatebc number of date/times of the data in the file
644     C! nymdbc(ndmax) array of dates for the data including century
645     C! nhmsbc(ndmax) array of times for the data
646     C! undef value for undefined values in the data
647     C! error logical TRUE if dataset problem
648 molod 1.3 C
649     C--------------------------------------------------------------------------
650 molod 1.5 implicit none
651 molod 1.3
652 molod 1.5 integer iunit, ndmax, nrec
653 molod 1.3
654 molod 1.5 character*8 cname
655     character*80 cdscrip
656 molod 1.20 character*112 dummy112
657     integer im,jm,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
658 molod 1.13 _RL lat0,lon0,undef
659 molod 1.5 logical error
660    
661 molod 1.11 integer i
662 molod 1.20 integer*4 im_32,jm_32
663 molod 1.9 integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
664 molod 1.5 real*4 lat0_32,lon0_32,undef_32
665 molod 1.3
666     C--------- Read file -----------------------------------------------
667    
668     read(iunit,rec=nrec,err=500) cname, cdscrip,
669 molod 1.20 . im_32, jm_32, lat0_32, lon0_32,
670     . ndatebc_32, undef_32
671    
672 molod 1.12 #ifdef _BYTESWAPIO
673 molod 1.18 call MDS_BYTESWAPI4( 1, im_32)
674     call MDS_BYTESWAPI4( 1, jm_32)
675 molod 1.12 call MDS_BYTESWAPR4( 1, lat0_32)
676     call MDS_BYTESWAPR4( 1, lon0_32)
677 molod 1.20 call MDS_BYTESWAPI4( 1, ndatebc_32)
678 molod 1.12 call MDS_BYTESWAPR4( 1, undef_32)
679     #endif
680 molod 1.5
681 molod 1.20 read(iunit,rec=nrec,err=500) dummy112,
682     . (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
683    
684 molod 1.5 im = im_32
685     jm = jm_32
686     lat0 = lat0_32
687     lon0 = lon0_32
688 molod 1.3 undef = undef_32
689    
690     ndatebc = ndatebc_32
691     do i=1,ndatebc
692 molod 1.20 #ifdef _BYTESWAPIO
693     call MDS_BYTESWAPI4( 1, nymdbc_32(i))
694     call MDS_BYTESWAPI4( 1, nhmsbc_32(i))
695     #endif
696 molod 1.3 nymdbc(i) = nymdbc_32(i)
697     nhmsbc(i) = nhmsbc_32(i)
698     enddo
699    
700     return
701     500 continue
702     print *, 'Error reading boundary condition from unit ',iunit
703     error = .true.
704     return
705     end

  ViewVC Help
Powered by ViewVC 1.1.22