/[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.16 - (hide annotations) (download)
Fri Feb 25 18:35:30 2005 UTC (19 years, 4 months ago) by molod
Branch: MAIN
CVS Tags: checkpoint57e_post, eckpoint57e_pre
Changes since 1.15: +5 -3 lines
Fix some syntax errors for data set names

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

  ViewVC Help
Powered by ViewVC 1.1.22