/[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.3 - (hide annotations) (download)
Tue Jun 8 16:42:54 2004 UTC (20 years ago) by molod
Branch: MAIN
Changes since 1.2: +759 -7 lines
Developing

1 molod 1.3 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/update_ocean_exports.F,v 1.2 2004/06/07 18:11:38 molod Exp $
2 molod 1.1 C $Name: $
3    
4     subroutine update_ocean_exports (myTime, myIter, myThid)
5     c----------------------------------------------------------------------
6     c Subroutine update_ocean_exports - 'Wrapper' routine to update
7     c the fields related to the ocean's surface that are needed
8 molod 1.3 c by fizhi (sst and sea ice extent).
9 molod 1.1 c
10     c Call: getsst (Return the current sst field-read dataset if needed)
11     c getsice (Return the current sea ice field-read data if needed)
12     c-----------------------------------------------------------------------
13     implicit none
14     #include "CPP_OPTIONS.h"
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     integer i, j, L, bi, bj
24     integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
25    
26     im1 = 1-OLx
27     im2 = sNx+OLx
28     jm1 = 1-OLy
29     jm2 = sNy+OLy
30     idim1 = 1
31     idim2 = sNx
32     jdim1 = 1
33     jdim2 = sNy
34    
35 molod 1.3 integer ksst,kice
36 molod 1.1
37 molod 1.3 c Declare Local Variables
38     c -----------------------
39     real sstmin
40     parameter ( sstmin = 273.16 )
41 molod 1.1
42 molod 1.3 integer i,j,im,jm
43    
44     C*********************************************************************
45     C**** Interpolate Data to Current Time ****
46     C*********************************************************************
47    
48     call getsst (ksst,nymd,nhms,sst,im,jm)
49     call getsice (kice,nymd,nhms,sice,im,jm)
50    
51     c Check for Minimum Open-Water SST
52     c --------------------------------
53     do j=1,jm
54     do i=1,im
55     if(sice(i,j).eq.0.0 .and. sst(i,j).lt.sstmin)sst(i,j) = sstmin
56 molod 1.1 enddo
57     enddo
58    
59     return
60     end
61 molod 1.3
62     subroutine getsice ( iunit,nymd,nhms,sice,im,jm )
63     C************************************************************************
64     C!GETSICE
65     C************************************************************************
66     C
67     C!ROUTINE: GETSICE
68     C!PROGRAMMER: Sharon Nebuda
69     C!DATE CODED: May 8, 1996
70     C!DESCRIPTION: GETSICE returns the sea ice depth.
71     C! This routine is adaptable for any frequency
72     C! data upto a daily frequency.
73     C! note: for diurnal data ndmax should be increased.
74     C
75     C!INPUT PARAMETERS:
76     C! iunit Unit number assigned to the sice data file
77     C! nymd YYMMDD of the current model timestep
78     C! nhms HHMMSS of the model time
79     C! im Number of x points
80     C! jm Number of y points
81     C! lattice Grid Decomposition defined by Dynamics
82     C
83     C!OUTPUT PARAMETERS:
84     C! sice(im,jm) Sea ice depth in meters
85     C
86     C!ROUTINES CALLED:
87     C
88     C! bcdata Reads the data for a given unit number
89     C! bcheader Reads the header info for a given unit number
90     C! interp_time Returns weights for linear interpolation
91     C
92     C--------------------------------------------------------------------------
93    
94     use dynamics_lattice_module
95     implicit none
96     type ( dynamics_lattice_type ) lattice
97    
98     c MPI Utilities
99     c -------------
100     include 'mpif.h'
101     integer ierror
102    
103     C Parameter statements
104     integer ndmax ! Maximum number of dates in one year for the data
105     parameter (ndmax = 370)
106    
107     C Variables passed to the routine:
108     integer iunit ! Unit number assigned to the sea ice data file
109     integer nymd ! YYMMDD of the current model timestep
110     integer nhms ! HHMMSS of the model time
111     integer im ! Number of x points
112     integer jm ! Number of y points
113    
114     C Variables returned by the routine:
115     real sice(im,jm) ! Sea ice depth in meters
116    
117     C Variables unique to the routine:
118     character*8 cname ! Name of the data in the file header
119     character*80 cdscrip ! Description of the data in the file header
120     real fac1 ! Weighted value (fraction) of the data
121     ! before the model time
122     real fac2 ! Weighted value (fraction) of the data
123     ! after the model time
124     logical first ! True for first time using the dates for the
125     ! BC data file. Then read in the header file.
126     logical found ! If false, then the data surrounding the model
127     ! time was not found
128     logical error ! TRUE if problem with data
129     integer i,j,n,nn ! DO loop counters
130     integer iyear ! Year of model
131     integer iyearbc ! Year of boundary condition data
132     real lat0 ! Starting lat of the bc data set (future use)
133     real lon0 ! Starting lon of the bc data set (future use)
134     integer nd ! Counter for record number of data to read
135     integer ndby3 ! int(ndatebc/3) used for write statement
136     integer imbc ! IM read from the BC data
137     integer jmbc ! JM read from the BC data
138     integer ndatebc ! Number of dates in the BC file
139     integer nhmsbc(ndmax) ! HHMMSS of the data time (not needed currently)
140     integer nhmsbc1 ! HHMMSS of the earlier data kept from last timestep
141     integer nhmsbc2 ! HHMMSS of the later data kept from last timestep
142     integer nrec ! Record number of the header (set to 1)
143     integer nymdbc(ndmax) ! YYYYMMDD of each data
144     integer nymdbc1 ! YYYYMMDD of the earlier data kept from last timestep
145     integer nymdbc2 ! YYYYMMDD of the later data kept from last timestep
146     integer nymdmod ! YYYYMMDD of the current model timestep
147     real timebc1 ! YYYYMMDD.HHMMSS of the earlier bc data
148     real timebc2 ! YYYYMMDD.HHMMSS of the later bc data
149     real timemod ! YYYYMMDD.HHMMSS of the current timestep
150     real undef ! Undefined value for missing data
151    
152     C Define Allocatable Arrays
153     real, allocatable, save :: sicebc1(:,:) ! Sea ice 0=no 1=yes from the bc data
154     ! of the date before the model time
155     real, allocatable, save :: sicebc2(:,:) ! Sea ice 0=no 1=yes from bc data
156     ! of the date after the model time
157    
158     C--------- Variable Initialization ---------------------------------
159    
160     data first /.true./
161     data error /.false./
162    
163     c save header info
164     save imbc, jmbc, lat0, lon0, ndatebc, undef, nymdbc, nhmsbc
165     save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
166     save first
167    
168     c this only works for between 1950-2050
169     if (nymd .lt. 500101) then
170     nymdmod = 20000000 + nymd
171     else if (nymd .le. 991231) then
172     nymdmod = 19000000 + nymd
173     else
174     nymdmod = nymd
175     endif
176    
177     c initialize so that first time through they have values for the check
178     c these vaules make the iyear .ne. iyearbc true anyways for
179     c for the first time so first isnt checked below.
180    
181     if (first) then
182     allocate ( sicebc1(lattice%imglobal,lattice%jmglobal) ) ! Allocate Memory for sicebc1
183     allocate ( sicebc2(lattice%imglobal,lattice%jmglobal) ) ! Allocate Memory for sicebc2
184     nymdbc(2) = 0
185     nymdbc1 = 0
186     nymdbc2 = 0
187     nhmsbc1 = 0
188     nhmsbc2 = 0
189     first = .false.
190     endif
191    
192     C---------- Read in Header file ----------------------------------
193    
194     iyear = nymdmod/10000
195     iyearbc = nymdbc(2)/10000
196    
197     if( iyear.ne.iyearbc ) then
198     if( lattice%myid.eq.0 ) then
199    
200     close(iunit)
201     open (iunit, form='unformatted', access='direct',recl=lattice%imglobal*lattice%jmglobal*4)
202     nrec = 1
203     call bcheader (iunit, ndmax, nrec,
204     . cname, cdscrip, imbc, jmbc, lat0, lon0,
205     . ndatebc, nymdbc, nhmsbc, undef, error)
206    
207     C--------- Check data for Compatibility ------------------------------
208    
209     C Check for correct data in boundary condition file
210     if (.not.error .and. cname.ne.'SICE') then
211     write(6,*) 'Wrong data in SICE boundary condition file => ',cname
212     error = .true.
213     endif
214    
215     C Check Horizontal Resolution
216     if (.not.error .and. imbc*jmbc.ne.lattice%imglobal*lattice%jmglobal) then
217     write(6,*) 'Boundary Condition Resolution DOES NOT match Model Resolution!'
218     write(6,*) 'Boundary Condition Resolution: ',imbc*jmbc
219     write(6,*) ' Model Resolution: ',lattice%imglobal*lattice%jmglobal
220     error = .true.
221     endif
222    
223     C Check Year
224     iyearbc = nymdbc(2)/10000
225     if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
226     write(6,*) 'Boundary Condition Year DOES NOT match REQUESTED Year!'
227     write(6,*) 'Boundary Condition Year: ', iyearbc
228     write(6,*) ' Requested Year: ', iyear
229     error = .true.
230     endif
231    
232     if (.not.error) then
233     C if climatology, fill dates for data with current model year
234     if (iyearbc.eq.0) then
235     write(6,*)
236     write(6,*) 'Climatological Dataset is being used.'
237     write(6,*) 'Current model year will be used to fill Header Dates'
238     do n = 2, ndatebc-1
239     nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
240     enddo
241     C For the first date subtract 1 year from the current model NYMD
242     n = 1
243     nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
244     C For the last date add 1 year to the current model NYMD
245     n = ndatebc
246     nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
247     endif
248    
249     C Write out header info
250     write(6,*) ' Updated boundary condition data'
251     write(6,*) ' ---------------------------------'
252     write(6,*) ' Variable: ',cname
253     write(6,*) ' Description: ',cdscrip
254     write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,' Undefined value = ',undef
255     write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
256     write(6,*) ' Data valid at these times: '
257     ndby3 = ndatebc/3
258     do n = 1, ndby3*3,3
259     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
260     1000 format(3(2x,i3,':',i8,2x,i8))
261     enddo
262     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
263     endif ! End error Check
264    
265     endif ! End MYID=0 Check
266    
267     c Broadcast information to other PEs
268     c ----------------------------------
269     #if (mpi)
270     call mpi_bcast ( error,1,mpi_logical,0,lattice%comm,ierror )
271     #endif
272     if( error ) call my_exit (101)
273    
274     #if (mpi)
275     call mpi_bcast ( ndatebc,1 ,mpi_integer,0,lattice%comm,ierror )
276     call mpi_bcast ( nymdbc,ndatebc,mpi_integer,0,lattice%comm,ierror )
277     call mpi_bcast ( nhmsbc,ndatebc,mpi_integer,0,lattice%comm,ierror )
278     #endif
279    
280     endif ! New Year Info Check
281    
282     C---------- Read sice data if necessary -------------------------------
283    
284     found = .false.
285     nd = 2
286    
287     c If model time is not within the times of saved sice data
288     c from previous call to getsice then read new data
289    
290     timemod = float(nymdmod) + float(nhms) /1000000
291     timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
292     timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
293     if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
294    
295     do while (.not.found .and. nd .le. ndatebc)
296     timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
297     if (timebc2 .gt. timemod) then
298     nymdbc1 = nymdbc(nd-1)
299     nymdbc2 = nymdbc(nd)
300     nhmsbc1 = nhmsbc(nd-1)
301     nhmsbc2 = nhmsbc(nd)
302     if ( lattice%myid.eq.0 ) call bcdata (iunit, imbc, jmbc, nd, nd+1, sicebc1, sicebc2)
303     #if (mpi)
304     call mpi_bcast ( sicebc1,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )
305     call mpi_bcast ( sicebc2,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )
306     #endif
307     found = .true.
308     else
309     nd = nd + 1
310     endif
311     enddo
312    
313     c Otherwise the data from the last time in getsice surrounds the
314     c current model time.
315    
316     else
317     found = .true.
318     endif
319    
320     if (.not.found) then
321     if( lattice%myid.eq.0 ) print *, 'STOP: Could not find SICE boundary condition dates surrounding the model time.'
322     call my_finalize
323     call my_exit (101)
324     endif
325    
326     C---------- Interpolate sice data ------------------------------------
327    
328     call interp_time ( nymdmod,nhms, nymdbc1,nhmsbc1, nymdbc2,nhmsbc2, fac1,fac2 )
329    
330     do j = 1, jm
331     do i = 1, im
332     sice(i,j) = sicebc1( lattice%iglobal(i),lattice%jglobal(j) )*fac1
333     . + sicebc2( lattice%iglobal(i),lattice%jglobal(j) )*fac2
334     c average to 0 or 1
335     c -----------------
336     if (sice(i,j) .ge. 0.5) then
337     sice(i,j) = 1.
338     else
339     sice(i,j) = 0.
340     endif
341     enddo
342     enddo
343    
344     C---------- Fill sice with depth of ice ------------------------------------
345    
346     do j = 1, jm
347     do i = 1, im
348     if (sice(i,j) .eq. 1.) then ! sea ice present
349     sice(i,j) = 3.
350     endif
351     enddo
352     enddo
353    
354     C---------------------------------------------------------------------------
355    
356     return
357     end
358     subroutine getsst ( iunit,nymd,nhms,sst,im,jm,lattice )
359     C************************************************************************
360     C!GETSST
361     C************************************************************************
362     C
363     C!ROUTINE: GETSST
364     C!PROGRAMMER: Sharon Nebuda
365     C!DATE CODED: May 8, 1996
366     C!DESCRIPTION: GETSST gets the SST data.
367     C! This routine is adaptable for any frequency
368     C! data upto a daily frequency.
369     C! note: for diurnal data ndmax should be increased.
370     C
371     C!INPUT PARAMETERS:
372     C! iunit Unit number assigned to the sst data file
373     C! nymd YYMMDD of the current model timestep
374     C! nhms HHMMSS of the model time
375     C! im Number of x points
376     C! jm Number of y points
377     C! lattice Grid Decomposition defined by Dynamics
378     C
379     C!OUTPUT PARAMETERS:
380     C! sst(im,jm) Sea surface temperature in Kelvin
381     C
382     C!ROUTINES CALLED:
383     C
384     C! bcdata Reads the data for a given unit number
385     C! bcheader Reads the header info for a given unit number
386     C! interp_time Returns weights for linear interpolation
387     C
388     C--------------------------------------------------------------------------
389    
390     use dynamics_lattice_module
391     implicit none
392     type ( dynamics_lattice_type ) lattice
393    
394     c MPI Utilities
395     c -------------
396     include 'mpif.h'
397     integer ierror
398    
399     C Parameter statements
400     integer ndmax ! Maximum number of dates in one year for the data
401     parameter (ndmax = 370)
402    
403     C Variables passed to the routine:
404     integer iunit ! Unit number assigned to the SST data file
405     integer nymd ! YYMMDD of the current model timestep
406     integer nhms ! HHMMSS of the model time
407     integer im ! Number of x points
408     integer jm ! Number of y points
409    
410     C Variables returned by the routine:
411     real sst(im,jm) ! Sea surface temperature in Kelvin
412    
413     C Variables unique to the routine:
414     character*8 cname ! Name of the data in the file header
415     character*80 cdscrip ! Description of the data in the file header
416     real fac1 ! Weighted value (fraction) of the data
417     ! before the model time
418     real fac2 ! Weighted value (fraction) of the data
419     ! after the model time
420     logical first ! True for first time using the dates for the
421     ! BC data file. Then read in the header file.
422     logical found ! If false, then the data surrounding the model
423     ! time was not found
424     logical error ! TRUE if problem with data
425     integer i,j,n,nn ! DO loop counters
426     integer iyear ! Year of model
427     integer iyearbc ! Year of boundary condition data
428     real lat0 ! Starting lat of the bc data set (future use)
429     real lon0 ! Starting lon of the bc data set (future use)
430     integer nd ! Counter for record number of data to read
431     integer ndby3 ! int(ndatebc/3) used for write statement
432     integer imbc ! IM read from the BC data
433     integer jmbc ! JM read from the BC data
434     integer ndatebc ! Number of dates in the BC file
435     integer nhmsbc(ndmax) ! HHMMSS of the data time (not needed currently)
436     integer nhmsbc1 ! HHMMSS of the earlier data kept from last timestep
437     integer nhmsbc2 ! HHMMSS of the later data kept from last timestep
438     integer nrec ! Record number of the header (set to 1)
439     integer nymdbc(ndmax) ! YYYYMMDD of each data
440     integer nymdbc1 ! YYYYMMDD of the earlier data kept from last timestep
441     integer nymdbc2 ! YYYYMMDD of the later data kept from last timestep
442     integer nymdmod ! YYYYMMDD of the current model timestep
443     real timebc1 ! YYYYMMDD.HHMMSS of the earlier bc data
444     real timebc2 ! YYYYMMDD.HHMMSS of the later bc data
445     real timemod ! YYYYMMDD.HHMMSS of the current timestep
446     real undef ! Undefined value for missing data
447    
448     C Define Allocatable Arrays
449     real, allocatable, save :: sstbc1(:,:) ! Sea surface temperature (K) from bc data
450     ! of the date before the model time
451     real, allocatable, save :: sstbc2(:,:) ! Sea surface temperature (K) from bc data
452     ! of the date after the model time
453    
454     C--------- Variable Initialization ---------------------------------
455    
456     data first /.true./
457     data error /.false./
458    
459     c save header info
460     save imbc, jmbc, lat0, lon0, ndatebc, undef, nymdbc, nhmsbc
461     save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2, sstbc1
462     save first
463    
464     c this only works for between 1950-2050
465     if (nymd .lt. 500101) then
466     nymdmod = 20000000 + nymd
467     else if (nymd .le. 991231) then
468     nymdmod = 19000000 + nymd
469     else
470     nymdmod = nymd
471     endif
472    
473     c initialize so that first time through they have values for the check
474     c these vaules make the iyear .ne. iyearbc true anyways for
475     c for the first time so first isnt checked below.
476     if (first) then
477     allocate ( sstbc1(lattice%imglobal,lattice%jmglobal) ) ! Allocate Memory for sstbc1
478     allocate ( sstbc2(lattice%imglobal,lattice%jmglobal) ) ! Allocate Memory for sstbc2
479     nymdbc(2) = 0
480     nymdbc1 = 0
481     nymdbc2 = 0
482     nhmsbc1 = 0
483     nhmsbc2 = 0
484     first = .false.
485     endif
486    
487     C---------- Read in Header file ----------------------------------
488    
489     iyear = nymdmod/10000
490     iyearbc = nymdbc(2)/10000
491    
492     if( iyear.ne.iyearbc ) then
493     if( lattice%myid.eq.0 ) then
494    
495     close(iunit)
496     open (iunit, form='unformatted', access='direct',recl=lattice%imglobal*lattice%jmglobal*4)
497     nrec = 1
498     call bcheader (iunit, ndmax, nrec,
499     . cname, cdscrip, imbc, jmbc, lat0, lon0,
500     . ndatebc, nymdbc, nhmsbc, undef, error)
501    
502     C--------- Check data for Compatibility
503    
504     C Check for correct data in boundary condition file
505     if (.not.error .and. cname.ne.'SST') then
506     write(6,*) 'Wrong data in SST boundary condition file => ',cname
507     error = .true.
508     endif
509    
510     C Check Horizontal Resolution
511     if (.not.error .and. imbc*jmbc.ne.lattice%imglobal*lattice%jmglobal) then
512     write(6,*) 'Boundary Condition Resolution DOES NOT match Model Resolution!'
513     write(6,*) 'Boundary Condition Resolution: ',imbc*jmbc
514     write(6,*) ' Model Resolution: ',lattice%imglobal*lattice%jmglobal
515     error = .true.
516     endif
517    
518     C Check Year
519     iyearbc = nymdbc(2)/10000
520     if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
521     write(6,*) 'Boundary Condition Year DOES NOT match REQUESTED Year!'
522     write(6,*) 'Boundary Condition Year: ', iyearbc
523     write(6,*) ' Requested Year: ', iyear
524     error = .true.
525     endif
526    
527     if (.not.error) then
528     C if climatology, fill dates for data with current model year
529     if (iyearbc.eq.0) then
530     write(6,*)
531     write(6,*) 'Climatological Dataset is being used.'
532     write(6,*) 'Current model year will be used to fill Header Dates'
533     do n = 2, ndatebc-1
534     nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
535     enddo
536     C For the first date subtract 1 year from the current model NYMD
537     n = 1
538     nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
539     C For the last date add 1 year to the current model NYMD
540     n = ndatebc
541     nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
542     endif
543    
544     C Write out header info
545     write(6,*) ' Updated boundary condition data'
546     write(6,*) ' ---------------------------------'
547     write(6,*) ' Variable: ',cname
548     write(6,*) ' Description: ',cdscrip
549     write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,' Undefined value = ',undef
550     write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
551     write(6,*) ' Data valid at these times: '
552     ndby3 = ndatebc/3
553     do n = 1, ndby3*3,3
554     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
555     1000 format(3(2x,i3,':',i8,2x,i8))
556     enddo
557     write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
558     endif ! End error Check
559    
560     endif ! End MYID=0 Check
561    
562     c Broadcast information to other PEs
563     c ----------------------------------
564     #if (mpi)
565     call mpi_bcast ( error,1,mpi_logical,0,lattice%comm,ierror )
566     #endif
567     if( error ) call my_exit (101)
568    
569     #if (mpi)
570     call mpi_bcast ( ndatebc,1 ,mpi_integer,0,lattice%comm,ierror )
571     call mpi_bcast ( nymdbc,ndatebc,mpi_integer,0,lattice%comm,ierror )
572     call mpi_bcast ( nhmsbc,ndatebc,mpi_integer,0,lattice%comm,ierror )
573     #endif
574    
575     endif ! New Year Info Check
576    
577     C---------- Read SST data if necessary -------------------------------
578    
579     found = .false.
580     nd = 2
581    
582     c If model time is not within the times of saved sst data
583     c from previous call to getsst then read new data
584    
585     timemod = float(nymdmod) + float(nhms) /1000000
586     timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
587     timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
588     if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
589    
590     do while (.not.found .and. nd .le. ndatebc)
591     timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
592     if (timebc2 .gt. timemod) then
593     nymdbc1 = nymdbc(nd-1)
594     nymdbc2 = nymdbc(nd)
595     nhmsbc1 = nhmsbc(nd-1)
596     nhmsbc2 = nhmsbc(nd)
597     if ( lattice%myid.eq.0 ) call bcdata (iunit, imbc, jmbc, nd, nd+1, sstbc1, sstbc2)
598     #if (mpi)
599     call mpi_bcast ( sstbc1,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )
600     call mpi_bcast ( sstbc2,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )
601     #endif
602     found = .true.
603     else
604     nd = nd + 1
605     endif
606     enddo
607    
608     c Otherwise the data from the last time in getsst surrounds the
609     c current model time.
610    
611     else
612     found = .true.
613     endif
614    
615     if (.not.found) then
616     if( lattice%myid.eq.0 ) print *, 'STOP: Could not find SST boundary condition dates surrounding the model time.'
617     call my_finalize
618     call my_exit (101)
619     endif
620    
621     C---------- Interpolate SST data ------------------------------------
622    
623     call interp_time ( nymdmod,nhms, nymdbc1,nhmsbc1, nymdbc2,nhmsbc2, fac1,fac2 )
624    
625     do j = 1, jm
626     do i = 1, im
627     sst(i,j) = sstbc1( lattice%iglobal(i),lattice%jglobal(j) )*fac1
628     . + sstbc2( lattice%iglobal(i),lattice%jglobal(j) )*fac2
629     enddo
630     enddo
631    
632     return
633     end
634    
635     subroutine bcdata (iunit, im, jm, nrec1, nrec2, field1, field2)
636     C************************************************************************
637     C!BCDATA
638     C************************************************************************
639     C
640     C!ROUTINE: BCDATA
641     C!PROGRAMMER: Sharon Nebuda
642     C!DATE CODED: April 29, 1996
643     C!DESCRIPTION: BCDATA reads the data from the file assigned to the
644     C! passed unit number and returns data from the two times
645     C! surrounding the current model time. The two record
646     C! postitions are not assumed to be next to each other.
647     C
648     C!INPUT PARAMETERS:
649     C! im number of x points
650     C! jm number of y points
651     C! nrec1 record number of the time before the model time
652     C! nrec2 record number of the time after the model time
653     C
654     C!OUTPUT PARAMETERS:
655     C! field1(im,jm) data field before the model time
656     C! field2(im,jm) data field after the model time
657     C
658     C!REVISION HISTORY:
659     C! NEW
660     C
661     C!ROUTINES CALLED:
662     C
663     C! none
664     C
665     C--------------------------------------------------------------------------
666    
667    
668     C--------------- Variable Declaration -------------------------------------
669     implicit none
670    
671     C Variables passed to the routine:
672     integer iunit ! Unit number assigned to the data file
673     integer im ! Number of x points
674     integer jm ! Number of y points
675     integer nrec1 ! Record number of the time before the model time
676     integer nrec2 ! Record number of the time after the model time
677    
678     C Variables returned by the routine:
679     real field1(im,jm) ! Real*8 Data before the model time
680     real field2(im,jm) ! Real*8 Data after the model time
681    
682     C Variables unique to the routine:
683     integer i,j ! DO loop counters
684     real*4 f1(im,jm) ! Real*4 Data before the model time
685     real*4 f2(im,jm) ! Real*4 Data after the model time
686    
687     C--------- Read file -----------------------------------------------
688    
689     read(iunit,rec=nrec1) f1
690     read(iunit,rec=nrec2) f2
691    
692     do j=1,jm
693     do i=1,im
694     field1(i,j) = f1(i,j)
695     field2(i,j) = f2(i,j)
696     enddo
697     enddo
698    
699     return
700     end
701     subroutine bcheader (iunit, ndmax, nrec,
702     . cname, cdscrip, im, jm, lat0, lon0, ndatebc,
703     . nymdbc, nhmsbc, undef, error)
704     C************************************************************************
705     C!BCHEADER
706     C************************************************************************
707     C
708     C!ROUTINE: BCHEADER
709     C!PROGRAMMER: Sharon Nebuda
710     C!DATE CODED: April 29, 1996
711     C!DESCRIPTION: BCHEADER reads the header info from the file assigned to the
712     C! passed unit number and returns the info back.
713     C
714     C!INPUT PARAMETERS:
715     C! iunit unit number assigned to the data file
716     C! ndmax maximum number of date/times of the data
717     C! nrec record number of the header info (or assume 1??)
718     C
719     C!OUTPUT PARAMETERS:
720     C! cname name of the data in the file header
721     C! cdscrip description of the data in the file header
722     C! im number of x points
723     C! jm number of y points
724     C! lat0 starting latitude for the data grid
725     C! lon0 starting longitude for the data grid
726     C! ndatebc number of date/times of the data in the file
727     C! nymdbc(ndmax) array of dates for the data including century
728     C! nhmsbc(ndmax) array of times for the data
729     C! undef value for undefined values in the data
730     C! error logical TRUE if dataset problem
731     C
732     C!REVISION HISTORY:
733     C! NEW
734     C
735     C!ROUTINES CALLED:
736     C! none
737     C
738     C--------------------------------------------------------------------------
739    
740     C--------------- Variable Declaration -------------------------------------
741     implicit none
742    
743     C Variables passed to the routine:
744     integer iunit ! Unit number assigned to the data file
745     integer ndmax ! Maximum number of dates for a given field
746     integer nrec ! Record number of the header info (or assume 1??)
747    
748     C Variables returned by the routine:
749     character*8 cname ! Name of the data in the file header
750     character*80 cdscrip ! Description of the data in the file header
751     integer im ! Number of x points
752     integer jm ! Number of y points
753     real lat0 ! Starting latitude of the data
754     real lon0 ! Starting longitude of the data
755     integer ndatebc ! Number of date/times of the data in the file
756     integer nymdbc(ndmax) ! array of dates for the data including century
757     integer nhmsbc(ndmax) ! array of times for the data
758     real undef ! value for undefined values in the data
759     logical error ! logical TRUE if dataset problem
760    
761     C Variables unique to the routine:
762     integer i ! DO loop counters
763     integer n
764     integer*4 im_32 ! Number of x points
765     integer*4 jm_32 ! Number of y points
766     real*4 lat0_32 ! Starting latitude of the data
767     real*4 lon0_32 ! Starting longitude of the data
768     integer*4 ndatebc_32 ! Number of date/times of the data in the file
769     integer*4 nymdbc_32(ndmax) ! array of dates for the data including century
770     integer*4 nhmsbc_32(ndmax) ! array of times for the data
771     real*4 undef_32 ! value for undefined values in the data
772    
773     C--------- Read file -----------------------------------------------
774    
775     read(iunit,rec=nrec,err=500) cname, cdscrip,
776     . im_32, jm_32, lat0_32, lon0_32,
777     . ndatebc_32, undef_32,
778     . (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
779    
780     im = im_32
781     jm = jm_32
782     lat0 = lat0_32
783     lon0 = lon0_32
784     undef = undef_32
785    
786     ndatebc = ndatebc_32
787     do i=1,ndatebc
788     nymdbc(i) = nymdbc_32(i)
789     nhmsbc(i) = nhmsbc_32(i)
790     enddo
791    
792     return
793     500 continue
794     print *, 'Error reading boundary condition from unit ',iunit
795     error = .true.
796     return
797     end

  ViewVC Help
Powered by ViewVC 1.1.22