/[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.13 - (hide annotations) (download)
Mon Jul 26 18:45:17 2004 UTC (19 years, 11 months ago) by molod
Branch: MAIN
CVS Tags: checkpoint55c_post, checkpoint54e_post, checkpoint55d_pre, checkpoint55h_post, checkpoint55b_post, checkpoint54d_post, checkpoint55, checkpoint54f_post, checkpoint55g_post, checkpoint55f_post, checkpoint55e_post, checkpoint55a_post, checkpoint55d_post
Changes since 1.12: +11 -17 lines
Went to use of FIZHI_OPTIONS and _RL in all routines

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

  ViewVC Help
Powered by ViewVC 1.1.22