FV3 Bundle
interpolator.F90
Go to the documentation of this file.
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
20 !> \author William Cooke <William.Cooke@noaa.gov>
21 !!
22 !! \brief interpolator_mod is a module to interpolate climatology data to model the grid.
23 !!
24 !! Modules Included:
25 !!
26 !! <table>
27 !! <tr>
28 !! <th>Module Name</th>
29 !! <th>Functions Included</th>
30 !! </tr>
31 !! <tr>
32 !! <td>mpp_mod</td>
33 !! <td>mpp_error, FATAL, mpp_pe, mpp_init, mpp_exit, mpp_npes,
34 !! WARNING, NOTE, input_nml_file</td>
35 !! </tr>
36 !! <tr>
37 !! <td>mpp_io_mod</td>
38 !! <td>mpp_open, mpp_close, mpp_get_times, mpp_get_atts, mpp_get_info,
39 !! mpp_read, mpp_get_axes, mpp_get_axis_data, mpp_get_fields,
40 !! fieldtype, atttype, axistype, MPP_RDONLY, MPP_NETCDF, MPP_MULTI,
41 !! MPP_APPEND, MPP_SINGLE</td>
42 !! </tr>
43 !! <tr>
44 !! <td>mpp_domains_mod</td>
45 !! <td>mpp_update_domains, mpp_define_domains, mpp_global_field,
46 !! domain2d, mpp_define_layout, mpp_get_compute_domain</td>
47 !! </tr>
48 !! <tr>
49 !! <td>diag_manager_mod</td>
50 !! <td>diag_manager_init, get_base_time, register_diag_field,
51 !! send_data, diag_axis_init</td>
52 !! </tr>
53 !! <tr>
54 !! <td>fms_mod</td>
55 !! <td>open_namelist_file, fms_init, mpp_pe, mpp_root_pe, stdlog,
56 !! file_exist, write_version_number, check_nml_error, error_mesg,
57 !! FATAL, NOTE, WARNING, close_file</td>
58 !! </tr>
59 !! <tr>
60 !! <td>horiz_interp_mod</td>
61 !! <td>horiz_interp_type, horiz_interp_new, horiz_interp_init,
62 !! horiz_interp, horiz_interp_del</td>
63 !! </tr>
64 !! <tr>
65 !! <td>time_manager_mod</td>
66 !! <td>time_type, set_time, set_date, get_date, get_calendar_type,
67 !! JULIAN, NOLEAP, get_date_julian, set_date_no_leap,
68 !! set_date_julian, get_date_no_leap, print_date,
69 !! operator(+), operator(-), operator(*), operator(>),
70 !! operator(<), decrement_time</td>
71 !! </tr>
72 !! <tr>
73 !! <td>time_interp_mod</td>
74 !! <td>time_interp, YEAR</td>
75 !! </tr>
76 !! <tr>
77 !! <td>constants_mod</td>
78 !! <td>grav, PI, SECONDS_PER_DAY</td>
79 !! </tr>
80 !! </table>
82 
83 #include <fms_platform.h>
84 
85 use mpp_mod, only : mpp_error, &
86  fatal, &
87  mpp_pe, &
88  mpp_init, &
89  mpp_exit, &
90  mpp_npes, &
91  warning, &
92  note, &
94 use mpp_io_mod, only : mpp_open, &
95  mpp_close, &
96  mpp_get_times, &
97  mpp_get_atts, &
98  mpp_get_info, &
99  mpp_read, &
100  mpp_get_axes, &
101  mpp_get_axis_data, &
102  mpp_get_fields, &
103  fieldtype, &
104  atttype, &
105  axistype, &
106  mpp_rdonly, &
107  mpp_netcdf, &
108  mpp_multi, &
109  mpp_append, &
110  mpp_single
111 use mpp_domains_mod, only : mpp_domains_init, &
115  domain2d, &
120  diag_axis_init
121 use fms_mod, only : lowercase, write_version_number, &
122  fms_init, &
123  file_exist, mpp_root_pe, stdlog, &
124  open_namelist_file, close_file, &
126 use horiz_interp_mod, only : horiz_interp_type, &
129  assignment(=), &
130  horiz_interp, &
132 use time_manager_mod, only : time_type, &
133  set_time, &
134  set_date, &
135  get_date, &
137  julian, noleap, &
140  print_date, &
141  operator(+), &
142  operator(-), &
143  operator(*), &
144  operator(>), &
145  operator(<), &
146  assignment(=), &
148 use time_interp_mod, only : time_interp, year
149 use constants_mod, only : grav, pi, seconds_per_day
150 
151 !--------------------------------------------------------------------
152 
153 implicit none
154 private
155 
156 !---------------------------------------------------------------------
157 !------- interfaces --------
158 
159 public interpolator_init, &
160  interpolator, &
165  init_clim_diag, &
167  read_data
168 
169 !> \page interpolator interpolator Interface
170 !!
171 !! ~~~~~~~~~~{.f90}
172 !! call interpolator (sulfate, model_time, p_half, model_data, name, is, js, clim_units)
173 !! call interpolator (o3, model_time, p_half, model_data, "ozone", is, js)
174 !! ~~~~~~~~~~
175 !!
176 !! The first option is used to generate sulfate models.
177 !!
178 !! The sulfate data is set by
179 !! ~~~~~~~~~~{.f90}
180 !! type(interpolate_type), intent(inout) :: sulfate
181 !! ~~~~~~~~~~
182 !! The name of the model is set by
183 !! ~~~~~~~~~~{.f90}
184 !! character(len=*), intent(in) :: name
185 !! ~~~~~~~~~~
186 !! The units used in this model are outputted to
187 !! ~~~~~~~~~~{.f90}
188 !! character(len=*), intent(out), optional :: clim_units
189 !! ~~~~~~~~~~
190 !!
191 !! The second option is generate ozone models.
192 !!
193 !! The ozone data is set by
194 !! ~~~~~~~~~~{.f90}
195 !! type(interpolate_type), intent(inout) :: o3
196 !! ~~~~~~~~~~
197 !!
198 !! Both of these options use the following variables in the model.
199 !!
200 !! The time used in the model is set by
201 !!
202 !! ~~~~~~~~~~{.f90}
203 !! type(time_type), intent(in) :: model_time
204 !! ~~~~~~~~~~
205 !! The model pressure field is set by
206 !! ~~~~~~~~~~{.f90}
207 !! real, intent(in), dimension(:,:,:) :: p_half
208 !! ~~~~~~~~~~
209 !!
210 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
211 !! \param [in] <field_name> The name of a field that you wish to interpolate
212 !! \param [in] <Time> The model time that you wish to interpolate to
213 !! \param [in] <phalf> The half level model pressure field
214 !! \param [in] <is> Index for the physics window
215 !! \param [in] <js> Index for the physics window
216 !! \param [out] <interp_data> The model fields with the interpolated climatology data
217 !! \param [out] <clim_units> The units of field_name
218 interface interpolator
219  module procedure interpolator_4d
220  module procedure interpolator_3d
221  module procedure interpolator_2d
222  module procedure interpolator_4d_no_time_axis
223  module procedure interpolator_3d_no_time_axis
224  module procedure interpolator_2d_no_time_axis
225 end interface
226 
227 !> \page assignment assignment Interface
228 !!
229 !! \param [in] <In> No description
230 !! \param [inout] <Out> No description
231 interface assignment(=)
232  module procedure interpolate_type_eq
233 end interface
234 
235 !> \page interp_weighted_scalar interp_weighted_scalar Interface
236 !!
237 !! ~~~~~~~~~~{.f90}
238 !! call interp_weighted_scalar (pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,:),interp_data(ilon,j,:,:))
239 !! call interp_weighted_scalar (pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
240 !! ~~~~~~~~~~
241 !!
242 !! \param [in] <grdin> No description
243 !! \param [in] <grdout> No description
244 !! \param [in] <datin> No description
245 !! \param [out] <datout> No description
247  module procedure interp_weighted_scalar_1d
248  module procedure interp_weighted_scalar_2d
249 end interface interp_weighted_scalar
250 
251 !---------------------------------------------------------------------
252 !----------- version number for this module --------------------------
253 
254 ! Include variable "version" to be written to log file.
255 #include<file_version.h>
256 logical :: module_is_initialized = .false.
257 logical :: clim_diag_initialized = .false.
258 
259 type, public :: interpolate_type !< Redundant climatology data between fields
260 private
261 !Redundant data between fields
262 !All climatology data
263 real, pointer :: lat(:) =>null() !< No description
264 real, pointer :: lon(:) =>null() !< No description
265 real, pointer :: latb(:) =>null() !< No description
266 real, pointer :: lonb(:) =>null() !< No description
267 real, pointer :: levs(:) =>null() !< No description
268 real, pointer :: halflevs(:) =>null() !< No description
269 type(horiz_interp_type) :: interph !< No description
270 type(time_type), pointer :: time_slice(:) =>null() !< An array of the times within the climatology.
271 integer :: unit !< Unit number on which file is being read.
272 character(len=64) :: file_name !< Climatology filename
273 integer :: time_flag !< Linear or seaonal interpolation?
274 integer :: level_type !< Pressure or Sigma level
275 integer :: is,ie,js,je !< No description
276 integer :: vertical_indices !< direction of vertical
277  !! data axis
278 logical :: climatological_year !< Is data for year = 0000?
279 
280 !Field specific data for nfields
281 type(fieldtype), pointer :: field_type(:) =>null() !< NetCDF field type
282 character(len=64), pointer :: field_name(:) =>null() !< name of this field
283 integer, pointer :: time_init(:,:) =>null() !< second index is the number of time_slices being kept. 2 or ntime.
284 integer, pointer :: mr(:) =>null() !< Flag for conversion of climatology to mixing ratio.
285 integer, pointer :: out_of_bounds(:) =>null()!< Flag for when surface pressure is out of bounds.
286 !++lwh
287 integer, pointer :: vert_interp(:) =>null() !< Flag for type of vertical interpolation.
288 !--lwh
289 real, pointer :: data(:,:,:,:,:) =>null() !< (nlatmod,nlonmod,nlevclim,size(time_init,2),nfields)
290 
291 real, pointer :: pmon_pyear(:,:,:,:) =>null() !< No description
292 real, pointer :: pmon_nyear(:,:,:,:) =>null() !< No description
293 real, pointer :: nmon_nyear(:,:,:,:) =>null() !< No description
294 real, pointer :: nmon_pyear(:,:,:,:) =>null() !< No description
295 !integer :: indexm, indexp, climatology
296 integer,dimension(:), pointer :: indexm =>null() !< No description
297 integer,dimension(:), pointer :: indexp =>null() !< No description
298 integer,dimension(:), pointer :: climatology =>null() !< No description
299 
300 type(time_type), pointer :: clim_times(:,:) => null() !< No description
301 logical :: separate_time_vary_calc !< No description
302 real :: tweight !< No description
303 real :: tweight1 !< The time weight between the climatology years
304 real :: tweight2 !< No description
305 real :: tweight3 !< The time weight between the month
306 integer :: itaum !< No description
307 integer :: itaup !< No description
308 end type interpolate_type
309 
310 
311 integer :: ndim !< No description
312 integer :: nvar !< No description
313 integer :: natt !< No description
314 integer :: ntime !< No description
315 integer :: nlat !< No description
316 integer :: nlatb !< No description
317 integer :: nlon !< No description
318 integer :: nlonb !< No description
319 integer :: nlev !< No description
320 integer :: nlevh !< No description
321 integer :: len, ntime_in, num_fields !< No description
322 type(axistype), allocatable :: axes(:) !< No description
323 type(axistype),save :: time_axis !< No description
324 type(fieldtype), allocatable :: varfields(:) !< No description
325 
326 ! pletzer real, allocatable :: time_in(:)
327 ! sjs real, allocatable :: climdata(:,:,:), climdata2(:,:,:)
328 
329 character(len=32) :: name, units !< No description
330 integer :: sense !< No description
331 
332 integer, parameter :: max_diag_fields = 30 !< No description
333 
334 ! flags to indicate direction of vertical axis in data file
335 integer, parameter :: increasing_downward = 1, increasing_upward = -1 !< Flags to indicate direction of vertical axis in data file
336 !++lwh
337 ! Flags to indicate whether the time interpolation should be linear or some other scheme for seasonal data.
338 ! NOTIME indicates that data file has no time axis.
339 integer, parameter :: linear = 1, seasonal = 2, bilinear = 3, notime = 4 !< Flags to indicate whether the time interpolation
340  !! should be linear or some other scheme for seasonal data.
341  !! NOTIME indicates that data file has no time axis.
342 
343 ! Flags to indicate where climatology pressure levels are pressure or sigma levels
344 integer, parameter :: pressure = 1, sigma = 2 !< Flags to indicate where climatology pressure levels are pressure or sigma levels
345 
346 ! Flags to indicate whether the climatology units are mixing ratio (kg/kg) or column integral (kg/m2).
347 ! Vertical interpolation scheme requires mixing ratio at this time.
348 integer, parameter :: no_conv = 1, kg_m2 = 2 !< Flags to indicate whether the climatology units are mixing ratio (kg/kg) or column integral (kg/m2).
349  !< Vertical interpolation scheme requires mixing ratio at this time.
350 
351 ! Flags to indicate what to do when the model surface pressure exceeds the climatology surface pressure level.
352 integer, parameter, public :: constant = 1, zero = 2 !< Flags to indicate what to do when the model surface pressure
353  !< exceeds the climatology surface pressure level.
354 
355 ! Flags to indicate the type of vertical interpolation
356 integer, parameter, public :: interp_weighted_p = 10, interp_linear_p = 20, interp_log_p = 30 !< Flags to indicate the type of vertical interpolation
357 !--lwh
358 
359 integer :: num_clim_diag = 0 !< No description
360 character(len=64) :: climo_diag_name(max_diag_fields) !< No description
362 real :: missing_value = -1.e10 !< No description
363 ! sjs integer :: itaum, itaup
364 
365 #ifdef NO_QUAD_PRECISION
366 ! 64-bit precision (kind=8)
367  integer, parameter:: f_p = selected_real_kind(15) !< 64-bit precision (kind=8)
368 #else
369 ! Higher precision (kind=16) for grid geometrical factors:
370  integer, parameter:: f_p = selected_real_kind(20) !< Higher precision (kind=16) for grid geometrical factors
371 #endif
372 
373 logical :: read_all_on_init = .false. !< No description
374 integer :: verbose = 0 !< No description
375 logical :: conservative_interp = .true. !< No description
376 logical :: retain_cm3_bug = .true. !< No description
377 
378 namelist /interpolator_nml/ &
380 
381 contains
382 
383 !#####################################################################
384 !
385 !---------------------------------------------------------------------
386 !> \brief interpolator_type_eq receives the variable In and Out as
387 !! input and returns Out.
388 !!
389 !! \param [in] <In> No description
390 !! \param [inout] <Out> No description
391 subroutine interpolate_type_eq (Out, In)
393 type(interpolate_type), intent(in) :: in
394 type(interpolate_type), intent(inout) :: out
395 
396 
397  if (associated(in%lat)) out%lat => in%lat
398  if (associated(in%lon)) out%lon => in%lon
399  if (associated(in%latb)) out%latb => in%latb
400  if (associated(in%lonb)) out%lonb => in%lonb
401  if (associated(in%levs)) out%levs => in%levs
402  if (associated(in%halflevs)) out%halflevs => in%halflevs
403 
404  out%interph = in%interph
405  if (associated(in%time_slice)) out%time_slice => in%time_slice
406  out%unit = in%unit
407  out%file_name = in%file_name
408  out%time_flag = in%time_flag
409  out%level_type = in%level_type
410  out%is = in%is
411  out%ie = in%ie
412  out%js = in%js
413  out%je = in%je
414  out%vertical_indices = in%vertical_indices
415  out%climatological_year = in%climatological_year
416  out%field_type => in%field_type
417  if (associated(in%field_name )) out%field_name => in%field_name
418  if (associated(in%time_init )) out%time_init => in%time_init
419  if (associated(in%mr )) out%mr => in%mr
420  if (associated(in%out_of_bounds)) out%out_of_bounds => in%out_of_bounds
421  if (associated(in%vert_interp )) out%vert_interp => in%vert_interp
422  if (associated(in%data )) out%data => in%data
423  if (associated(in%pmon_pyear )) out%pmon_pyear => in%pmon_pyear
424  if (associated(in%pmon_nyear )) out%pmon_nyear => in%pmon_nyear
425  if (associated(in%nmon_nyear )) out%nmon_nyear => in%nmon_nyear
426  if (associated(in%nmon_pyear )) out%nmon_pyear => in%nmon_pyear
427  if (associated(in%indexm )) out%indexm => in%indexm
428  if (associated(in%indexp )) out%indexp => in%indexp
429  if (associated(in%climatology )) out%climatology => in%climatology
430  if (associated(in%clim_times )) out%clim_times => in%clim_times
431  out%separate_time_vary_calc = in%separate_time_vary_calc
432  out%tweight = in%tweight
433  out%tweight1 = in%tweight1
434  out%tweight2 = in%tweight2
435  out%tweight3 = in%tweight3
436  out%itaum = in%itaum
437  out%itaup = in%itaup
438 
439 
440 
441 end subroutine interpolate_type_eq
442 
443 
444 
445 
446 !#######################################################################
447 !
448 !---------------------------------------------------------------------
449 !> \brief interpolator_init receives various data as input in order
450 !! to initialize interpolating.
451 !!
452 !! \param [inout] <clim_type> An interpolate type containing the necessary file and field
453 !! data to be passed to the interpolator routine
454 !! \param [in] <file_name> Climatology filename
455 !! \param [in] <lonb_mod> The corners of the model grid-box longitudes
456 !! \param [in] <latb_mod> The corners of the model grid_box latitudes
457 !! \param [in] <data_names> OPTIONAL: A list of the names of components within the climatology
458 !! file which you wish to read
459 !! \param [in] <data_out_of_bounds> A list of the flags that are to be used in determining
460 !! what to do if the pressure levels in the model go out of
461 !! bounds from those of the climatology
462 !! \param [in] <vert_interp> OPTIONAL: Flag to determine type of vertical interpolation
463 !! \param [out] <clim_units> OPTIONAL: A list of the units for the components listed in data_names
464 !! \param [out] <single_year_file> OPTIONAL: No description
465 subroutine interpolator_init( clim_type, file_name, lonb_mod, latb_mod, &
466  data_names, data_out_of_bounds, &
467  vert_interp, clim_units, single_year_file)
468 type(interpolate_type), intent(inout) :: clim_type
469 character(len=*), intent(in) :: file_name
470 real , intent(in) :: lonb_mod(:,:), latb_mod(:,:)
471 character(len=*), intent(in) , optional :: data_names(:)
472 !++lwh
473 integer , intent(in) :: data_out_of_bounds(:)
474 integer , intent(in), optional :: vert_interp(:)
475 !--lwh
476 character(len=*), intent(out), optional :: clim_units(:)
477 logical, intent(out), optional :: single_year_file
478 !
479 ! INTENT IN
480 ! file_name :: Climatology filename
481 ! lonb_mod :: The corners of the model grid-box longitudes.
482 ! latb_mod :: The corners of the model grid_box latitudes.
483 ! data_names :: A list of the names of components within the climatology file which you wish to read.
484 ! data_out_of_bounds :: A list of the flags that are to be used in determining what to do if the pressure levels in the model
485 ! go out of bounds from those of the climatology.
486 ! vert_interp:: Flag to determine type of vertical interpolation
487 !
488 ! INTENT OUT
489 ! clim_type :: An interpolate type containing the necessary file and field data to be passed to the interpolator routine.
490 ! clim_units :: A list of the units for the components listed in data_names.
491 !
492 
493 integer :: unit
494 character(len=64) :: src_file
495 !++lwh
496 real :: dlat, dlon
497 !--lwh
498 type(time_type) :: base_time
499 logical :: name_present
500 real :: dtr,tpi
501 integer :: fileday, filemon, fileyr, filehr, filemin,filesec, m,m1
502 character(len= 20) :: fileunits
503 real, dimension(:), allocatable :: alpha
504 integer :: j, i
505 logical :: non_monthly
506 character(len=24) :: file_calendar
507 character(len=256) :: error_mesg
508 integer :: model_calendar
509 integer :: yr, mo, dy, hr, mn, sc
510 integer :: n
511 type(time_type) :: julian_time, noleap_time
512 real, allocatable :: time_in(:)
513 real, allocatable, save :: agrid_mod(:,:,:)
514 integer :: nx, ny
515 integer :: io, ierr
516 
517 if (.not. module_is_initialized) then
518  call fms_init
519  call diag_manager_init
520  call horiz_interp_init
521 
522 !--------------------------------------------------------------------
523 ! namelist input
524 !--------------------------------------------------------------------
525 
526  if(file_exist('input.nml')) then
527 #ifdef INTERNAL_FILE_NML
528  read (input_nml_file, nml=interpolator_nml, iostat=io)
529  ierr = check_nml_error(io,'interpolator_nml')
530 #else
531  unit = open_namelist_file('input.nml')
532  ierr=1; do while (ierr /= 0)
533  read(unit, nml = interpolator_nml, iostat=io, end=10)
534  ierr = check_nml_error(io, 'interpolator_nml')
535  end do
536 10 call close_file(unit)
537 #endif
538  end if
539 
540 endif
541 
542 clim_type%separate_time_vary_calc = .false.
543 
544 tpi = 2.0*pi ! 4.*acos(0.)
545 dtr = tpi/360.
546 
547 num_fields = 0
548 
549 !--------------------------------------------------------------------
550 ! open source file containing fields to be interpolated
551 !--------------------------------------------------------------------
552 src_file = 'INPUT/'//trim(file_name)
553 
554 if(file_exist(trim(src_file))) then
555  call mpp_open( unit, trim(src_file), action=mpp_rdonly, &
556  form=mpp_netcdf, threading=mpp_multi, fileset=mpp_single )
557 else
558 !Climatology file doesn't exist, so exit
559  call mpp_error(fatal,'Interpolator_init : Data file '//trim(src_file)//' does not exist')
560 endif
561 
562 !Find the number of variables (nvar) in this file
563 call mpp_get_info(unit, ndim, nvar, natt, ntime)
564 clim_type%unit = unit
565 clim_type%file_name = trim(file_name)
566 
568 if(present(data_names)) num_fields= size(data_names(:))
569 
570 ! -------------------------------------------------------------------
571 ! Allocate space for the number of axes in the data file.
572 ! -------------------------------------------------------------------
573 allocate(axes(ndim))
574 call mpp_get_axes(unit, axes, time_axis)
575 
576 nlon=0 ! Number of longitudes (center-points) in the climatology.
577 nlat=0 ! Number of latitudes (center-points) in the climatology.
578 nlev=0 ! Number of levels (center-points) in the climatology.
579 nlatb=0 ! Number of longitudes (boundaries) in the climatology.
580 nlonb=0 ! Number of latitudes (boundaries) in the climatology.
581 nlevh=0 ! Number of levels (boundaries) in the climatology.
582 
583 clim_type%level_type = 0 ! Default value
584 
585 !++lwh
586 ! -------------------------------------------------------------------
587 ! For 2-D fields, set a default value of nlev=nlevh=1
588 ! -------------------------------------------------------------------
589 nlev = 1
590 nlevh = 1
591 !--lwh
592  clim_type%vertical_indices = 0 ! initial value
593 
594 do i = 1, ndim
596  calendar=file_calendar, sense=sense)
597  select case(name)
598  case('lat')
599  nlat=len
600  allocate(clim_type%lat(nlat))
601  call mpp_get_axis_data(axes(i),clim_type%lat)
602  select case(units(1:6))
603  case('degree')
604  clim_type%lat = clim_type%lat*dtr
605  case('radian')
606  case default
607  call mpp_error(fatal, "interpolator_init : Units for lat not recognised in file "//file_name)
608  end select
609  case('lon')
610  nlon=len
611  allocate(clim_type%lon(nlon))
612  call mpp_get_axis_data(axes(i),clim_type%lon)
613  select case(units(1:6))
614  case('degree')
615  clim_type%lon = clim_type%lon*dtr
616  case('radian')
617  case default
618  call mpp_error(fatal, "interpolator_init : Units for lon not recognised in file "//file_name)
619  end select
620  case('latb')
621  nlatb=len
622  allocate(clim_type%latb(nlatb))
623  call mpp_get_axis_data(axes(i),clim_type%latb)
624  select case(units(1:6))
625  case('degree')
626  clim_type%latb = clim_type%latb*dtr
627  case('radian')
628  case default
629  call mpp_error(fatal, "interpolator_init : Units for latb not recognised in file "//file_name)
630  end select
631  case('lonb')
632  nlonb=len
633  allocate(clim_type%lonb(nlonb))
634  call mpp_get_axis_data(axes(i),clim_type%lonb)
635  select case(units(1:6))
636  case('degree')
637  clim_type%lonb = clim_type%lonb*dtr
638  case('radian')
639  case default
640  call mpp_error(fatal, "interpolator_init : Units for lonb not recognised in file "//file_name)
641  end select
642  case('pfull')
643  nlev=len
644  allocate(clim_type%levs(nlev))
645  call mpp_get_axis_data(axes(i),clim_type%levs)
646  clim_type%level_type = pressure
647  ! Convert to Pa
648  if( trim(adjustl(lowercase(chomp(units)))) == "mb" .or. trim(adjustl(lowercase(chomp(units)))) == "hpa") then
649  clim_type%levs = clim_type%levs * 100.
650  end if
651 ! define the direction of the vertical data axis
652 ! switch index order if necessary so that indx 1 is at lowest pressure,
653 ! index nlev at highest pressure.
654  if( sense == 1 ) then
655  clim_type%vertical_indices = increasing_upward
656  allocate (alpha(nlev))
657  do n = 1, nlev
658  alpha(n) = clim_type%levs(nlev-n+1)
659  end do
660  do n = 1, nlev
661  clim_type%levs(n) = alpha(n)
662  end do
663  deallocate (alpha)
664  else
665  clim_type%vertical_indices = increasing_downward
666  endif
667 
668  case('phalf')
669  nlevh=len
670  allocate(clim_type%halflevs(nlevh))
671  call mpp_get_axis_data(axes(i),clim_type%halflevs)
672  clim_type%level_type = pressure
673  ! Convert to Pa
674  if( trim(adjustl(lowercase(chomp(units)))) == "mb" .or. trim(adjustl(lowercase(chomp(units)))) == "hpa") then
675  clim_type%halflevs = clim_type%halflevs * 100.
676  end if
677 ! define the direction of the vertical data axis
678 ! switch index order if necessary so that indx 1 is at lowest pressure,
679 ! index nlev at highest pressure.
680  if( sense == 1 ) then
681  clim_type%vertical_indices = increasing_upward
682  allocate (alpha(nlevh))
683  do n = 1, nlevh
684  alpha(n) = clim_type%halflevs(nlevh-n+1)
685  end do
686  do n = 1, nlevh
687  clim_type%halflevs(n) = alpha(n)
688  end do
689  deallocate (alpha)
690  else
691  clim_type%vertical_indices = increasing_downward
692  endif
693  case('sigma_full')
694  nlev=len
695  allocate(clim_type%levs(nlev))
696  call mpp_get_axis_data(axes(i),clim_type%levs)
697  clim_type%level_type = sigma
698  case('sigma_half')
699  nlevh=len
700  allocate(clim_type%halflevs(nlevh))
701  call mpp_get_axis_data(axes(i),clim_type%halflevs)
702  clim_type%level_type = sigma
703 
704  case('time')
705  model_calendar = get_calendar_type()
706  fileday = 0
707  filemon = 0
708  fileyr = 0
709  filehr = 0
710  filemin= 0
711  filesec = 0
712  select case(units(:3))
713  case('day')
714  fileunits = units(12:) !Assuming "days since YYYY-MM-DD HH:MM:SS"
715  if ( len_trim(fileunits) < 19 ) then
716  write(error_mesg, '(A49,A,A49,A)' ) &
717  'Interpolator_init : Incorrect time units in file ', &
718  trim(file_name), '. Expecting days since YYYY-MM-DD HH:MM:SS, found', &
719  trim(units)
720  call mpp_error(fatal,error_mesg)
721  endif
722  read(fileunits(1:4) , *) fileyr
723  read(fileunits(6:7) , *) filemon
724  read(fileunits(9:10) , *) fileday
725  read(fileunits(12:13), *) filehr
726  read(fileunits(15:16), *) filemin
727  read(fileunits(18:19), *) filesec
728  case('mon')
729  fileunits = units(14:) !Assuming "months since YYYY-MM-DD HH:MM:SS"
730  if ( len_trim(fileunits) < 19 ) then
731  write(error_mesg, '(A49,A,A51,A)' ) &
732  'Interpolator_init : Incorrect time units in file ', &
733  trim(file_name), '. Expecting months since YYYY-MM-DD HH:MM:SS, found', &
734  trim(units)
735  call mpp_error(fatal,error_mesg)
736  endif
737  read(fileunits(1:4) , *) fileyr
738  read(fileunits(6:7) , *) filemon
739  read(fileunits(9:10) , *) fileday
740  read(fileunits(12:13), *) filehr
741  read(fileunits(15:16), *) filemin
742  read(fileunits(18:19), *) filesec
743  case default
744  call mpp_error(fatal,'Interpolator_init : Time units not recognised in file '//file_name)
745  end select
746 
747  clim_type%climatological_year = (fileyr == 0)
748 
749  if (.not. clim_type%climatological_year) then
750 
751 !----------------------------------------------------------------------
752 ! if file date has a non-zero year in the base time, determine that
753 ! base_time based on the netcdf info.
754 !----------------------------------------------------------------------
755  if ( (model_calendar == julian .and. &
756  & trim(adjustl(lowercase(file_calendar))) == 'julian') .or. &
757  & (model_calendar == noleap .and. &
758  & trim(adjustl(lowercase(file_calendar))) == 'noleap') ) then
759  call mpp_error (note, 'interpolator_mod: Model and file&
760  & calendars are the same for file ' // &
761  & trim(file_name) // '; no calendar conversion &
762  &needed')
763  base_time = set_date(fileyr, filemon, fileday, filehr, &
764  filemin,filesec)
765  else if ( (model_calendar == julian .and. &
766  & trim(adjustl(lowercase(file_calendar))) == 'noleap')) then
767  call mpp_error (note, 'interpolator_mod: Using julian &
768  &model calendar and noleap file calendar&
769  & for file ' // trim(file_name) // &
770  &'; calendar conversion needed')
771  base_time = set_date_no_leap(fileyr, filemon, fileday, &
772  & filehr, filemin, filesec)
773  else if ( (model_calendar == noleap .and. &
774  & trim(adjustl(lowercase(file_calendar))) == 'julian')) then
775  call mpp_error (note, 'interpolator_mod: Using noleap &
776  &model calendar and julian file calendar&
777  & for file ' // trim(file_name) // &
778  &'; calendar conversion needed')
779  base_time = set_date_julian(fileyr, filemon, fileday, &
780  & filehr, filemin, filesec)
781  else
782  call mpp_error (fatal , 'interpolator_mod: Model and file&
783  & calendars ( ' // trim(file_calendar) // ' ) differ &
784  &for file ' // trim(file_name) // '; this calendar &
785  &conversion not currently available')
786  endif
787 
788  else
789 
790 !! if the year is specified as '0000', then the file is intended to
791 !! apply to all years -- the time variables within the file refer to
792 !! the displacement from the start of each year to the time of the
793 !! associated data. Time interpolation is to be done with interface
794 !! time_interp_list, with the optional argument modtime=YEAR. base_time
795 !! is set to an arbitrary value here; it's only use will be as a
796 !! timestamp for optionally generated diagnostics.
797 
798  base_time = get_base_time()
799  endif
800 
801 
802  ntime_in = 1
803  if (ntime > 0) then
804  allocate(time_in(ntime), clim_type%time_slice(ntime))
805  allocate(clim_type%clim_times(12,(ntime+11)/12))
806  time_in = 0.0
807  clim_type%time_slice = set_time(0,0) + base_time
808  clim_type%clim_times = set_time(0,0) + base_time
809  call mpp_get_times(clim_type%unit, time_in)
810  ntime_in = ntime
811 ! determine whether the data is a continuous set of monthly values or
812 ! a series of annual cycles spread throughout the period of data
813  non_monthly = .false.
814  do n = 1, ntime-1
815 ! Assume that the times in the data file correspond to days only.
816  if (time_in(n+1) > (time_in(n) + 32.)) then
817  non_monthly = .true.
818  exit
819  endif
820  end do
821  if (clim_type%climatological_year) then
822  call mpp_error (note, 'interpolator_mod :' // &
823  trim(file_name) // ' is a year-independent climatology file')
824  else
825  call mpp_error (note, 'interpolator_mod :' // &
826  trim(file_name) // ' is a timeseries file')
827  endif
828 
829  do n = 1, ntime
830 !Assume that the times in the data file correspond to days only.
831 
832 
833  if (clim_type%climatological_year) then
834 !! RSH NOTE:
835 !! for this case, do not add base_time. time_slice will be sent to
836 !! time_interp_list with the optional argument modtime=YEAR, so that
837 !! the time that is needed in time_slice is the displacement into the
838 !! year, not the displacement from a base_time.
839  clim_type%time_slice(n) = &
840  set_time(int( ( time_in(n) - int(time_in(n)) ) * seconds_per_day ), &
841  int(time_in(n)))
842  else
843 
844 !--------------------------------------------------------------------
845 ! if fileyr /= 0 (i.e., climatological_year=F),
846 ! then define the times associated with each time-
847 ! slice. if calendar conversion between data file and model calendar
848 ! is needed, do it so that data from the file is associated with the
849 ! same calendar time in the model. here the time_slice needs to
850 ! include the base_time; values will be generated relative to the
851 ! "real" time.
852 !--------------------------------------------------------------------
853  if ( (model_calendar == julian .and. &
854  & trim(adjustl(lowercase(file_calendar))) == 'julian') .or. &
855  & (model_calendar == noleap .and. &
856  & trim(adjustl(lowercase(file_calendar))) == 'noleap') ) then
857 
858 !---------------------------------------------------------------------
859 ! no calendar conversion needed.
860 !---------------------------------------------------------------------
861  clim_type%time_slice(n) = &
862  set_time(int( ( time_in(n) - int(time_in(n)) ) * seconds_per_day ),&
863  int(time_in(n))) &
864  + base_time
865 
866 !---------------------------------------------------------------------
867 ! convert file times from noleap to julian.
868 !---------------------------------------------------------------------
869  else if ( (model_calendar == julian .and. &
870  & trim(adjustl(lowercase(file_calendar))) == 'noleap')) then
871  noleap_time = set_time(0, int(time_in(n))) + base_time
872  call get_date_no_leap (noleap_time, yr, mo, dy, hr, &
873  mn, sc)
874  clim_type%time_slice(n) = set_date_julian(yr, mo, dy, &
875  hr, mn, sc)
876  if (n == 1) then
877  call print_date (clim_type%time_slice(1), &
878  str= 'for file ' // trim(file_name) // ', the &
879  &first time slice is mapped to :')
880  endif
881  if (n == ntime) then
882  call print_date (clim_type%time_slice(ntime), &
883  str= 'for file ' // trim(file_name) // ', the &
884  &last time slice is mapped to:')
885  endif
886 
887 
888 !---------------------------------------------------------------------
889 ! convert file times from julian to noleap.
890 !---------------------------------------------------------------------
891  else if ( (model_calendar == noleap .and. &
892  & trim(adjustl(lowercase(file_calendar))) == 'julian')) then
893  julian_time = set_time(0, int(time_in(n))) + base_time
894  call get_date_julian (julian_time, yr, mo, dy, hr, mn, sc)
895  clim_type%time_slice(n) = set_date_no_leap(yr, mo, dy, &
896  hr, mn, sc)
897  if (n == 1) then
898  call print_date (clim_type%time_slice(1), &
899  str= 'for file ' // trim(file_name) // ', the &
900  &first time slice is mapped to :')
901  endif
902  if (n == ntime) then
903  call print_date (clim_type%time_slice(ntime), &
904  str= 'for file ' // trim(file_name) // ', the &
905  &last time slice is mapped to:')
906  endif
907 
908 !---------------------------------------------------------------------
909 ! any other calendar combinations would have caused a fatal error
910 ! above.
911 !---------------------------------------------------------------------
912  endif
913  endif
914 
915  m = (n-1)/12 +1 ; m1 = n- (m-1)*12
916  clim_type%clim_times(m1,m) = clim_type%time_slice(n)
917  enddo
918  else
919  allocate(time_in(1), clim_type%time_slice(1))
920  allocate(clim_type%clim_times(1,1))
921  time_in = 0.0
922  clim_type%time_slice = set_time(0,0) + base_time
923  clim_type%clim_times(1,1) = set_time(0,0) + base_time
924  endif
925  deallocate(time_in)
926  end select ! case(name)
927 enddo
928 
929 
930 ! -------------------------------------------------------------------
931 ! For 2-D fields, allocate levs and halflevs here
932 ! code is still needed for case when only halflevs are in data file.
933 ! -------------------------------------------------------------------
934  if( .not. associated(clim_type%levs) ) then
935  allocate( clim_type%levs(nlev) )
936  clim_type%levs = 0.0
937  endif
938  if( .not. associated(clim_type%halflevs) ) then
939  allocate( clim_type%halflevs(nlev+1) )
940  clim_type%halflevs(1) = 0.0
941  if (clim_type%level_type == pressure) then
942  clim_type%halflevs(nlev+1) = 1013.25* 100.0 ! MKS
943  else if (clim_type%level_type == sigma ) then
944  clim_type%halflevs(nlev+1) = 1.0
945  endif
946  do n=2,nlev
947  clim_type%halflevs(n) = 0.5*(clim_type%levs(n) + &
948  clim_type%levs(n-1))
949  end do
950  endif
951 deallocate(axes)
952 
953 
954 ! In the case where only the midpoints of the longitudes are defined we force the definition
955 ! of the boundaries to be half-way between the midpoints.
956 if (.not. associated(clim_type%lon) .and. .not. associated(clim_type%lonb)) &
957  call mpp_error(fatal,'Interpolator_init : There appears to be no longitude axis in file '//file_name)
958 
959 if (.not. associated(clim_type%lonb) ) then
960 
961  if (size(clim_type%lon(:)) /= 1) then
962  allocate(clim_type%lonb(size(clim_type%lon(:))+1))
963  dlon = (clim_type%lon(2)-clim_type%lon(1))/2.0
964  clim_type%lonb(1) = clim_type%lon(1) - dlon
965  clim_type%lonb(2:) = clim_type%lon(1:) + dlon
966  else
967 
968 !! this is the case for zonal mean data, lon = 1, lonb not present
969 !! in file.
970 
971  allocate(clim_type%lonb(2))
972  clim_type%lonb(1) = -360.*dtr
973  clim_type%lonb(2) = 360.0*dtr
974  clim_type%lon(1) = 0.0
975  endif
976 endif
977 
978 !clim_type%lonb=clim_type%lonb*dtr
979 ! This assumes the lonb are in degrees in the NetCDF file!
980 
981 if (.not. associated(clim_type%lat) .and. .not. associated(clim_type%latb)) &
982  call mpp_error(fatal,'Interpolator_init : There appears to be no latitude axis in file '//file_name)
983 ! In the case where only the grid midpoints of the latitudes are defined we force the
984 ! definition of the boundaries to be half-way between the midpoints.
985 if (.not. associated(clim_type%latb) ) then
986  allocate(clim_type%latb(nlat+1))
987  dlat = (clim_type%lat(2)-clim_type%lat(1)) * 0.5
988 ! clim_type%latb(1) = min( 90., max(-90., clim_type%lat(1) - dlat) )
989  clim_type%latb(1) = min( pi/2., max(-pi/2., clim_type%lat(1) - dlat) )
990  clim_type%latb(2:nlat) = ( clim_type%lat(1:nlat-1) + clim_type%lat(2:nlat) ) * 0.5
991  dlat = ( clim_type%lat(nlat) - clim_type%lat(nlat-1) ) * 0.5
992 ! clim_type%latb(nlat+1) = min( 90., max(-90., clim_type%lat(nlat) + dlat) )
993  clim_type%latb(nlat+1) = min( pi/2., max(-pi/2., clim_type%lat(nlat) + dlat) )
994 endif
995 !clim_type%latb=clim_type%latb*dtr
996 
997 !Assume that the horizontal interpolation within a file is the same for each variable.
998 
999  if (conservative_interp) then
1000  call horiz_interp_new (clim_type%interph, &
1001  clim_type%lonb, clim_type%latb, &
1002  lonb_mod, latb_mod)
1003  else
1004 
1005  call mpp_error(note, "Using Bilinear interpolation")
1006 
1007  !!! DEBUG CODE
1008  if (.not. allocated(agrid_mod)) then
1009  nx = size(lonb_mod,1)-1
1010  ny = size(latb_mod,2)-1
1011  allocate(agrid_mod(nx,ny,2))
1012  do j=1,ny
1013  do i=1,nx
1014  call cell_center2((/lonb_mod(i,j),latb_mod(i,j)/), &
1015  (/lonb_mod(i+1,j),latb_mod(i+1,j)/), &
1016  (/lonb_mod(i,j+1),latb_mod(i,j+1)/), &
1017  (/lonb_mod(i+1,j+1),latb_mod(i+1,j+1)/), agrid_mod(i,j,:))
1018  enddo
1019  enddo
1020  endif
1021 
1022  !!! END DEBUG CODE
1023 
1024  call horiz_interp_new (clim_type%interph, &
1025  clim_type%lonb, clim_type%latb, &
1026  agrid_mod(:,:,1), agrid_mod(:,:,2), interp_method="bilinear")
1027  endif
1028 
1029 !--------------------------------------------------------------------
1030 ! allocate the variable clim_type%data . This will be the climatology
1031 ! data horizontally interpolated, so it will be on the model horizontal
1032 ! grid, but it will still be on the climatology vertical grid.
1033 !--------------------------------------------------------------------
1034 
1035 select case(ntime)
1036  case (13:)
1037 ! This may be data that does not have a continous time-line
1038 ! i.e. IPCC data where decadal data is present but we wish to retain
1039 ! the seasonal nature of the data.
1040 !! RSH: the following test will not always work; instead use the
1041 !! RSH: non-monthly variable to test on.
1042 !RSHlast_time = clim_type%time_slice(1) + ( ntime -1 ) * &
1043 !RSH ( clim_type%time_slice(2) - clim_type%time_slice(1) )
1044 
1045 !RSHif ( last_time < clim_type%time_slice(ntime)) then
1046 
1047  if (non_monthly) then
1048 ! We have a broken time-line. e.g. We have monthly data but only for years ending in 0. 1960,1970 etc.
1049 ! allocate(clim_type%data(size(lonb_mod(:))-1, size(latb_mod(:))-1, nlev, 2, num_fields))
1050  allocate(clim_type%pmon_pyear(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, num_fields))
1051  allocate(clim_type%pmon_nyear(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, num_fields))
1052  allocate(clim_type%nmon_nyear(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, num_fields))
1053  allocate(clim_type%nmon_pyear(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, num_fields))
1054  clim_type%pmon_pyear = 0.0
1055  clim_type%pmon_nyear = 0.0
1056  clim_type%nmon_nyear = 0.0
1057  clim_type%nmon_pyear = 0.0
1058  clim_type%TIME_FLAG = bilinear
1059 else
1060 ! We have a continuous time-line so treat as for 5-12 timelevels as below.
1061  if ( .not. read_all_on_init) then
1062  allocate(clim_type%data(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, 2, num_fields))
1063  else
1064  allocate(clim_type%data(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, &
1065  ntime, num_fields))
1066  endif
1067  clim_type%data = 0.0
1068  clim_type%TIME_FLAG = linear
1069 endif
1070 
1071 
1072 !++lwh
1073  case (1:12)
1074 !--lwh
1075 ! We have more than 4 timelevels
1076 ! Assume we have monthly or higher time resolution datasets (climatology or time series)
1077 ! So we only need to read 2 datasets and apply linear temporal interpolation.
1078  if ( .not. read_all_on_init) then
1079  allocate(clim_type%data(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, 2, num_fields))
1080  else
1081  allocate(clim_type%data(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, &
1082  ntime, num_fields))
1083  endif
1084  clim_type%data = 0.0
1085  clim_type%TIME_FLAG = linear
1086 !++lwh
1087 !case (1:4)
1088 ! Assume we have seasonal data and read in all the data.
1089 ! We can apply sine curves to these data.
1090 
1091 ! allocate(clim_type%data(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, ntime, num_fields))
1092 ! clim_type%data = 0.0
1093 ! clim_type%TIME_FLAG = SEASONAL
1094 !--lwh
1095 ! case (default)
1096  case(:0)
1097  clim_type%TIME_FLAG = notime
1098  allocate(clim_type%data(size(lonb_mod,1)-1, size(latb_mod,2)-1, nlev, 1, num_fields))
1099 end select
1100 
1101 
1102 !------------------------------------------------------------------
1103 ! Allocate space for the single time level of the climatology on its
1104 ! grid size.
1105 !----------------------------------------------------------------------
1106 
1107  if(clim_type%TIME_FLAG .eq. linear ) then
1108  allocate(clim_type%time_init(num_fields,2))
1109  else
1110  allocate(clim_type%time_init(num_fields,ntime))
1111  endif
1112  allocate (clim_type%indexm(num_fields), &
1113  clim_type%indexp(num_fields), &
1114  clim_type%climatology(num_fields))
1115  clim_type%time_init(:,:) = 0
1116  clim_type%indexm(:) = 0
1117  clim_type%indexp(:) = 0
1118  clim_type%climatology(:) = 0
1119 
1120 
1121 allocate(clim_type%field_name(num_fields))
1122 allocate(clim_type%field_type(num_fields))
1123 allocate(clim_type%mr(num_fields))
1124 allocate(clim_type%out_of_bounds(num_fields))
1125 clim_type%out_of_bounds(:)=0
1126 allocate(clim_type%vert_interp(num_fields))
1127 clim_type%vert_interp(:)=0
1128 !--------------------------------------------------------------------
1129 !Allocate the space for the fields within the climatology data file.
1130 allocate(varfields(nvar))
1131 !--------------------------------------------------------------------
1132 ! Get the variable names out of the file.
1133 call mpp_get_fields(clim_type%unit, varfields)
1134 
1135 if(present(data_names)) then
1136 
1137 !++lwh
1138  if ( size(data_out_of_bounds(:)) /= size(data_names(:)) .and. size(data_out_of_bounds(:)) /= 1 ) &
1139  call mpp_error(fatal,'interpolator_init : The size of the data_out_of_bounds array must be 1&
1140  & or size(data_names)')
1141  if (present(vert_interp)) then
1142  if( size(vert_interp(:)) /= size(data_names(:)) .and. size(vert_interp(:)) /= 1 ) &
1143  call mpp_error(fatal,'interpolator_init : The size of the vert_interp array must be 1&
1144  & or size(data_names)')
1145  endif
1146 ! Only read the fields named in data_names
1147  do j=1,size(data_names(:))
1148  name_present = .false.
1149  do i=1,nvar
1151  if( trim(adjustl(lowercase(name))) == trim(adjustl(lowercase(data_names(j)))) ) then
1152  units=chomp(units)
1153  if (mpp_pe() == 0 ) write(*,*) 'Initializing src field : ',trim(name)
1154  clim_type%field_name(j) = name
1155  clim_type%field_type(j) = varfields(i)
1156  clim_type%mr(j) = check_climo_units(units)
1157  name_present = .true.
1158  if (present(clim_units)) clim_units(j) = units
1159  clim_type%out_of_bounds(j) = data_out_of_bounds( min(j,SIZE(data_out_of_bounds(:))) )
1160  if( clim_type%out_of_bounds(j) /= constant .and. &
1161  clim_type%out_of_bounds(j) /= zero ) &
1162  call mpp_error(fatal,"Interpolator_init: data_out_of_bounds must be&
1163  & set to ZERO or CONSTANT")
1164  if( present(vert_interp) ) then
1165  clim_type%vert_interp(j) = vert_interp( min(j,SIZE(vert_interp(:))) )
1166  if( clim_type%vert_interp(j) /= interp_weighted_p .and. &
1167  clim_type%vert_interp(j) /= interp_linear_p ) &
1168  call mpp_error(fatal,"Interpolator_init: vert_interp must be&
1169  & set to INTERP_WEIGHTED_P or INTERP_LINEAR_P")
1170  else
1171  clim_type%vert_interp(j) = interp_weighted_p
1172  end if
1173  endif
1174  enddo
1175  if(.not. name_present) &
1176  call mpp_error(fatal,'interpolator_init : Check names of fields being passed. ' &
1177  //trim(data_names(j))//' does not exist.')
1178  enddo
1179 else
1180 
1181  if ( size(data_out_of_bounds(:)) /= nvar .and. size(data_out_of_bounds(:)) /= 1 ) &
1182  call mpp_error(fatal,'interpolator_init : The size of the out of bounds array must be 1&
1183  & or the number of fields in the climatology dataset')
1184  if ( present(vert_interp) ) then
1185  if (size(vert_interp(:)) /= nvar .and. size(vert_interp(:)) /= 1 ) &
1186  call mpp_error(fatal,'interpolator_init : The size of the vert_interp array must be 1&
1187  & or the number of fields in the climatology dataset')
1188  endif
1189 
1190 ! Read all the fields within the climatology data file.
1191  do i=1,nvar
1193  if (mpp_pe() ==0 ) write(*,*) 'Initializing src field : ',trim(name)
1194  clim_type%field_name(i) = lowercase(trim(name))
1195  clim_type%field_type(i) = varfields(i)
1196  clim_type%mr(i) = check_climo_units(units)
1197  if (present(clim_units)) clim_units(i) = units
1198  clim_type%out_of_bounds(i) = data_out_of_bounds( min(i,SIZE(data_out_of_bounds(:))) )
1199  if( clim_type%out_of_bounds(i) /= constant .and. &
1200  clim_type%out_of_bounds(i) /= zero ) &
1201  call mpp_error(fatal,"Interpolator_init: data_out_of_bounds must be&
1202  & set to ZERO or CONSTANT")
1203  if( present(vert_interp) ) then
1204  clim_type%vert_interp(i) = vert_interp( min(i,SIZE(vert_interp(:))) )
1205  if( clim_type%vert_interp(i) /= interp_weighted_p .and. &
1206  clim_type%vert_interp(i) /= interp_linear_p ) &
1207  call mpp_error(fatal,"Interpolator_init: vert_interp must be&
1208  & set to INTERP_WEIGHTED_P or INTERP_LINEAR_P")
1209  else
1210  clim_type%vert_interp(i) = interp_weighted_p
1211  end if
1212  end do
1213 !--lwh
1214 endif
1215 
1216 deallocate(varfields)
1217 
1218 
1219 if( clim_type%TIME_FLAG .eq. seasonal ) then
1220 ! Read all the data at this point.
1221  do i=1,num_fields
1222  do n = 1, ntime
1223  call read_data( clim_type, clim_type%field_type(i), &
1224  clim_type%data(:,:,:,n,i), n, i, base_time )
1225  enddo
1226  enddo
1227 endif
1228 
1229 if( clim_type%TIME_FLAG .eq. linear .and. read_all_on_init) then
1230 ! Read all the data at this point.
1231  do i=1,num_fields
1232  do n = 1, ntime
1233  call read_data( clim_type, clim_type%field_type(i), &
1234  clim_type%data(:,:,:,n,i), n, i, base_time )
1235  enddo
1236  enddo
1237 
1238  call mpp_close (unit)
1239 endif
1240 
1241 if( clim_type%TIME_FLAG .eq. notime ) then
1242 ! Read all the data at this point.
1243  do i=1,num_fields
1244  call read_data_no_time_axis( clim_type, clim_type%field_type(i), &
1245  clim_type%data(:,:,:,1,i), i )
1246  enddo
1247  call mpp_close (unit)
1248 endif
1249 
1250 if (present (single_year_file)) then
1251  single_year_file = clim_type%climatological_year
1252 endif
1253 
1254 module_is_initialized = .true.
1255 
1256 !---------------------------------------------------------------------
1257 ! write version number and namelist to logfile.
1258 !---------------------------------------------------------------------
1259 call write_version_number("INTERPOLATOR_MOD", version)
1260 
1261  if (mpp_pe() == mpp_root_pe() ) &
1262  write (stdlog(), nml=interpolator_nml)
1263 
1264 end subroutine interpolator_init
1265 !
1266 !---------------------------------------------------------------------
1267 !
1268 !> \brief cell_center2 receives the variables q1, q2, q3, and q4
1269 !! as inputs and returns e2.
1270 !!
1271 !! \param [in] <q1> No description
1272 !! \param [in] <q2> No description
1273 !! \param [in] <q3> No description
1274 !! \param [in] <q4> No description
1275 !! \param [out] <e2> No description
1276  subroutine cell_center2(q1, q2, q3, q4, e2)
1277  real , intent(in ) :: q1(2), q2(2), q3(2), q4(2)
1278  real , intent(out) :: e2(2)
1279 ! Local
1280  real p1(3), p2(3), p3(3), p4(3)
1281  real ec(3)
1282  real dd
1283  integer k
1284 
1285  call latlon2xyz(q1, p1)
1286  call latlon2xyz(q2, p2)
1287  call latlon2xyz(q3, p3)
1288  call latlon2xyz(q4, p4)
1289 
1290  do k=1,3
1291  ec(k) = p1(k) + p2(k) + p3(k) + p4(k)
1292  enddo
1293  dd = sqrt( ec(1)**2 + ec(2)**2 + ec(3)**2 )
1294 
1295  do k=1,3
1296  ec(k) = ec(k) / dd
1297  enddo
1298 
1299  call cart_to_latlon(1, ec, e2(1), e2(2))
1300 
1301  end subroutine cell_center2
1302 !
1303 !---------------------------------------------------------------------
1304 !> \brief car_to_latlon receives the variables np, q, xs, and ys
1305 !! as inputs and returns q, xs, and ys.
1306 !!
1307 !! \param [in] <np> No description
1308 !! \param [inout] <q> No description
1309 !! \param [inout] <xs> No description
1310 !! \param [inout] <ys> No description
1311  subroutine cart_to_latlon(np, q, xs, ys)
1312 ! vector version of cart_to_latlon1
1313  integer, intent(in):: np
1314  real, intent(inout):: q(3,np)
1315  real, intent(inout):: xs(np), ys(np)
1316 ! local
1317  real, parameter:: esl=1.e-10
1318  real (f_p):: p(3)
1319  real (f_p):: dist, lat, lon
1320  integer i,k
1321 
1322  do i=1,np
1323  do k=1,3
1324  p(k) = q(k,i)
1325  enddo
1326  dist = sqrt(p(1)**2 + p(2)**2 + p(3)**2)
1327  do k=1,3
1328  p(k) = p(k) / dist
1329  enddo
1330 
1331  if ( (abs(p(1))+abs(p(2))) < esl ) then
1332  lon = 0.
1333  else
1334  lon = atan2( p(2), p(1) ) ! range [-pi,pi]
1335  endif
1336 
1337  if ( lon < 0.) lon = 2.*pi + lon
1338  lat = asin(p(3))
1339 
1340  xs(i) = lon
1341  ys(i) = lat
1342 ! q Normalized:
1343  do k=1,3
1344  q(k,i) = p(k)
1345  enddo
1346  enddo
1347 
1348  end subroutine cart_to_latlon
1349 !
1350 !---------------------------------------------------------------------
1351 !> \brief latlon2xyz receives the variable p as input and returns e
1352 !! as output in order to map (lon, lat) to (x,y,z).
1353 !!
1354 !! \param [in] <p> No description
1355 !! \param [out] <e> No description
1356  subroutine latlon2xyz(p, e)
1358 ! Routine to map (lon, lat) to (x,y,z)
1359 !
1360  real, intent(in) :: p(2)
1361  real, intent(out):: e(3)
1362 
1363  integer n
1364  real (f_p):: q(2)
1365  real (f_p):: e1, e2, e3
1366 
1367  do n=1,2
1368  q(n) = p(n)
1369  enddo
1370 
1371  e1 = cos(q(2)) * cos(q(1))
1372  e2 = cos(q(2)) * sin(q(1))
1373  e3 = sin(q(2))
1374 !-----------------------------------
1375 ! Truncate to the desired precision:
1376 !-----------------------------------
1377  e(1) = e1
1378  e(2) = e2
1379  e(3) = e3
1380 
1381  end subroutine latlon2xyz
1382 
1383 !
1384 !#######################################################################
1385 !
1386 !---------------------------------------------------------------------
1387 !> \brief check_climo_units checks the units that the climatology
1388 !! data is using. This is needed to allow for conversion of
1389 !! datasets to mixing ratios which is what the vertical
1390 !! interpolation scheme requires. The default is to assume no
1391 !! conversion is needed. If the units are those of a column
1392 !! burden (kg/m2) then conversion to mixing ratio is flagged.
1393 !!
1394 !! \param [in] <units> The units which you will be checking
1395 function check_climo_units(units)
1396 ! Function to check the units that the climatology data is using.
1397 ! This is needed to allow for conversion of datasets to mixing ratios which is what the
1398 ! vertical interpolation scheme requires
1399 ! The default is to assume no conversion is needed.
1400 ! If the units are those of a column burden (kg/m2) then conversion to mixing ratio is flagged.
1401 !
1402 character(len=*), intent(in) :: units
1403 
1404 integer :: check_climo_units
1405 
1407 select case(chomp(units))
1408  case('kg/m2', 'kg/m^2', 'kg/m**2', 'kg m^-2', 'kg m**-2')
1410  case('molecules/cm2/s', 'molecule/cm2/s', 'molec/cm2/s')
1412  case('kg/m2/s')
1414 end select
1415 
1416 end function check_climo_units
1417 !
1418 !#######################################################################
1419 !
1420 !---------------------------------------------------------------------
1421 !> \brief init_clim_diag is a routine to register diagnostic fields
1422 !! for the climatology file. This routine calculates the domain
1423 !! decompostion of the climatology fields for later export
1424 !! through send_data. The ids created here are for column
1425 !! burdens that will diagnose the vertical interpolation
1426 !! routine.
1427 !!
1428 !! \param [inout] <clim_type> The interpolate type containing the
1429 !! names of the fields in the climatology file
1430 !! \param [in] <mod_axes> The axes of the model
1431 !! \param [in] <init_time> The model initialization time
1432 !!
1433 !! \throw FATAL, "init_clim_diag : You must call interpolator_init before calling init_clim_diag"
1434 !! \throw FATAL, "init_clim_diag : Trying to set up too many diagnostic fields for the climatology data"
1435 subroutine init_clim_diag(clim_type, mod_axes, init_time)
1437 ! Routine to register diagnostic fields for the climatology file.
1438 ! This routine calculates the domain decompostion of the climatology fields
1439 ! for later export through send_data.
1440 ! The ids created here are for column burdens that will diagnose the vertical interpolation routine.
1441 ! climo_diag_id : 'module_name = climo' is intended for use with the model vertical resolution.
1442 ! hinterp_id : 'module_name = 'hinterp' is intended for use with the climatology vertical resolution.
1443 
1444 ! INTENT INOUT :
1445 ! clim_type : The interpolate type containing the names of the fields in the climatology file.
1446 !
1447 ! INTENT IN :
1448 ! mod_axes : The axes of the model.
1449 ! init_time : The model initialization time.
1450 !
1451 type(interpolate_type), intent(inout) :: clim_type
1452 integer , intent(in) :: mod_axes(:)
1453 type(time_type) , intent(in) :: init_time
1454 
1455 integer :: axes(2),nxd,nyd,ndivs,i
1456 type(domain2d) :: domain
1457 integer :: domain_layout(2), iscomp, iecomp,jscomp,jecomp
1458 
1459 
1460 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
1461  call mpp_error(fatal, "init_clim_diag : You must call interpolator_init before calling init_clim_diag")
1462 
1463 
1464 ndivs = mpp_npes()
1465 nxd = size(clim_type%lon(:))
1466 nyd = size(clim_type%lat(:))
1467 
1468 ! Define the domain decomposition of the climatology file. This may be (probably is) different from the model domain.
1469 call mpp_define_layout ((/1,nxd,1,nyd/), ndivs, domain_layout)
1470 call mpp_define_domains((/1,nxd,1,nyd/),domain_layout, domain,xhalo=0,yhalo=0)
1471 call mpp_get_compute_domain (domain, iscomp, iecomp, jscomp, jecomp)
1472  axes(1) = diag_axis_init(clim_type%file_name(1:5)//'x',clim_type%lon,units='degrees',cart_name='x',domain2=domain)
1473  axes(2) = diag_axis_init(clim_type%file_name(1:5)//'y',clim_type%lat,units='degrees',cart_name='y',domain2=domain)
1474 clim_type%is = iscomp
1475 clim_type%ie = iecomp
1476 clim_type%js = jscomp
1477 clim_type%je = jecomp
1478 
1479 !init_time = set_date(1980,1,1,0,0,0)
1480 
1481 if ((num_clim_diag + size(clim_type%field_name(:))) .gt. max_diag_fields ) &
1482  call mpp_error(fatal, "init_clim_diag : Trying to set up too many diagnostic fields for the climatology data")
1483 do i=1,size(clim_type%field_name(:))
1484 climo_diag_name(i+num_clim_diag) = clim_type%field_name(i)
1485 climo_diag_id(i+num_clim_diag) = register_diag_field('climo',clim_type%field_name(i),axes(1:2),init_time,&
1486  'climo_'//clim_type%field_name(i), 'kg/kg', missing_value)
1487 hinterp_id(i+num_clim_diag) = register_diag_field('hinterp',clim_type%field_name(i),mod_axes(1:2),init_time,&
1488  'interp_'//clim_type%field_name(i),'kg/kg' , missing_value)
1489 enddo
1490 ! Total number of climatology diagnostics (num_clim_diag). This can be from multiple climatology fields with different spatial axes.
1491 ! It is simply a holder for the diagnostic indices.
1492 num_clim_diag = num_clim_diag+size(clim_type%field_name(:))
1493 
1494 clim_diag_initialized = .true.
1495 
1496 end subroutine init_clim_diag
1497 
1498 
1499 
1500 !
1501 !---------------------------------------------------------------------
1502 !> \brief obtain_interpolator_time_slices makes sure that the
1503 !! appropriate time slices are available for interpolation on
1504 !! this time step.
1505 !!
1506 !! \param [inout] <clim_type> The interpolate type previously defined
1507 !! by a call to interpolator_init
1508 !! \param [in] <Time> The model time that you wish to interpolate to
1509 !!
1510 !! \throw FATAL "interpolator_timeslice 1: file="
1511 !! \throw FATAL "interpolator_timeslice 2: file="
1512 !! \throw FATAL "interpolator_timeslice 3: file="
1513 !! \throw FATAL "interpolator_timeslice 4: file="
1514 !! \throw FATAL "interpolator_timeslice 5: file="
1515 !! \throw FATAL "interpolator_timeslice : No data from the previous
1516 !! climatology time but we have the next time. How did
1517 !! this happen?"
1518 subroutine obtain_interpolator_time_slices (clim_type, Time)
1520 ! Makes sure that appropriate time slices are available for interpolation
1521 ! on this time step
1522 !
1523 ! INTENT INOUT
1524 ! clim_type : The interpolate type previously defined by a call to interpolator_init
1525 !
1526 ! INTENT IN
1527 ! Time : The model time that you wish to interpolate to.
1528 
1529 type(interpolate_type), intent(inout) :: clim_type
1530 type(time_type) , intent(in) :: time
1531 
1532 integer :: taum, taup
1533 integer :: modyear, modmonth, modday, modhour, modminute, modsecond
1534 integer :: climyear, climmonth, climday, climhour, climminute, climsecond
1535 integer :: year1, month1, day, hour, minute, second
1536 integer :: climatology, m
1537 type(time_type) :: t_prev, t_next
1538 type(time_type), dimension(2) :: month
1539 integer :: indexm, indexp, yearm, yearp
1540 integer :: i, n
1541 character(len=256) :: err_msg
1542 
1543  if (clim_type%climatological_year) then
1544  !++lwh
1545  if (size(clim_type%time_slice) > 1) then
1546  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, modtime=year, err_msg=err_msg )
1547  if(trim(err_msg) /= '') then
1548  call mpp_error(fatal,'interpolator_timeslice 1: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1549  endif
1550  else
1551  taum = 1
1552  taup = 1
1553  clim_type%tweight = 0.
1554  end if
1555  !--lwh
1556  else
1557  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, err_msg=err_msg )
1558  if(trim(err_msg) /= '') then
1559  call mpp_error(fatal,'interpolator_timeslice 2: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1560  endif
1561  endif
1562 
1563  if(clim_type%TIME_FLAG .eq. bilinear ) then
1564  ! Check if delta-time is greater than delta of first two climatology time-slices.
1565  if ( (time - clim_type%time_slice(taum) ) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) .or. &
1566  (clim_type%time_slice(taup) - time) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) ) then
1567  ! The difference between the model time and the last climatology time-slice previous to the model time.
1568  ! We need 2 time levels.
1569  clim_type%itaum=0
1570  clim_type%itaup=0
1571  ! Assume this is monthly data. So we need to get the data applicable to the model date but substitute
1572  ! the climatology year into the appropriate place.
1573 
1574 
1575  ! We need to get the previous months data for the climatology year before
1576  ! and after the model year.
1577  call get_date(time, modyear, modmonth, modday, modhour, modminute, modsecond)
1578  call get_date(clim_type%time_slice(taum), climyear, climmonth, climday, climhour, climminute, climsecond)
1579 
1580  climatology = 1
1581  do m = 1, size(clim_type%clim_times(:,:),2)
1582  !Assume here that a climatology is for 1 year and consists of 12 months starting in January.
1583  call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
1584  if (year1 == climyear) climatology = m
1585  enddo
1586  do m = 1,12
1587  !Find which month we are trying to look at and set clim_date[mp] to the dates spanning that.
1588  call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
1589  if ( month1 == modmonth ) then
1590 !RSHBUGFX if ( modday <= day ) then
1591  if ( modday < day ) then
1592  indexm = m-1 ; indexp = m
1593  else
1594  indexm = m ; indexp = m+1
1595  endif
1596  endif
1597 
1598  enddo
1599  if ( indexm == 0 ) then
1600  indexm = 12
1601  yearm = modyear - 1
1602  else
1603  yearm = modyear
1604  endif
1605  call get_date(clim_type%time_slice(indexm+(climatology-1)*12), &
1606  climyear, climmonth, climday, climhour, climminute, climsecond)
1607  month(1) = set_date(yearm, indexm, climday, climhour, climminute, climsecond)
1608  if ( indexp == 13 ) then
1609  indexp = 1
1610  yearp = modyear + 1
1611  else
1612  yearp = modyear
1613  endif
1614  call get_date(clim_type%time_slice(indexp+(climatology-1)*12), &
1615  climyear, climmonth, climday, climhour, climminute, climsecond)
1616  month(2) = set_date(yearp, indexp, climday, climhour, climminute, climsecond)
1617 
1618  call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg ) ! tweight3 is the time weight between the months.
1619  if ( .not. retain_cm3_bug ) then
1620  if (taum==2 .and. taup==2) clim_type%tweight3 = 1. ! protect against post-perth time_interp behavior
1621  end if
1622  if(trim(err_msg) /= '') then
1623  call mpp_error(fatal,'interpolator_timeslice 3: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1624  endif
1625 
1626  month(1) = clim_type%time_slice(indexm+(climatology-1)*12)
1627  month(2) = clim_type%time_slice(indexm+climatology*12)
1628  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
1629  t_prev = set_date(yearm, climmonth, climday, climhour, climminute, climsecond)
1630  call time_interp(t_prev, month, clim_type%tweight1, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
1631  if ( .not. retain_cm3_bug ) then
1632  if (taum==2 .and. taup==2) clim_type%tweight1 = 1. ! protect against post-perth time_interp behavior
1633  end if
1634  if(trim(err_msg) /= '') then
1635  call mpp_error(fatal,'interpolator_timeslice 4: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1636  endif
1637 
1638  month(1) = clim_type%time_slice(indexp+(climatology-1)*12)
1639  month(2) = clim_type%time_slice(indexp+climatology*12)
1640  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
1641  t_next = set_date(yearp, climmonth, climday, climhour, climminute, climsecond)
1642  call time_interp(t_next, month, clim_type%tweight2, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
1643  if ( .not. retain_cm3_bug ) then
1644  if (taum==2 .and. taup==2) clim_type%tweight2 = 1. ! protect against post-perth time_interp behavior
1645  end if
1646  if(trim(err_msg) /= '') then
1647  call mpp_error(fatal,'interpolator_timeslice 5: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1648  endif
1649 
1650  if (indexm == clim_type%indexm(1) .and. &
1651  indexp == clim_type%indexp(1) .and. &
1652  climatology == clim_type%climatology(1)) then
1653  else
1654  clim_type%indexm(:) = indexm
1655  clim_type%indexp(:) = indexp
1656  clim_type%climatology(:) = climatology
1657  do i=1, size(clim_type%field_name(:))
1658  call read_data(clim_type,clim_type%field_type(i), &
1659  clim_type%pmon_pyear(:,:,:,i), &
1660  clim_type%indexm(i)+(clim_type%climatology(i)-1)*12,i,time)
1661 ! Read the data for the next month in the previous climatology.
1662  call read_data(clim_type,clim_type%field_type(i), &
1663  clim_type%nmon_pyear(:,:,:,i), &
1664  clim_type%indexp(i)+(clim_type%climatology(i)-1)*12,i,time)
1665  call read_data(clim_type,clim_type%field_type(i), &
1666  clim_type%pmon_nyear(:,:,:,i), &
1667  clim_type%indexm(i)+clim_type%climatology(i)*12,i,time)
1668  call read_data(clim_type,clim_type%field_type(i), &
1669  clim_type%nmon_nyear(:,:,:,i), &
1670  clim_type%indexp(i)+clim_type%climatology(i)*12,i,time)
1671  end do
1672  endif
1673 
1674 
1675 
1676  else ! We are within a climatology data set
1677 
1678 
1679  do i=1, size(clim_type%field_name(:))
1680  if (taum /= clim_type%time_init(i,1) .or. &
1681  taup /= clim_type%time_init(i,2) ) then
1682 
1683 
1684  call read_data(clim_type,clim_type%field_type(i), &
1685  clim_type%pmon_pyear(:,:,:,i), taum,i,time)
1686 ! Read the data for the next month in the previous climatology.
1687  call read_data(clim_type,clim_type%field_type(i), &
1688  clim_type%nmon_pyear(:,:,:,i), taup,i,time)
1689  clim_type%time_init(i,1) = taum
1690  clim_type%time_init(i,2) = taup
1691  endif
1692  end do
1693 
1694 ! clim_type%pmon_nyear = 0.0
1695 ! clim_type%nmon_nyear = 0.0
1696 
1697 ! set to zero so when next return to bilinear section will be sure to
1698 ! have proper data (relevant when running fixed_year case for more than
1699 ! one year in a single job)
1700  clim_type%indexm(:) = 0
1701  clim_type%indexp(:) = 0
1702  clim_type%climatology(:) = 0
1703 
1704 
1705 ! clim_type%tweight3 = 0.0 ! This makes [pn]mon_nyear irrelevant. Set them to 0 to test.
1706  clim_type%tweight1 = 0.0
1707  clim_type%tweight2 = 0.0
1708  clim_type%tweight3 = clim_type%tweight
1709  endif
1710  endif !(BILINEAR)
1711 
1712  if(clim_type%TIME_FLAG .eq. linear .and. &
1713  (.not. read_all_on_init) ) then
1714 ! We need 2 time levels. Check we have the correct data.
1715  clim_type%itaum=0
1716  clim_type%itaup=0
1717  do n=1,size(clim_type%time_init,2)
1718  if (clim_type%time_init(1,n) .eq. taum ) clim_type%itaum = n
1719  if (clim_type%time_init(1,n) .eq. taup ) clim_type%itaup = n
1720  enddo
1721 
1722  if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0) then
1723 !Neither time is set so we need to read 2 time slices.
1724 !Set up
1725 ! field(:,:,:,1) as the previous time slice.
1726 ! field(:,:,:,2) as the next time slice.
1727  do i=1, size(clim_type%field_name(:))
1728  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,1,i), taum,i,time)
1729  clim_type%time_init(i,1) = taum
1730  clim_type%itaum = 1
1731  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,2,i), taup,i,time)
1732  clim_type%time_init(i,2) = taup
1733  clim_type%itaup = 2
1734  end do
1735  endif ! clim_type%itaum.eq.clim_type%itaup.eq.0
1736  if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0) then
1737 ! Can't think of a situation where we would have the next time level but not the previous.
1738  call mpp_error(fatal,'interpolator_timeslice : No data from the previous climatology time &
1739  & but we have the next time. How did this happen?')
1740  endif
1741  if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0) then
1742 !We have the previous time step but not the next time step data
1743  clim_type%itaup = 1
1744  if (clim_type%itaum .eq. 1 ) clim_type%itaup = 2
1745  do i=1, size(clim_type%field_name(:))
1746  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,clim_type%itaup,i), taup,i, time)
1747  clim_type%time_init(i,clim_type%itaup)=taup
1748  end do
1749  endif
1750 
1751 
1752  endif! TIME_FLAG
1753 
1754  clim_type%separate_time_vary_calc = .true.
1755 
1756 !-------------------------------------------------------------------
1757 
1758 
1759 end subroutine obtain_interpolator_time_slices
1760 
1761 
1762 !#####################################################################
1763 !
1764 !---------------------------------------------------------------------
1765 !> \brief unset_interpolator_time_flag sets a flag in clim_type to
1766 !! false.
1767 !!
1768 !! \param [inout] <clim_type> The interpolate type containing the names of the fields in the climatology file
1769 subroutine unset_interpolator_time_flag (clim_type)
1771 type(interpolate_type), intent(inout) :: clim_type
1772 
1773 
1774  clim_type%separate_time_vary_calc = .false.
1775 
1776 
1777 end subroutine unset_interpolator_time_flag
1778 
1779 
1780 
1781 !#####################################################################
1782 !
1783 !---------------------------------------------------------------------
1784 !> \brief interpolator_4D receives a field name as input and
1785 !! interpolates the field to model a 4D grid and time axis.
1786 !!
1787 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
1788 !! \param [in] <field_name> The name of a field that you wish to interpolate
1789 !! \param [in] <Time> The model time that you wish to interpolate to
1790 !! \param [in] <phalf> The half level model pressure field
1791 !! \param [in] <is> OPTIONAL: Index for the physics window
1792 !! \param [in] <js> OPTIONAL: Index for the physics window
1793 !! \param [out] <interp_data> The model fields with the interpolated climatology data
1794 !! \param [out] <clim_units> OPTIONAL: The units of field_name
1795 !!
1796 !! \throw FATAL "interpolator_4D : You must call interpolator_init
1797 !! before calling interpolator"
1798 !! \throw FATAL "interpolator_mod: cannot use 4D interface to interpolator for this file"
1799 !! \throw FATAL "interpolator_4D 1: file="
1800 !! \throw FATAL "interpolator_4D 2: file="
1801 !! \throw FATAL "interpolator_4D 3: file="
1802 !! \throw FATAL "interpolator_4D 4: file="
1803 !! \throw FATAL "interpolator_4D 5: file="
1804 !! \throw FATAL "interpolator_3D : No data from the previous climatology
1805 !! time but we have the next time. How did this happen?"
1806 !! \throw NOTE "Interpolator: model surface pressure is greater than
1807 !! climatology surface pressure for "
1808 !! \throw NOTE "Interpolator: model top pressure is less than
1809 !! climatology top pressure for "
1810 !! \throw FATAL "Interpolator: the field name is not contained in this
1811 !! intepolate_type: "
1812 subroutine interpolator_4d(clim_type, Time, phalf, interp_data, &
1813  field_name, is,js, clim_units)
1815 ! Return 4-D field interpolated to model grid and time
1816 !
1817 ! INTENT INOUT
1818 ! clim_type : The interpolate type previously defined by a call to interpolator_init
1819 !
1820 ! INTENT IN
1821 ! field_name : The name of a field that you wish to interpolate.
1822 ! all variables within this interpolate_type variable
1823 ! will be interpolated on this call. field_name may
1824 ! be any one of the variables.
1825 ! Time : The model time that you wish to interpolate to.
1826 ! phalf : The half level model pressure field.
1827 ! is, js : The indices of the physics window.
1828 !
1829 ! INTENT OUT
1830 ! interp_data : The model fields with the interpolated climatology data.
1831 ! clim_units : The units of field_name
1832 !
1833 type(interpolate_type), intent(inout) :: clim_type
1834 character(len=*) , intent(in) :: field_name
1835 type(time_type) , intent(in) :: Time
1836 real, dimension(:,:,:), intent(in) :: phalf
1837 real, dimension(:,:,:,:), intent(out) :: interp_data
1838 integer , intent(in) , optional :: is,js
1839 character(len=*) , intent(out), optional :: clim_units
1840 integer :: taum, taup, ilon
1841 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:)),size(clim_type%field_name(:)))
1842 real :: p_fact(size(interp_data,1),size(interp_data,2))
1843 real :: col_data(size(interp_data,1),size(interp_data,2), &
1844  size(clim_type%field_name(:)))
1845 real :: pclim(size(clim_type%halflevs(:)))
1846 integer :: istart,iend,jstart,jend
1847 logical :: result, found
1848 logical :: found_field=.false.
1849 integer :: modyear, modmonth, modday, modhour, modminute, modsecond
1850 integer :: climyear, climmonth, climday, climhour, climminute, climsecond
1851 integer :: year1, month1, day, hour, minute, second
1852 integer :: climatology, m
1853 type(time_type) :: t_prev, t_next
1854 type(time_type), dimension(2) :: month
1855 integer :: indexm, indexp, yearm, yearp
1856 integer :: i, j, k, n
1857 character(len=256) :: err_msg
1858 
1859 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
1860  call mpp_error(fatal, "interpolator_4D : You must call interpolator_init before calling interpolator")
1861 
1862  do n=2,size(clim_type%field_name(:))
1863  if (clim_type%vert_interp(n) /= clim_type%vert_interp(n-1) .or. &
1864  clim_type%out_of_bounds(n) /= clim_type%out_of_bounds(n-1)) then
1865  if (mpp_pe() == mpp_root_pe() ) then
1866  print *, 'processing file ' // trim(clim_type%file_name)
1867  endif
1868  call mpp_error (fatal, 'interpolator_mod: &
1869  &cannot use 4D interface to interpolator for this file')
1870  endif
1871  end do
1872 
1873 
1874 
1875 
1876 istart = 1
1877 if (present(is)) istart = is
1878 iend = istart - 1 + size(interp_data,1)
1879 
1880 jstart = 1
1881 if (present(js)) jstart = js
1882 jend = jstart - 1 + size(interp_data,2)
1883 
1884  do i= 1,size(clim_type%field_name(:))
1885 !!++lwh
1886  if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) ) then
1887 !--lwh
1888  found_field=.true.
1889  exit
1890  endif
1891 end do
1892  i = 1
1893 
1894  if(present(clim_units)) then
1895  call mpp_get_atts(clim_type%field_type(i),units=clim_units)
1896  clim_units = chomp(clim_units)
1897  endif
1898 
1899 
1900 
1901 
1902 !----------------------------------------------------------------------
1903 ! skip the time interpolation portion of this routine if subroutine
1904 ! obtain_interpolator_time_slices has already been called on this
1905 ! stewp for this interpolate_type variable.
1906 !----------------------------------------------------------------------
1907 
1908 if ( .not. clim_type%separate_time_vary_calc) then
1909 ! print *, 'TIME INTERPOLATION NOT SEPARATED 4d--', &
1910 ! trim(clim_type%file_name), mpp_pe()
1911 
1912  if (clim_type%climatological_year) then
1913 !++lwh
1914  if (size(clim_type%time_slice) > 1) then
1915  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, modtime=year, err_msg=err_msg )
1916  if(trim(err_msg) /= '') then
1917  call mpp_error(fatal,'interpolator_4D 1: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1918  endif
1919  else
1920  taum = 1
1921  taup = 1
1922  clim_type%tweight = 0.
1923  end if
1924 !--lwh
1925  else
1926  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, err_msg=err_msg )
1927  if(trim(err_msg) /= '') then
1928  call mpp_error(fatal,'interpolator_4D 2: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1929  endif
1930  endif
1931 
1932  if(clim_type%TIME_FLAG .eq. bilinear ) then
1933  ! Check if delta-time is greater than delta of first two climatology time-slices.
1934  if ( (time - clim_type%time_slice(taum) ) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) .or. &
1935  (clim_type%time_slice(taup) - time) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) ) then
1936  ! The difference between the model time and the last climatology time-slice previous to the model time.
1937  ! We need 2 time levels.
1938  clim_type%itaum=0
1939  clim_type%itaup=0
1940  ! Assume this is monthly data. So we need to get the data applicable to the model date but substitute
1941  ! the climatology year into the appropriate place.
1942 
1943 
1944  ! We need to get the previous months data for the climatology year before
1945  ! and after the model year.
1946  call get_date(time, modyear, modmonth, modday, modhour, modminute, modsecond)
1947  call get_date(clim_type%time_slice(taum), climyear, climmonth, climday, climhour, climminute, climsecond)
1948 
1949  climatology = 1
1950  do m = 1, size(clim_type%clim_times(:,:),2)
1951  !Assume here that a climatology is for 1 year and consists of 12 months starting in January.
1952  call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
1953  if (year1 == climyear) climatology = m
1954  enddo
1955  do m = 1,12
1956  !Find which month we are trying to look at and set clim_date[mp] to the dates spanning that.
1957  call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
1958  if ( month1 == modmonth ) then
1959 !RSHBUGFX if ( modday <= day ) then
1960  if ( modday < day ) then
1961  indexm = m-1 ; indexp = m
1962  else
1963  indexm = m ; indexp = m+1
1964  endif
1965  endif
1966 
1967  enddo
1968  if ( indexm == 0 ) then
1969  indexm = 12
1970  yearm = modyear - 1
1971  else
1972  yearm = modyear
1973  endif
1974  call get_date(clim_type%time_slice(indexm+(climatology-1)*12), &
1975  climyear, climmonth, climday, climhour, climminute, climsecond)
1976  month(1) = set_date(yearm, indexm, climday, climhour, climminute, climsecond)
1977  if ( indexp == 13 ) then
1978  indexp = 1
1979  yearp = modyear + 1
1980  else
1981  yearp = modyear
1982  endif
1983  call get_date(clim_type%time_slice(indexp+(climatology-1)*12), &
1984  climyear, climmonth, climday, climhour, climminute, climsecond)
1985  month(2) = set_date(yearp, indexp, climday, climhour, climminute, climsecond)
1986 
1987  call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg ) ! tweight3 is the time weight between the months.
1988  if ( .not. retain_cm3_bug ) then
1989  if (taum==2 .and. taup==2) clim_type%tweight3 = 1. ! protect against post-perth time_interp behavior
1990  end if
1991  if(trim(err_msg) /= '') then
1992  call mpp_error(fatal,'interpolator_4D 3: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
1993  endif
1994 
1995  month(1) = clim_type%time_slice(indexm+(climatology-1)*12)
1996  month(2) = clim_type%time_slice(indexm+climatology*12)
1997  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
1998  t_prev = set_date(yearm, climmonth, climday, climhour, climminute, climsecond)
1999  call time_interp(t_prev, month, clim_type%tweight1, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
2000  if ( .not. retain_cm3_bug ) then
2001  if (taum==2 .and. taup==2) clim_type%tweight1 = 1. ! protect against post-perth time_interp behavior
2002  end if
2003  if(trim(err_msg) /= '') then
2004  call mpp_error(fatal,'interpolator_4D 4: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2005  endif
2006  month(1) = clim_type%time_slice(indexp+(climatology-1)*12)
2007  month(2) = clim_type%time_slice(indexp+climatology*12)
2008  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
2009  t_next = set_date(yearp, climmonth, climday, climhour, climminute, climsecond)
2010  call time_interp(t_next, month, clim_type%tweight2, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
2011  if ( .not. retain_cm3_bug ) then
2012  if (taum==2 .and. taup==2) clim_type%tweight2 = 1. ! protect against post-perth time_interp behavior
2013  end if
2014  if(trim(err_msg) /= '') then
2015  call mpp_error(fatal,'interpolator_4D 5: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2016  endif
2017 
2018  if (indexm == clim_type%indexm(1) .and. &
2019  indexp == clim_type%indexp(1) .and. &
2020  climatology == clim_type%climatology(1)) then
2021  else
2022  clim_type%indexm(:) = indexm
2023  clim_type%indexp(:) = indexp
2024  clim_type%climatology(:) = climatology
2025  do i=1, size(clim_type%field_name(:))
2026  call read_data(clim_type,clim_type%field_type(i), &
2027  clim_type%pmon_pyear(:,:,:,i), &
2028  clim_type%indexm(i)+(clim_type%climatology(i)-1)*12,i,time)
2029 ! Read the data for the next month in the previous climatology.
2030  call read_data(clim_type,clim_type%field_type(i), &
2031  clim_type%nmon_pyear(:,:,:,i), &
2032  clim_type%indexp(i)+(clim_type%climatology(i)-1)*12,i,time)
2033  call read_data(clim_type,clim_type%field_type(i), &
2034  clim_type%pmon_nyear(:,:,:,i), &
2035  clim_type%indexm(i)+clim_type%climatology(i)*12,i,time)
2036  call read_data(clim_type,clim_type%field_type(i), &
2037  clim_type%nmon_nyear(:,:,:,i), &
2038  clim_type%indexp(i)+clim_type%climatology(i)*12,i,time)
2039  end do
2040  endif
2041 
2042 
2043 
2044  else ! We are within a climatology data set
2045 
2046 
2047  do i=1, size(clim_type%field_name(:))
2048  if (taum /= clim_type%time_init(i,1) .or. &
2049  taup /= clim_type%time_init(i,2) ) then
2050 
2051 
2052  call read_data(clim_type,clim_type%field_type(i), &
2053  clim_type%pmon_pyear(:,:,:,i), taum,i,time)
2054 ! Read the data for the next month in the previous climatology.
2055  call read_data(clim_type,clim_type%field_type(i), &
2056  clim_type%nmon_pyear(:,:,:,i), taup,i,time)
2057  clim_type%time_init(i,1) = taum
2058  clim_type%time_init(i,2) = taup
2059  endif
2060  end do
2061 
2062 ! clim_type%pmon_nyear = 0.0
2063 ! clim_type%nmon_nyear = 0.0
2064 
2065 ! set to zero so when next return to bilinear section will be sure to
2066 ! have proper data (relevant when running fixed_year case for more than
2067 ! one year in a single job)
2068  clim_type%indexm(:) = 0
2069  clim_type%indexp(:) = 0
2070  clim_type%climatology(:) = 0
2071 
2072 
2073 ! clim_type%tweight3 = 0.0 ! This makes [pn]mon_nyear irrelevant. Set them to 0 to test.
2074  clim_type%tweight1 = 0.0
2075  clim_type%tweight2 = 0.0
2076  clim_type%tweight3 = clim_type%tweight
2077  endif
2078  endif !(BILINEAR)
2079 
2080  if(clim_type%TIME_FLAG .eq. linear .and. &
2081  (.not. read_all_on_init) ) then
2082 ! We need 2 time levels. Check we have the correct data.
2083  clim_type%itaum=0
2084  clim_type%itaup=0
2085  do n=1,size(clim_type%time_init,2)
2086  if (clim_type%time_init(1,n) .eq. taum ) clim_type%itaum = n
2087  if (clim_type%time_init(1,n) .eq. taup ) clim_type%itaup = n
2088  enddo
2089 
2090  if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0) then
2091 !Neither time is set so we need to read 2 time slices.
2092 !Set up
2093 ! field(:,:,:,1) as the previous time slice.
2094 ! field(:,:,:,2) as the next time slice.
2095  do i=1, size(clim_type%field_name(:))
2096  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,1,i), taum,i,time)
2097  clim_type%time_init(i,1) = taum
2098  clim_type%itaum = 1
2099  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,2,i), taup,i,time)
2100  clim_type%time_init(i,2) = taup
2101  clim_type%itaup = 2
2102  end do
2103  endif ! clim_type%itaum.eq.clim_type%itaup.eq.0
2104  if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0) then
2105 ! Can't think of a situation where we would have the next time level but not the previous.
2106  call mpp_error(fatal,'interpolator_3D : No data from the previous climatology time &
2107  & but we have the next time. How did this happen?')
2108  endif
2109  if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0) then
2110 !We have the previous time step but not the next time step data
2111  clim_type%itaup = 1
2112  if (clim_type%itaum .eq. 1 ) clim_type%itaup = 2
2113  do i=1, size(clim_type%field_name(:))
2114  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,clim_type%itaup,i), taup,i, time)
2115  clim_type%time_init(i,clim_type%itaup)=taup
2116  end do
2117  endif
2118 
2119 
2120  endif! TIME_FLAG
2121 
2122 
2123 endif ! (.not. separate_time_vary_calc)
2124 
2125 
2126 select case(clim_type%TIME_FLAG)
2127  case (linear)
2128  do n=1, size(clim_type%field_name(:))
2129  hinterp_data(:,:,:,n) = (1.-clim_type%tweight)* &
2130  clim_type%data(istart:iend,jstart:jend,:,clim_type%itaum,n) + &
2131  clim_type%tweight* &
2132  clim_type%data(istart:iend,jstart:jend,:,clim_type%itaup,n)
2133  end do
2134 ! case (SEASONAL)
2135 ! Do sine fit to data at this point
2136  case (bilinear)
2137  do n=1, size(clim_type%field_name(:))
2138  hinterp_data(:,:,:,n) = (1.-clim_type%tweight1)*(1.-clim_type%tweight3)* &
2139  clim_type%pmon_pyear(istart:iend,jstart:jend,:,n) + &
2140  (1.-clim_type%tweight2)*clim_type%tweight3* &
2141  clim_type%nmon_pyear(istart:iend,jstart:jend,:,n) + &
2142  clim_type%tweight1* (1.-clim_type%tweight3)* &
2143  clim_type%pmon_nyear(istart:iend,jstart:jend,:,n) + &
2144  clim_type%tweight2* clim_type%tweight3* &
2145  clim_type%nmon_nyear(istart:iend,jstart:jend,:,n)
2146 
2147  end do
2148 
2149 end select
2150 
2151 select case(clim_type%level_type)
2152  case(pressure)
2153  p_fact = 1.0
2154  case(sigma)
2155  p_fact = maxval(phalf,3)! max pressure in the column !(:,:,size(phalf,3))
2156 end select
2157 
2158 col_data(:,:,:)=0.0
2159  do i= 1, size(clim_type%field_name(:))
2160 
2161 select case(clim_type%mr(i))
2162  case(no_conv)
2163  do k = 1,size(hinterp_data,3)
2164  col_data(:,:,i) = col_data(:,:,i) + hinterp_data(:,:,k,i)* &
2165  (clim_type%halflevs(k+1)-clim_type%halflevs(k))/grav
2166  enddo
2167 
2168  case(kg_m2)
2169  do k = 1,size(hinterp_data,3)
2170  col_data(:,:,i) = col_data(:,:,i) + hinterp_data(:,:,k,i)
2171  hinterp_data(:,:,k,i) = hinterp_data(:,:,k,i)/ &
2172  ((clim_type%halflevs(k+1)-clim_type%halflevs(k))*p_fact)
2173  enddo
2174 end select
2175  enddo
2176 
2177  do i= 1, size(clim_type%field_name(:))
2178 found = .false.
2179 do j = 1,size(climo_diag_name(:))
2180  if ( trim(adjustl(lowercase(climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i))))) then
2181  found = .true.
2182  exit
2183  endif
2184 enddo
2185 
2186 if (found) then
2187  if (hinterp_id(j) > 0 ) then
2188  result = send_data(hinterp_id(j),col_data(:,:,i),time,is_in=istart,js_in=jstart)
2189  endif
2190 endif
2191 
2192  end do
2193 
2194  i = 1
2195 
2196 !++lwh
2197 do j = 1, size(phalf,2)
2198  do ilon=1,size(phalf,1)
2199  pclim = p_fact(ilon,j)*clim_type%halflevs
2200  if ( maxval(phalf(ilon,j,:)) > maxval(pclim) ) then
2201  if (verbose > 3) then
2202  call mpp_error(note,"Interpolator: model surface pressure&
2203  & is greater than climatology surface pressure for "&
2204  // trim(clim_type%file_name))
2205  endif
2206  select case(clim_type%out_of_bounds(i))
2207  case(constant)
2208  pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
2209 ! case(ZERO)
2210 ! pclim( maxloc(pclim)) = 0
2211  end select
2212  endif
2213  if ( minval(phalf(ilon,j,:)) < minval(pclim) ) then
2214  if (verbose > 3) then
2215  call mpp_error(note,"Interpolator: model top pressure&
2216  & is less than climatology top pressure for "&
2217  // trim(clim_type%file_name))
2218  endif
2219  select case(clim_type%out_of_bounds(i))
2220  case(constant)
2221  pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
2222 ! case(ZERO)
2223 ! pclim( maxloc(pclim)) = 0
2224  end select
2225  endif
2226  select case(clim_type%vert_interp(i))
2227  case(interp_weighted_p)
2228  call interp_weighted_scalar(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,:),interp_data(ilon,j,:,:))
2229  case(interp_linear_p)
2230  do n=1, size(clim_type%field_name(:))
2231  call interp_linear(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,n),interp_data(ilon,j,:,n))
2232  end do
2233 ! case(INTERP_LOG)
2234  end select
2235  enddo
2236 enddo
2237 
2238 !--lwh
2239  do i= 1, size(clim_type%field_name(:))
2240 
2241 select case(clim_type%mr(i))
2242  case(kg_m2)
2243  do k = 1,size(interp_data,3)
2244  interp_data(:,:,k,i) = interp_data(:,:,k,i)*(phalf(:,:,k+1)-phalf(:,:,k))
2245  enddo
2246 end select
2247 
2248  end do
2249 
2250 if( .not. found_field) then !field name is not in interpolator file.ERROR.
2251  call mpp_error(fatal,"Interpolator: the field name is not contained in this &
2252  &intepolate_type: "//trim(field_name))
2253 endif
2254 end subroutine interpolator_4d
2255 !
2256 !#######################################################################
2257 !#######################################################################
2258 !
2259 !---------------------------------------------------------------------
2260 !> \brief interpolator_3D receives a field name as input and
2261 !! interpolates the field to model a 3D grid and time axis.
2262 !!
2263 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
2264 !! \param [in] <field_name> The name of a field that you wish to interpolate
2265 !! \param [in] <Time> The model time that you wish to interpolate to
2266 !! \param [in] <phalf> The half level model pressure field
2267 !! \param [in] <is> OPTIONAL: Index for the physics window
2268 !! \param [in] <js> OPTIONAL: Index for the physics window
2269 !! \param [out] <interp_data> The model fields with the interpolated climatology data
2270 !! \param [out] <clim_units> OPTIONAL: The units of field_name
2271 !!
2272 !! \throw FATAL "interpolator_3D : You must call interpolator_init
2273 !! before calling interpolator"
2274 !! \throw FATAL "interpolator_3D 1: file="
2275 !! \throw FATAL "interpolator_3D 2: file="
2276 !! \throw FATAL "interpolator_3D 3: file="
2277 !! \throw FATAL "interpolator_3D 4: file="
2278 !! \throw FATAL "interpolator_3D 5: file="
2279 !! \throw FATAL "interpolator_3D : No data from the previous climatology
2280 !! time but we have the next time. How did this happen?"
2281 !! \throw NOTE "Interpolator: model surface pressure is greater than
2282 !! climatology surface pressure for "
2283 !! \throw NOTE "Interpolator: model top pressure is less than
2284 !! climatology top pressure for "
2285 !! \throw FATAL "Interpolator: the field name is not contained in this
2286 !! intepolate_type: "
2287 subroutine interpolator_3d(clim_type, Time, phalf, interp_data,field_name, is,js, clim_units)
2289 ! Return 3-D field interpolated to model grid and time
2290 !
2291 ! INTENT INOUT
2292 ! clim_type : The interpolate type previously defined by a call to interpolator_init
2293 !
2294 ! INTENT IN
2295 ! field_name : The name of the field that you wish to interpolate.
2296 ! Time : The model time that you wish to interpolate to.
2297 ! phalf : The half level model pressure field.
2298 ! is, js : The indices of the physics window.
2299 !
2300 ! INTENT OUT
2301 ! interp_data : The model field with the interpolated climatology data.
2302 ! clim_units : The units of field_name
2303 !
2304 type(interpolate_type), intent(inout) :: clim_type
2305 character(len=*) , intent(in) :: field_name
2306 type(time_type) , intent(in) :: Time
2307 real, dimension(:,:,:), intent(in) :: phalf
2308 real, dimension(:,:,:), intent(out) :: interp_data
2309 integer , intent(in) , optional :: is,js
2310 character(len=*) , intent(out), optional :: clim_units
2311 integer :: taum, taup, ilon
2312 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:)))
2313 real :: p_fact(size(interp_data,1),size(interp_data,2))
2314 real :: col_data(size(interp_data,1),size(interp_data,2))
2315 real :: pclim(size(clim_type%halflevs(:)))
2316 integer :: istart,iend,jstart,jend
2317 logical :: result, found
2318 logical :: found_field=.false.
2319 integer :: modyear, modmonth, modday, modhour, modminute, modsecond
2320 integer :: climyear, climmonth, climday, climhour, climminute, climsecond
2321 integer :: year1, month1, day, hour, minute, second
2322 integer :: climatology, m
2323 type(time_type) :: t_prev, t_next
2324 type(time_type), dimension(2) :: month
2325 integer :: indexm, indexp, yearm, yearp
2326 integer :: i, j, k, n
2327 character(len=256) :: err_msg
2328 
2329 
2330 
2331 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
2332  call mpp_error(fatal, "interpolator_3D : You must call interpolator_init before calling interpolator")
2333 
2334 istart = 1
2335 if (present(is)) istart = is
2336 iend = istart - 1 + size(interp_data,1)
2337 
2338 jstart = 1
2339 if (present(js)) jstart = js
2340 jend = jstart - 1 + size(interp_data,2)
2341 
2342 do i= 1,size(clim_type%field_name(:))
2343 !++lwh
2344  if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) ) then
2345 !--lwh
2346  found_field=.true.
2347  if(present(clim_units)) then
2348  call mpp_get_atts(clim_type%field_type(i),units=clim_units)
2349  clim_units = chomp(clim_units)
2350  endif
2351 
2352 !----------------------------------------------------------------------
2353 ! skip the time interpolation portion of this routine if subroutine
2354 ! obtain_interpolator_time_slices has already been called on this
2355 ! stewp for this interpolate_type variable.
2356 !----------------------------------------------------------------------
2357 
2358 
2359 if ( .not. clim_type%separate_time_vary_calc) then
2360 ! print *, 'TIME INTERPOLATION NOT SEPARATED 3d--', &
2361 ! trim(clim_type%file_name), mpp_pe()
2362  if (clim_type%climatological_year) then
2363 !++lwh
2364  if (size(clim_type%time_slice) > 1) then
2365  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, modtime=year, err_msg=err_msg )
2366  if(trim(err_msg) /= '') then
2367  call mpp_error(fatal,'interpolator_3D 1: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2368  endif
2369  else
2370  taum = 1
2371  taup = 1
2372  clim_type%tweight = 0.
2373  end if
2374 !--lwh
2375  else
2376  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, err_msg=err_msg )
2377  if(trim(err_msg) /= '') then
2378  call mpp_error(fatal,'interpolator_3D 2: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2379  endif
2380  endif
2381 
2382 ! if(clim_type%TIME_FLAG .ne. LINEAR ) then
2383  if(clim_type%TIME_FLAG .ne. linear .or. read_all_on_init ) then
2384  clim_type%itaum=taum
2385  clim_type%itaup=taup
2386  endif
2387 
2388  if(clim_type%TIME_FLAG .eq. bilinear ) then
2389  ! Check if delta-time is greater than delta of first two climatology time-slices.
2390  if ( (time - clim_type%time_slice(taum) ) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) .or. &
2391  (clim_type%time_slice(taup) - time) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) ) then
2392  ! The difference between the model time and the last climatology time-slice previous to the model time.
2393  ! We need 2 time levels.
2394  clim_type%itaum=0
2395  clim_type%itaup=0
2396  ! Assume this is monthly data. So we need to get the data applicable to the model date but substitute
2397  ! the climatology year into the appropriate place.
2398 
2399 
2400  ! We need to get the previous months data for the climatology year before
2401  ! and after the model year.
2402  call get_date(time, modyear, modmonth, modday, modhour, modminute, modsecond)
2403  call get_date(clim_type%time_slice(taum), climyear, climmonth, climday, climhour, climminute, climsecond)
2404 
2405  climatology = 1
2406  do m = 1, size(clim_type%clim_times(:,:),2)
2407  !Assume here that a climatology is for 1 year and consists of 12 months starting in January.
2408  call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
2409  if (year1 == climyear) climatology = m
2410  enddo
2411  do m = 1,12
2412  !Find which month we are trying to look at and set clim_date[mp] to the dates spanning that.
2413  call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
2414  if ( month1 == modmonth ) then
2415 !RSHBUGFX if ( modday <= day ) then
2416  if ( modday < day ) then
2417  indexm = m-1 ; indexp = m
2418  else
2419  indexm = m ; indexp = m+1
2420  endif
2421  endif
2422 
2423  enddo
2424  if ( indexm == 0 ) then
2425  indexm = 12
2426  yearm = modyear - 1
2427  else
2428  yearm = modyear
2429  endif
2430  call get_date(clim_type%time_slice(indexm+(climatology-1)*12), &
2431  climyear, climmonth, climday, climhour, climminute, climsecond)
2432  month(1) = set_date(yearm, indexm, climday, climhour, climminute, climsecond)
2433  if ( indexp == 13 ) then
2434  indexp = 1
2435  yearp = modyear + 1
2436  else
2437  yearp = modyear
2438  endif
2439  call get_date(clim_type%time_slice(indexp+(climatology-1)*12), &
2440  climyear, climmonth, climday, climhour, climminute, climsecond)
2441  month(2) = set_date(yearp, indexp, climday, climhour, climminute, climsecond)
2442 
2443  call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg ) ! tweight3 is the time weight between the months.
2444  if ( .not. retain_cm3_bug ) then
2445  if (taum==2 .and. taup==2) clim_type%tweight3 = 1. ! protect against post-perth time_interp behavior
2446  end if
2447  if(trim(err_msg) /= '') then
2448  call mpp_error(fatal,'interpolator_3D 3: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2449  endif
2450 
2451  month(1) = clim_type%time_slice(indexm+(climatology-1)*12)
2452  month(2) = clim_type%time_slice(indexm+climatology*12)
2453  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
2454  t_prev = set_date(yearm, climmonth, climday, climhour, climminute, climsecond)
2455  call time_interp(t_prev, month, clim_type%tweight1, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
2456  if ( .not. retain_cm3_bug ) then
2457  if (taum==2 .and. taup==2) clim_type%tweight1 = 1. ! protect against post-perth time_interp behavior
2458  end if
2459  if(trim(err_msg) /= '') then
2460  call mpp_error(fatal,'interpolator_3D 4: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2461  endif
2462 
2463  month(1) = clim_type%time_slice(indexp+(climatology-1)*12)
2464  month(2) = clim_type%time_slice(indexp+climatology*12)
2465  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
2466  t_next = set_date(yearp, climmonth, climday, climhour, climminute, climsecond)
2467  call time_interp(t_next, month, clim_type%tweight2, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
2468  if ( .not. retain_cm3_bug ) then
2469  if (taum==2 .and. taup==2) clim_type%tweight2 = 1. ! protect against post-perth time_interp behavior
2470  end if
2471  if(trim(err_msg) /= '') then
2472  call mpp_error(fatal,'interpolator_3D 5: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2473  endif
2474 
2475 
2476  if (indexm == clim_type%indexm(i) .and. &
2477  indexp == clim_type%indexp(i) .and. &
2478  climatology == clim_type%climatology(i)) then
2479  else
2480  clim_type%indexm(i) = indexm
2481  clim_type%indexp(i) = indexp
2482  clim_type%climatology(i) = climatology
2483  call read_data(clim_type,clim_type%field_type(i), &
2484  clim_type%pmon_pyear(:,:,:,i), &
2485  clim_type%indexm(i)+(clim_type%climatology(i)-1)*12,i,time)
2486 ! Read the data for the next month in the previous climatology.
2487  call read_data(clim_type,clim_type%field_type(i), &
2488  clim_type%nmon_pyear(:,:,:,i), &
2489  clim_type%indexp(i)+(clim_type%climatology(i)-1)*12,i,time)
2490  call read_data(clim_type,clim_type%field_type(i), &
2491  clim_type%pmon_nyear(:,:,:,i), &
2492  clim_type%indexm(i)+clim_type%climatology(i)*12,i,time)
2493  call read_data(clim_type,clim_type%field_type(i), &
2494  clim_type%nmon_nyear(:,:,:,i), &
2495  clim_type%indexp(i)+clim_type%climatology(i)*12,i,time)
2496  endif
2497 
2498 
2499 
2500 
2501  else ! We are within a climatology data set
2502 
2503  if (taum /= clim_type%time_init(i,1) .or. &
2504  taup /= clim_type%time_init(i,2) ) then
2505 
2506  call read_data(clim_type,clim_type%field_type(i), clim_type%pmon_pyear(:,:,:,i), taum,i,time)
2507 ! Read the data for the next month in the previous climatology.
2508  call read_data(clim_type,clim_type%field_type(i), clim_type%nmon_pyear(:,:,:,i), taup,i,time)
2509 !RSHbug clim_type%pmon_nyear = 0.0
2510 !RSHbug clim_type%nmon_nyear = 0.0
2511 
2512 ! clim_type%pmon_nyear(:,:,:,i) = 0.0
2513 ! clim_type%nmon_nyear(:,:,:,i) = 0.0
2514 
2515 ! set to zero so when next return to bilinear section will be sure to
2516 ! have proper data (relevant when running fixed_year case for more than
2517 ! one year in a single job)
2518  clim_type%indexm(i) = 0
2519  clim_type%indexp(i) = 0
2520  clim_type%climatology(i) = 0
2521 
2522 
2523  clim_type%time_init(i,1) = taum
2524  clim_type%time_init(i,2) = taup
2525  endif
2526 ! clim_type%tweight3 = 0.0 ! This makes [pn]mon_nyear irrelevant. Set them to 0 to test.
2527  clim_type%tweight1 = 0.0 ; clim_type%tweight2 = 0.0
2528  clim_type%tweight3 = clim_type%tweight
2529  endif
2530 
2531  endif ! (BILINEAR)
2532 
2533 
2534  if(clim_type%TIME_FLAG .eq. linear .and. &
2535  (.not. read_all_on_init) ) then
2536 ! We need 2 time levels. Check we have the correct data.
2537  clim_type%itaum=0
2538  clim_type%itaup=0
2539  do n=1,size(clim_type%time_init,2)
2540  if (clim_type%time_init(i,n) .eq. taum ) clim_type%itaum = n
2541  if (clim_type%time_init(i,n) .eq. taup ) clim_type%itaup = n
2542  enddo
2543 
2544  if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0) then
2545 !Neither time is set so we need to read 2 time slices.
2546 !Set up
2547 ! field(:,:,:,1) as the previous time slice.
2548 ! field(:,:,:,2) as the next time slice.
2549  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,1,i), taum,i,time)
2550  clim_type%time_init(i,1) = taum
2551  clim_type%itaum = 1
2552  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,2,i), taup,i,time)
2553  clim_type%time_init(i,2) = taup
2554  clim_type%itaup = 2
2555  endif ! clim_type%itaum.eq.clim_type%itaup.eq.0
2556  if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0) then
2557 ! Can't think of a situation where we would have the next time level but not the previous.
2558  call mpp_error(fatal,'interpolator_3D : No data from the previous climatology time &
2559  & but we have the next time. How did this happen?')
2560  endif
2561  if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0) then
2562 !We have the previous time step but not the next time step data
2563  clim_type%itaup = 1
2564  if (clim_type%itaum .eq. 1 ) clim_type%itaup = 2
2565  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,clim_type%itaup,i), taup,i, time)
2566  clim_type%time_init(i,clim_type%itaup)=taup
2567  endif
2568 
2569 
2570  endif! TIME_FLAG
2571 
2572  endif !( .not. clim_type%separate_time_vary_calc)
2573 select case(clim_type%TIME_FLAG)
2574  case (linear)
2575  hinterp_data = (1.-clim_type%tweight) * clim_type%data(istart:iend,jstart:jend,:,clim_type%itaum,i) + &
2576  clim_type%tweight * clim_type%data(istart:iend,jstart:jend,:,clim_type%itaup,i)
2577 ! case (SEASONAL)
2578 ! Do sine fit to data at this point
2579  case (bilinear)
2580  hinterp_data = &
2581  (1.-clim_type%tweight1) * (1.-clim_type%tweight3) * clim_type%pmon_pyear(istart:iend,jstart:jend,:,i) + &
2582  (1.-clim_type%tweight2) * clim_type%tweight3 * clim_type%nmon_pyear(istart:iend,jstart:jend,:,i) + &
2583  clim_type%tweight1 * (1.-clim_type%tweight3) * clim_type%pmon_nyear(istart:iend,jstart:jend,:,i) + &
2584  clim_type%tweight2 * clim_type%tweight3 * clim_type%nmon_nyear(istart:iend,jstart:jend,:,i)
2585 
2586 
2587 
2588 end select
2589 
2590 select case(clim_type%level_type)
2591  case(pressure)
2592  p_fact = 1.0
2593  case(sigma)
2594  p_fact = maxval(phalf,3)! max pressure in the column !(:,:,size(phalf,3))
2595 end select
2596 
2597 col_data(:,:)=0.0
2598 select case(clim_type%mr(i))
2599  case(no_conv)
2600  do k = 1,size(hinterp_data,3)
2601  col_data(:,:) = col_data(:,:) + hinterp_data(:,:,k)* &
2602  (clim_type%halflevs(k+1)-clim_type%halflevs(k))/grav
2603  enddo
2604 
2605  case(kg_m2)
2606  do k = 1,size(hinterp_data,3)
2607  col_data(:,:) = col_data(:,:) + hinterp_data(:,:,k)
2608  hinterp_data(:,:,k) = hinterp_data(:,:,k)/ &
2609  ((clim_type%halflevs(k+1)-clim_type%halflevs(k))*p_fact)
2610  enddo
2611 end select
2612 
2613 found = .false.
2614 do j = 1,size(climo_diag_name(:))
2615  if ( trim(adjustl(lowercase(climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i))))) then
2616  found = .true.
2617  exit
2618  endif
2619 enddo
2620 
2621 if (found) then
2622  if (hinterp_id(j) > 0 ) then
2623  result = send_data(hinterp_id(j),col_data,time,is_in=istart,js_in=jstart)
2624  endif
2625 endif
2626 
2627 
2628 !++lwh
2629 do j = 1, size(phalf,2)
2630  do ilon=1,size(phalf,1)
2631  pclim = p_fact(ilon,j)*clim_type%halflevs
2632  if ( maxval(phalf(ilon,j,:)) > maxval(pclim) ) then
2633  if (verbose > 3) then
2634  call mpp_error(note,"Interpolator: model surface pressure&
2635  & is greater than climatology surface pressure for "&
2636  // trim(clim_type%file_name))
2637  endif
2638  select case(clim_type%out_of_bounds(i))
2639  case(constant)
2640  pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
2641 ! case(ZERO)
2642 ! pclim( maxloc(pclim)) = 0
2643  end select
2644  endif
2645  if ( minval(phalf(ilon,j,:)) < minval(pclim) ) then
2646  if (verbose > 3) then
2647  call mpp_error(note,"Interpolator: model top pressure&
2648  & is less than climatology top pressure for "&
2649  // trim(clim_type%file_name))
2650  endif
2651  select case(clim_type%out_of_bounds(i))
2652  case(constant)
2653  pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
2654 ! case(ZERO)
2655 ! pclim( maxloc(pclim)) = 0
2656  end select
2657  endif
2658  select case(clim_type%vert_interp(i))
2659  case(interp_weighted_p)
2660  call interp_weighted_scalar(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
2661  case(interp_linear_p)
2662  call interp_linear(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
2663 ! case(INTERP_LOG)
2664  end select
2665  enddo
2666 enddo
2667 
2668 !--lwh
2669 
2670 select case(clim_type%mr(i))
2671  case(kg_m2)
2672  do k = 1,size(interp_data,3)
2673  interp_data(:,:,k) = interp_data(:,:,k)*(phalf(:,:,k+1)-phalf(:,:,k))
2674  enddo
2675 end select
2676 
2677  endif !field_name
2678 enddo !End of i loop
2679 if( .not. found_field) then !field name is not in interpolator file.ERROR.
2680  call mpp_error(fatal,"Interpolator: the field name is not contained in this &
2681  &intepolate_type: "//trim(field_name))
2682 endif
2683 end subroutine interpolator_3d
2684 !
2685 !#######################################################################
2686 !
2687 !++lwh
2688 !---------------------------------------------------------------------
2689 !> \brief interpolator_2D receives a field name as input and
2690 !! interpolates the field to model a 2D grid and time axis.
2691 !!
2692 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
2693 !! \param [in] <field_name> The name of a field that you wish to interpolate
2694 !! \param [in] <Time> The model time that you wish to interpolate to
2695 !! \param [in] <is> OPTIONAL: Index for the physics window
2696 !! \param [in] <js> OPTIONAL: Index for the physics window
2697 !! \param [out] <interp_data> The model fields with the interpolated climatology data
2698 !! \param [out] <clim_units> OPTIONAL: The units of field_name
2699 !!
2700 !! \throw FATAL "interpolator_2D : You must call interpolator_init
2701 !! before calling interpolator"
2702 !! \throw FATAL "interpolator_2D 1: file="
2703 !! \throw FATAL "interpolator_2D 2: file="
2704 !! \throw FATAL "interpolator_2D 3: file="
2705 !! \throw FATAL "interpolator_2D 4: file="
2706 !! \throw FATAL "interpolator_2D 5: file="
2707 !! \throw FATAL "interpolator_2D : No data from the previous climatology
2708 !! time but we have the next time. How did this happen?"
2709 !! \throw FATAL "Interpolator: the field name is not contained in this
2710 !! intepolate_type: "
2711 subroutine interpolator_2d(clim_type, Time, interp_data, field_name, is, js, clim_units)
2713 ! Return 2-D field interpolated to model grid and time
2714 !
2715 !
2716 ! INTENT INOUT
2717 ! clim_type : The interpolate type previously defined by a call to interpolator_init
2718 !
2719 ! INTENT IN
2720 ! field_name : The name of the field that you wish to interpolate.
2721 ! Time : The model time that you wish to interpolate to.
2722 ! is, js : The indices of the physics window.
2723 !
2724 ! INTENT OUT
2725 ! interp_data : The model field with the interpolated climatology data.
2726 ! clim_units : The units of field_name
2727 !
2728 type(interpolate_type), intent(inout) :: clim_type
2729 character(len=*) , intent(in) :: field_name
2730 type(time_type) , intent(in) :: Time
2731 real, dimension(:,:), intent(out) :: interp_data
2732 integer , intent(in) , optional :: is,js
2733 character(len=*) , intent(out), optional :: clim_units
2734 integer :: taum, taup
2735 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:)))
2736 integer :: istart,iend,jstart,jend
2737 logical :: result, found
2738 logical :: found_field=.false.
2739 integer :: modyear, modmonth, modday, modhour, modminute, modsecond
2740 integer :: climyear, climmonth, climday, climhour, climminute, climsecond
2741 integer :: year1, month1, day, hour, minute, second
2742 integer :: climatology, m
2743 type(time_type) :: t_prev, t_next
2744 type(time_type), dimension(2) :: month
2745 integer :: indexm, indexp, yearm, yearp
2746 integer :: j, i, n
2747 character(len=256) :: err_msg
2748 
2749 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
2750  call mpp_error(fatal, "interpolator_2D : You must call interpolator_init before calling interpolator")
2751 
2752 istart = 1
2753 if (present(is)) istart = is
2754 iend = istart - 1 + size(interp_data,1)
2755 
2756 jstart = 1
2757 if (present(js)) jstart = js
2758 jend = jstart - 1 + size(interp_data,2)
2759 
2760 do i= 1,size(clim_type%field_name(:))
2761 !++lwh
2762  if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) ) then
2763 !--lwh
2764 
2765  found_field=.true.
2766 
2767  if(present(clim_units)) then
2768  call mpp_get_atts(clim_type%field_type(i),units=clim_units)
2769  clim_units = chomp(clim_units)
2770  endif
2771 
2772 
2773 !----------------------------------------------------------------------
2774 ! skip the time interpolation portion of this routine if subroutine
2775 ! obtain_interpolator_time_slices has already been called on this
2776 ! stewp for this interpolate_type variable.
2777 !----------------------------------------------------------------------
2778 
2779 if ( .not. clim_type%separate_time_vary_calc) then
2780 ! print *, 'TIME INTERPOLATION NOT SEPARATED 2d--', &
2781 ! trim(clim_type%file_name), mpp_pe()
2782  if (clim_type%climatological_year) then
2783 !++lwh
2784  if (size(clim_type%time_slice) > 1) then
2785  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, modtime=year, err_msg=err_msg )
2786  if(trim(err_msg) /= '') then
2787  call mpp_error(fatal,'interpolator_2D 1: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2788  endif
2789  else
2790  taum = 1
2791  taup = 1
2792  clim_type%tweight = 0.
2793  end if
2794 !--lwh
2795  else
2796  call time_interp(time, clim_type%time_slice, clim_type%tweight, taum, taup, err_msg=err_msg )
2797  if(trim(err_msg) /= '') then
2798  call mpp_error(fatal,'interpolator_2D 2: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2799  endif
2800  endif
2801 
2802 ! If the climatology file has seasonal, a split time-line or has all the data
2803 ! read in then enter this loop.
2804 !
2805  if(clim_type%TIME_FLAG .ne. linear .or. read_all_on_init) then
2806  clim_type%itaum=taum
2807  clim_type%itaup=taup
2808  endif
2809 
2810 ! if(clim_type%TIME_FLAG .eq. BILINEAR ) then
2811 ! ! Check if delta-time is greater than delta of first two climatology time-slices.
2812 ! if ( (Time - clim_type%time_slice(taum) ) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) .or. &
2813 ! (clim_type%time_slice(taup) - Time) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) ) then
2814 ! ! The difference between the model time and the last climatology time-slice previous to the model time.
2815 ! ! We need 2 time levels. Check we have the correct data.
2816 ! itaum=0
2817 ! itaup=0
2818 ! ! Assume this is monthly data. So we need to get the data applicable to the model date but substitute
2819 ! ! the climatology year into the appropriate place.
2820 !
2821 ! call get_date(Time, modyear, modmonth, modday, modhour, modminute, modsecond)
2822 ! call get_date(clim_type%time_slice(taum), climyear, climmonth, climday, climhour, climminute, climsecond)
2823 ! clim_datem = set_date(climyear, modmonth, modday, modhour, modminute, modsecond)
2824 ! call time_interp(clim_datem, clim_type%time_slice, tweight1, taum1, taup1 )
2825 !
2826 !
2827 ! call get_date(clim_type%time_slice(taup), climyear, climmonth, climday, climhour, climminute, climsecond)
2828 ! clim_datep = set_date(climyear, modmonth, modday, modhour, modminute, modsecond)
2829 !
2830 !
2831 ! endif
2832 !
2833 ! endif
2834  if(clim_type%TIME_FLAG .eq. bilinear ) then
2835  ! Check if delta-time is greater than delta of first two climatology time-slices.
2836  if ( (time - clim_type%time_slice(taum) ) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) .or. &
2837  (clim_type%time_slice(taup) - time) > ( clim_type%time_slice(2)- clim_type%time_slice(1) ) ) then
2838  ! The difference between the model time and the last climatology time-slice previous to the model time.
2839  ! We need 2 time levels.
2840  clim_type%itaum=0
2841  clim_type%itaup=0
2842  ! Assume this is monthly data. So we need to get the data applicable to the model date but substitute
2843  ! the climatology year into the appropriate place.
2844 
2845 
2846  ! We need to get the previous months data for the climatology year before
2847  ! and after the model year.
2848  call get_date(time, modyear, modmonth, modday, modhour, modminute, modsecond)
2849  call get_date(clim_type%time_slice(taum), climyear, climmonth, climday, climhour, climminute, climsecond)
2850 
2851  climatology = 1
2852  do m = 1, size(clim_type%clim_times(:,:),2)
2853  !Assume here that a climatology is for 1 year and consists of 12 months starting in January.
2854  call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
2855  if (year1 == climyear) climatology = m
2856  enddo
2857  do m = 1,12
2858  !Find which month we are trying to look at and set clim_date[mp] to the dates spanning that.
2859  call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
2860  if ( month1 == modmonth ) then
2861 !RSHBUGFX if ( modday <= day ) then
2862  if ( modday < day ) then
2863  indexm = m-1 ; indexp = m
2864  else
2865  indexm = m ; indexp = m+1
2866  endif
2867  endif
2868 
2869  enddo
2870  if ( indexm == 0 ) then
2871  indexm = 12
2872  yearm = modyear - 1
2873  else
2874  yearm = modyear
2875  endif
2876  call get_date(clim_type%time_slice(indexm+(climatology-1)*12), &
2877  climyear, climmonth, climday, climhour, climminute, climsecond)
2878  month(1) = set_date(yearm, indexm, climday, climhour, climminute, climsecond)
2879  if ( indexp == 13 ) then
2880  indexp = 1
2881  yearp = modyear + 1
2882  else
2883  yearp = modyear
2884  endif
2885  call get_date(clim_type%time_slice(indexp+(climatology-1)*12), &
2886  climyear, climmonth, climday, climhour, climminute, climsecond)
2887  month(2) = set_date(yearp, indexp, climday, climhour, climminute, climsecond)
2888 
2889  call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg ) ! tweight3 is the time weight between the months.
2890  if ( .not. retain_cm3_bug ) then
2891  if (taum==2 .and. taup==2) clim_type%tweight3 = 1. ! protect against post-perth time_interp behavior
2892  end if
2893  if(trim(err_msg) /= '') then
2894  call mpp_error(fatal,'interpolator_2D 3: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2895  endif
2896 
2897  month(1) = clim_type%time_slice(indexm+(climatology-1)*12)
2898  month(2) = clim_type%time_slice(indexm+climatology*12)
2899  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
2900  t_prev = set_date(yearm, climmonth, climday, climhour, climminute, climsecond)
2901  call time_interp(t_prev, month, clim_type%tweight1, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
2902  if ( .not. retain_cm3_bug ) then
2903  if (taum==2 .and. taup==2) clim_type%tweight1 = 1. ! protect against post-perth time_interp behavior
2904  end if
2905  if(trim(err_msg) /= '') then
2906  call mpp_error(fatal,'interpolator_2D 4: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2907  endif
2908 
2909  month(1) = clim_type%time_slice(indexp+(climatology-1)*12)
2910  month(2) = clim_type%time_slice(indexp+climatology*12)
2911  call get_date(month(1), climyear, climmonth, climday, climhour, climminute, climsecond)
2912  t_next = set_date(yearp, climmonth, climday, climhour, climminute, climsecond)
2913  call time_interp(t_next, month, clim_type%tweight2, taum, taup, err_msg=err_msg ) !tweight1 is the time weight between the climatology years.
2914  if ( .not. retain_cm3_bug ) then
2915  if (taum==2 .and. taup==2) clim_type%tweight2 = 1. ! protect against post-perth time_interp behavior
2916  end if
2917  if(trim(err_msg) /= '') then
2918  call mpp_error(fatal,'interpolator_2D 5: '//trim(err_msg)//' file='//trim(clim_type%file_name), fatal)
2919  endif
2920 
2921 
2922  if (indexm == clim_type%indexm(i) .and. &
2923  indexp == clim_type%indexp(i) .and. &
2924  climatology == clim_type%climatology(i)) then
2925  else
2926  clim_type%indexm(i) = indexm
2927  clim_type%indexp(i) = indexp
2928  clim_type%climatology(i) = climatology
2929  call read_data(clim_type,clim_type%field_type(i), &
2930  clim_type%pmon_pyear(:,:,:,i), &
2931  clim_type%indexm(i)+(clim_type%climatology(i)-1)*12,i,time)
2932 ! Read the data for the next month in the previous climatology.
2933  call read_data(clim_type,clim_type%field_type(i), &
2934  clim_type%nmon_pyear(:,:,:,i), &
2935  clim_type%indexp(i)+(clim_type%climatology(i)-1)*12,i,time)
2936  call read_data(clim_type,clim_type%field_type(i), &
2937  clim_type%pmon_nyear(:,:,:,i), &
2938  clim_type%indexm(i)+clim_type%climatology(i)*12,i,time)
2939  call read_data(clim_type,clim_type%field_type(i), &
2940  clim_type%nmon_nyear(:,:,:,i), &
2941  clim_type%indexp(i)+clim_type%climatology(i)*12,i,time)
2942  endif
2943 
2944 
2945 
2946 
2947  else ! We are within a climatology data set
2948 
2949  if (taum /= clim_type%time_init(i,1) .or. &
2950  taup /= clim_type%time_init(i,2) ) then
2951 
2952  call read_data(clim_type,clim_type%field_type(i), clim_type%pmon_pyear(:,:,:,i), taum,i,time)
2953 ! Read the data for the next month in the previous climatology.
2954  call read_data(clim_type,clim_type%field_type(i), clim_type%nmon_pyear(:,:,:,i), taup,i,time)
2955 !RSHbug clim_type%pmon_nyear = 0.0
2956 !RSHbug clim_type%nmon_nyear = 0.0
2957 
2958 ! clim_type%pmon_nyear(:,:,:,i) = 0.0
2959 ! clim_type%nmon_nyear(:,:,:,i) = 0.0
2960 
2961 ! set to zero so when next return to bilinear section will be sure to
2962 ! have proper data (relevant when running fixed_year case for more than
2963 ! one year in a single job)
2964  clim_type%indexm(i) = 0
2965  clim_type%indexp(i) = 0
2966  clim_type%climatology(i) = 0
2967 
2968 
2969  clim_type%time_init(i,1) = taum
2970  clim_type%time_init(i,2) = taup
2971  endif
2972 ! clim_type%tweight3 = 0.0 ! This makes [pn]mon_nyear irrelevant. Set them to 0 to test.
2973  clim_type%tweight1 = 0.0 ; clim_type%tweight2 = 0.0
2974  clim_type%tweight3 = clim_type%tweight
2975  endif
2976 
2977  endif ! (BILINEAR)
2978 
2979  if(clim_type%TIME_FLAG .eq. linear .and. &
2980  (.not. read_all_on_init) ) then
2981 ! We need 2 time levels. Check we have the correct data.
2982  clim_type%itaum=0
2983  clim_type%itaup=0
2984  do n=1,size(clim_type%time_init,2)
2985  if (clim_type%time_init(i,n) .eq. taum ) clim_type%itaum = n
2986  if (clim_type%time_init(i,n) .eq. taup ) clim_type%itaup = n
2987  enddo
2988 
2989  if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0) then
2990  !Neither time is set so we need to read 2 time slices.
2991  !Set up
2992  ! field(:,:,:,1) as the previous time slice.
2993  ! field(:,:,:,2) as the next time slice.
2994  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,1,i), taum,i,time)
2995  clim_type%time_init(i,1) = taum
2996  clim_type%itaum = 1
2997  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,2,i), taup,i,time)
2998  clim_type%time_init(i,2) = taup
2999  clim_type%itaup = 2
3000  endif ! clim_type%itaum.eq.clim_type%itaup.eq.0
3001  if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0) then
3002  ! Can't think of a situation where we would have the next time level but not the previous.
3003  call mpp_error(fatal,'interpolator_2D : No data from the previous climatology time but we have&
3004  & the next time. How did this happen?')
3005  endif
3006  if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0) then
3007  !We have the previous time step but not the next time step data
3008  clim_type%itaup = 1
3009  if (clim_type%itaum .eq. 1 ) clim_type%itaup = 2
3010  call read_data(clim_type,clim_type%field_type(i), clim_type%data(:,:,:,clim_type%itaup,i), taup,i, time)
3011  clim_type%time_init(i,clim_type%itaup)=taup
3012  endif
3013  endif! TIME_FLAG .eq. LINEAR .and. (.not. read_all_on_init)
3014 
3015  endif ! (.not. separate_time_vary_calc)
3016 
3017 
3018 
3019 select case(clim_type%TIME_FLAG)
3020  case (linear)
3021  hinterp_data = (1.-clim_type%tweight)*clim_type%data(istart:iend,jstart:jend,:,clim_type%itaum,i) &
3022  + clim_type%tweight*clim_type%data(istart:iend,jstart:jend,:,clim_type%itaup,i)
3023 ! case (SEASONAL)
3024 ! Do sine fit to data at this point
3025  case (bilinear)
3026  hinterp_data = &
3027  (1.-clim_type%tweight1) * (1.-clim_type%tweight3) * clim_type%pmon_pyear(istart:iend,jstart:jend,:,i) + &
3028  (1.-clim_type%tweight2) * clim_type%tweight3 * clim_type%nmon_pyear(istart:iend,jstart:jend,:,i) + &
3029  clim_type%tweight1 * (1.-clim_type%tweight3) * clim_type%pmon_nyear(istart:iend,jstart:jend,:,i) + &
3030  clim_type%tweight2 * clim_type%tweight3 * clim_type%nmon_nyear(istart:iend,jstart:jend,:,i)
3031 
3032 end select
3033 
3034 found = .false.
3035 do j = 1,size(climo_diag_name(:))
3036  if (trim(adjustl(lowercase(climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i))))) then
3037  found = .true.
3038  exit
3039  endif
3040 enddo
3041 
3042 if (found) then
3043  if (hinterp_id(j) > 0 ) then
3044  result = send_data(hinterp_id(j),hinterp_data,time,is_in=istart,js_in=jstart)
3045  endif
3046 endif
3047 
3048  interp_data(:,:) = hinterp_data(:,:,1)
3049 
3050  endif !field_name
3051 enddo !End of i loop
3052 
3053 if( .not. found_field) then !field name is not in interpolator file.ERROR.
3054  call mpp_error(fatal,"Interpolator: the field name is not contained in this &
3055  &intepolate_type: "//trim(field_name))
3056 endif
3057 end subroutine interpolator_2d
3058 !--lwh
3059 !
3060 !#######################################################################
3061 !
3062 !---------------------------------------------------------------------
3063 !> \brief interpolator_4D_no_time_axis receives a field name as input and
3064 !! interpolates the field to model a 4D grid.
3065 !!
3066 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
3067 !! \param [in] <field_name> The name of a field that you wish to interpolate
3068 !! \param [in] <phalf> The half level model pressure field
3069 !! \param [in] <is> OPTIONAL: Index for the physics window
3070 !! \param [in] <js> OPTIONAL: Index for the physics window
3071 !! \param [out] <interp_data> The model fields with the interpolated climatology data
3072 !! \param [out] <clim_units> OPTIONAL: The units of field_name
3073 !!
3074 !! \throw FATAL "interpolator_4D_no_time_axis : You must call
3075 !! interpolator_init before calling interpolator"
3076 !! \throw FATAL "interpolator_mod: cannot use 4D interface to
3077 !! interpolator for this file"
3078 !! \throw NOTE "Interpolator: model surface pressure is greater than
3079 !! surface pressure of input data for "
3080 !! \throw NOTE "Interpolator: model top pressure is less than surface
3081 !! pressure of input data for "
3082 !! \throw FATAL "Interpolator: the field name is not contained in this
3083 !! intepolate_type: "
3084 subroutine interpolator_4d_no_time_axis(clim_type, phalf, interp_data, field_name, is,js, clim_units)
3086 ! Return 4-D field interpolated to model grid
3087 
3088 ! INTENT INOUT
3089 ! clim_type : The interpolate type previously defined by a call to interpolator_init
3090 
3091 ! INTENT IN
3092 ! field_name : The name of a field that you wish to interpolate.
3093 ! all variables within this interpolate_type variable
3094 ! will be interpolated on this call. field_name may
3095 ! be any one of the variables.
3096 ! phalf : The half level model pressure field.
3097 ! is, js : The indices of the physics window.
3098 
3099 ! INTENT OUT
3100 ! interp_data : The model fields
3101 ! clim_units : The units of field_name
3102 
3103 type(interpolate_type), intent(inout) :: clim_type
3104 character(len=*) , intent(in) :: field_name
3105 real, dimension(:,:,:), intent(in) :: phalf
3106 real, dimension(:,:,:,:), intent(out) :: interp_data
3107 integer , intent(in) , optional :: is,js
3108 character(len=*) , intent(out), optional :: clim_units
3109 integer :: ilon
3110 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:)),size(clim_type%field_name(:)))
3111 real :: p_fact(size(interp_data,1),size(interp_data,2))
3112 real :: pclim(size(clim_type%halflevs(:)))
3113 integer :: istart,iend,jstart,jend
3114 logical :: result
3115 logical :: found_field=.false.
3116 integer :: i, j, k, n
3117 
3118 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
3119  call mpp_error(fatal, "interpolator_4D_no_time_axis : You must call interpolator_init before calling interpolator")
3120 
3121 do n=2,size(clim_type%field_name(:))
3122  if (clim_type%vert_interp(n) /= clim_type%vert_interp(n-1) .or. &
3123  clim_type%out_of_bounds(n) /= clim_type%out_of_bounds(n-1)) then
3124  if (mpp_pe() == mpp_root_pe() ) then
3125  print *, 'processing file ' // trim(clim_type%file_name)
3126  endif
3127  call mpp_error (fatal, 'interpolator_mod: &
3128  &cannot use 4D interface to interpolator for this file')
3129  endif
3130 end do
3131 
3132 istart = 1
3133 if (present(is)) istart = is
3134 iend = istart - 1 + size(interp_data,1)
3135 
3136 jstart = 1
3137 if (present(js)) jstart = js
3138 jend = jstart - 1 + size(interp_data,2)
3139 
3140 do i= 1,size(clim_type%field_name(:))
3141  if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) ) then
3142  found_field=.true.
3143  exit
3144  endif
3145 end do
3146 i = 1
3147 
3148 if(present(clim_units)) then
3149  call mpp_get_atts(clim_type%field_type(i),units=clim_units)
3150  clim_units = chomp(clim_units)
3151 endif
3152 
3153 do n=1, size(clim_type%field_name(:))
3154  hinterp_data(:,:,:,n) = clim_type%data(istart:iend,jstart:jend,:,1,n)
3155 end do
3156 
3157 select case(clim_type%level_type)
3158  case(pressure)
3159  p_fact = 1.0
3160  case(sigma)
3161  p_fact = maxval(phalf,3)! max pressure in the column !(:,:,size(phalf,3))
3162 end select
3163 
3164  do i= 1, size(clim_type%field_name(:))
3165  select case(clim_type%mr(i))
3166  case(kg_m2)
3167  do k = 1,size(hinterp_data,3)
3168  hinterp_data(:,:,k,i) = hinterp_data(:,:,k,i)/((clim_type%halflevs(k+1)-clim_type%halflevs(k))*p_fact)
3169  enddo
3170  end select
3171  enddo
3172 
3173  i = 1
3174 
3175 do j = 1, size(phalf,2)
3176  do ilon=1,size(phalf,1)
3177  pclim = p_fact(ilon,j)*clim_type%halflevs
3178  if ( maxval(phalf(ilon,j,:)) > maxval(pclim) ) then
3179  if (verbose > 3) then
3180  call mpp_error(note,"Interpolator: model surface pressure&
3181  & is greater than surface pressure of input data for "&
3182  // trim(clim_type%file_name))
3183  endif
3184  select case(clim_type%out_of_bounds(i))
3185  case(constant)
3186  pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
3187  end select
3188  endif
3189  if ( minval(phalf(ilon,j,:)) < minval(pclim) ) then
3190  if (verbose > 3) then
3191  call mpp_error(note,"Interpolator: model top pressure&
3192  & is less than top pressure of input data for "&
3193  // trim(clim_type%file_name))
3194  endif
3195  select case(clim_type%out_of_bounds(i))
3196  case(constant)
3197  pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
3198  end select
3199  endif
3200  select case(clim_type%vert_interp(i))
3201  case(interp_weighted_p)
3202  call interp_weighted_scalar(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,:),interp_data(ilon,j,:,:))
3203  case(interp_linear_p)
3204  do n=1, size(clim_type%field_name(:))
3205  call interp_linear(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,n),interp_data(ilon,j,:,n))
3206  end do
3207  end select
3208  enddo
3209 enddo
3210 
3211  do i= 1, size(clim_type%field_name(:))
3212 
3213 select case(clim_type%mr(i))
3214  case(kg_m2)
3215  do k = 1,size(interp_data,3)
3216  interp_data(:,:,k,i) = interp_data(:,:,k,i)*(phalf(:,:,k+1)-phalf(:,:,k))
3217  enddo
3218 end select
3219 
3220  end do
3221 
3222 if( .not. found_field) then !field name is not in interpolator file.ERROR.
3223  call mpp_error(fatal,"Interpolator: the field name is not contained in this &
3224  &intepolate_type: "//trim(field_name))
3225 endif
3226 end subroutine interpolator_4d_no_time_axis
3227 
3228 !#######################################################################
3229 !
3230 !---------------------------------------------------------------------
3231 !> \brief interpolator_3D_no_time_axis receives a field name as input and
3232 !! interpolates the field to model a 3D grid.
3233 !!
3234 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
3235 !! \param [in] <field_name> The name of a field that you wish to interpolate
3236 !! \param [in] <phalf> The half level model pressure field
3237 !! \param [in] <is> OPTIONAL: Index for the physics window
3238 !! \param [in] <js> OPTIONAL: Index for the physics window
3239 !! \param [out] <interp_data> The model fields with the interpolated climatology data
3240 !! \param [out] <clim_units> OPTIONAL: The units of field_name
3241 !!
3242 !! \throw FATAL "interpolator_3D_no_time_axis : You must call
3243 !! interpolator_init before calling interpolator"
3244 !! \throw FATAL "interpolator_mod: cannot use 4D interface to
3245 !! interpolator for this file"
3246 !! \throw NOTE "Interpolator: model surface pressure is greater than
3247 !! climatology surface pressure for "
3248 !! \throw NOTE "Interpolator: model top pressure is less than
3249 !! climatology top pressure for "
3250 !! \throw FATAL "Interpolator: the field name is not contained in this
3251 !! intepolate_type: "
3252 subroutine interpolator_3d_no_time_axis(clim_type, phalf, interp_data, field_name, is,js, clim_units)
3254 ! Return 3-D field interpolated to model grid
3255 
3256 ! INTENT INOUT
3257 ! clim_type : The interpolate type previously defined by a call to interpolator_init
3258 
3259 ! INTENT IN
3260 ! field_name : The name of the field that you wish to interpolate.
3261 ! phalf : The half level model pressure field.
3262 ! is, js : The indices of the physics window.
3263 
3264 ! INTENT OUT
3265 ! interp_data : The model field with the interpolated climatology data.
3266 ! clim_units : The units of field_name
3267 
3268 type(interpolate_type), intent(inout) :: clim_type
3269 character(len=*) , intent(in) :: field_name
3270 real, dimension(:,:,:), intent(in) :: phalf
3271 real, dimension(:,:,:), intent(out) :: interp_data
3272 integer , intent(in) , optional :: is,js
3273 character(len=*) , intent(out), optional :: clim_units
3274 !real :: tweight, tweight1, tweight2, tweight3
3275 real :: tweight !< No description
3276 real :: tweight1 !< The time weight between the climatology years
3277 real :: tweight2 !< No description
3278 real :: tweight3 !< The time weight between the months
3279 integer :: taum, taup, ilon !< No description
3280 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:))) !< No description
3281 real :: p_fact(size(interp_data,1),size(interp_data,2)) !< No description
3282 real :: pclim(size(clim_type%halflevs(:))) !< No description
3283 integer :: istart,iend,jstart,jend !< No description
3284 logical :: result !< No description
3285 logical :: found_field=.false. !< No description
3286 integer :: i, j, k, n !< No description
3287 
3288 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
3289  call mpp_error(fatal, "interpolator_3D_no_time_axis : You must call interpolator_init before calling interpolator")
3290 
3291 istart = 1
3292 if (present(is)) istart = is
3293 iend = istart - 1 + size(interp_data,1)
3294 
3295 jstart = 1
3296 if (present(js)) jstart = js
3297 jend = jstart - 1 + size(interp_data,2)
3298 
3299 do i= 1,size(clim_type%field_name(:))
3300  if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) ) then
3301  found_field=.true.
3302  if(present(clim_units)) then
3303  call mpp_get_atts(clim_type%field_type(i),units=clim_units)
3304  clim_units = chomp(clim_units)
3305  endif
3306 
3307  hinterp_data = clim_type%data(istart:iend,jstart:jend,:,1,i)
3308 
3309 select case(clim_type%level_type)
3310  case(pressure)
3311  p_fact = 1.0
3312  case(sigma)
3313  p_fact = maxval(phalf,3)! max pressure in the column !(:,:,size(phalf,3))
3314 end select
3315 
3316 select case(clim_type%mr(i))
3317  case(kg_m2)
3318  do k = 1,size(hinterp_data,3)
3319  hinterp_data(:,:,k) = hinterp_data(:,:,k)/((clim_type%halflevs(k+1)-clim_type%halflevs(k))*p_fact)
3320  enddo
3321 end select
3322 
3323 do j = 1, size(phalf,2)
3324  do ilon=1,size(phalf,1)
3325  pclim = p_fact(ilon,j)*clim_type%halflevs
3326  if ( maxval(phalf(ilon,j,:)) > maxval(pclim) ) then
3327  if (verbose > 3) then
3328  call mpp_error(note,"Interpolator: model surface pressure&
3329  & is greater than climatology surface pressure for "&
3330  // trim(clim_type%file_name))
3331  endif
3332  select case(clim_type%out_of_bounds(i))
3333  case(constant)
3334  pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
3335  end select
3336  endif
3337  if ( minval(phalf(ilon,j,:)) < minval(pclim) ) then
3338  if (verbose > 3) then
3339  call mpp_error(note,"Interpolator: model top pressure&
3340  & is less than climatology top pressure for "&
3341  // trim(clim_type%file_name))
3342  endif
3343  select case(clim_type%out_of_bounds(i))
3344  case(constant)
3345  pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
3346  end select
3347  endif
3348  select case(clim_type%vert_interp(i))
3349  case(interp_weighted_p)
3350  call interp_weighted_scalar(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
3351  case(interp_linear_p)
3352  call interp_linear(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
3353  end select
3354  enddo
3355 enddo
3356 
3357 select case(clim_type%mr(i))
3358  case(kg_m2)
3359  do k = 1,size(interp_data,3)
3360  interp_data(:,:,k) = interp_data(:,:,k)*(phalf(:,:,k+1)-phalf(:,:,k))
3361  enddo
3362 end select
3363 
3364  endif !field_name
3365 enddo !End of i loop
3366 if( .not. found_field) then !field name is not in interpolator file.ERROR.
3367  call mpp_error(fatal,"Interpolator: the field name is not contained in this &
3368  &intepolate_type: "//trim(field_name))
3369 endif
3370 end subroutine interpolator_3d_no_time_axis
3371 
3372 !#######################################################################
3373 !
3374 !---------------------------------------------------------------------
3375 !> \brief interpolator_2D_no_time_axis receives a field name as input and
3376 !! interpolates the field to model a 2D grid.
3377 !!
3378 !! \param [inout] <clim_type> The interpolate type previously defined by a call to interpolator_init
3379 !! \param [in] <field_name> The name of a field that you wish to interpolate
3380 !! \param [in] <is> OPTIONAL: Index for the physics window
3381 !! \param [in] <js> OPTIONAL: Index for the physics window
3382 !! \param [out] <interp_data> The model fields with the interpolated climatology data
3383 !! \param [out] <clim_units> OPTIONAL: The units of field_name
3384 !!
3385 !! \throw FATAL "interpolator_2D_no_time_axis : You must call
3386 !! interpolator_init before calling interpolator"
3387 !! \throw FATAL "Interpolator: the field name is not contained in this
3388 !! intepolate_type: "
3389 subroutine interpolator_2d_no_time_axis(clim_type, interp_data, field_name, is, js, clim_units)
3391 ! Return 2-D field interpolated to model grid
3392 
3393 ! INTENT INOUT
3394 ! clim_type : The interpolate type previously defined by a call to interpolator_init
3395 
3396 ! INTENT IN
3397 ! field_name : The name of the field that you wish to interpolate.
3398 ! is, js : The indices of the physics window.
3399 
3400 ! INTENT OUT
3401 ! interp_data : The model field with the interpolated climatology data.
3402 ! clim_units : The units of field_name
3403 
3404 type(interpolate_type), intent(inout) :: clim_type
3405 character(len=*) , intent(in) :: field_name
3406 real, dimension(:,:), intent(out) :: interp_data
3407 integer , intent(in) , optional :: is,js
3408 character(len=*) , intent(out), optional :: clim_units
3409 real :: tweight, tweight1, tweight2, tweight3
3410 integer :: taum, taup, ilon
3411 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:)))
3412 real :: p_fact(size(interp_data,1),size(interp_data,2))
3413 integer :: istart,iend,jstart,jend
3414 logical :: result
3415 logical :: found_field=.false.
3416 integer :: j, k, i, n
3417 
3418 if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) &
3419  call mpp_error(fatal, "interpolator_2D_no_time_axis : You must call interpolator_init before calling interpolator")
3420 
3421 istart = 1
3422 if (present(is)) istart = is
3423 iend = istart - 1 + size(interp_data,1)
3424 
3425 jstart = 1
3426 if (present(js)) jstart = js
3427 jend = jstart - 1 + size(interp_data,2)
3428 
3429 do i= 1,size(clim_type%field_name(:))
3430  if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) ) then
3431 
3432  found_field=.true.
3433 
3434  if(present(clim_units)) then
3435  call mpp_get_atts(clim_type%field_type(i),units=clim_units)
3436  clim_units = chomp(clim_units)
3437  endif
3438 
3439  hinterp_data = clim_type%data(istart:iend,jstart:jend,:,1,i)
3440 
3441  interp_data(:,:) = hinterp_data(:,:,1)
3442 
3443  endif !field_name
3444 enddo !End of i loop
3445 
3446 if( .not. found_field) then !field name is not in interpolator file.ERROR.
3447  call mpp_error(fatal,"Interpolator: the field name is not contained in this &
3448  &intepolate_type: "//trim(field_name))
3449 endif
3450 
3451 end subroutine interpolator_2d_no_time_axis
3452 
3453 !#######################################################################
3454 !
3455 !---------------------------------------------------------------------
3456 !> \brief interpolator_end receives interpolate data as input
3457 !! and deallocates its memory.
3458 !!
3459 !! \param [inout] <clim_type> The interpolate type whose components will be deallocated
3460 subroutine interpolator_end(clim_type)
3461 ! Subroutine to deallocate the interpolate type clim_type.
3462 !
3463 ! INTENT INOUT
3464 ! clim_type : allocate type whose components will be deallocated.
3465 !
3466 type(interpolate_type), intent(inout) :: clim_type
3467 integer :: logunit
3468 
3469 logunit=stdlog()
3470 if ( mpp_pe() == mpp_root_pe() ) then
3471  write (logunit,'(/,(a))') 'Exiting interpolator, have a nice day ...'
3472 end if
3473 
3474 if (associated (clim_type%lat )) deallocate(clim_type%lat)
3475 if (associated (clim_type%lon )) deallocate(clim_type%lon)
3476 if (associated (clim_type%latb )) deallocate(clim_type%latb)
3477 if (associated (clim_type%lonb )) deallocate(clim_type%lonb)
3478 if (associated (clim_type%levs )) deallocate(clim_type%levs)
3479 if (associated (clim_type%halflevs)) deallocate(clim_type%halflevs)
3480 call horiz_interp_del(clim_type%interph)
3481 if (associated (clim_type%time_slice)) deallocate(clim_type%time_slice)
3482 if (associated (clim_type%field_type)) deallocate(clim_type%field_type)
3483 if (associated (clim_type%field_name)) deallocate(clim_type%field_name)
3484 if (associated (clim_type%time_init )) deallocate(clim_type%time_init)
3485 if (associated (clim_type%mr )) deallocate(clim_type%mr)
3486 if (associated (clim_type%data)) then
3487  deallocate(clim_type%data)
3488 endif
3489 if (associated (clim_type%pmon_pyear)) then
3490  deallocate(clim_type%pmon_pyear)
3491  deallocate(clim_type%pmon_nyear)
3492  deallocate(clim_type%nmon_nyear)
3493  deallocate(clim_type%nmon_pyear)
3494 endif
3495 
3496 !! RSH mod
3497 if( .not. (clim_type%TIME_FLAG .eq. linear .and. &
3498 ! read_all_on_init)) .or. clim_type%TIME_FLAG .eq. BILINEAR ) then
3499  read_all_on_init) ) then
3500  call mpp_close(clim_type%unit)
3501 endif
3502 
3503 
3504 module_is_initialized = .false.
3505 
3506 end subroutine interpolator_end
3507 !
3508 !#######################################################################
3509 !
3510 !---------------------------------------------------------------------
3511 !> \brief read_data receives various climate data as inputs and
3512 !! returns a horizontally interpolated climatology field.
3513 !!
3514 !! \param [in] <clim_type> The interpolate type which contains the data
3515 !! \param [in] <src_field> The field type
3516 !! \param [in] <nt> The index of the time slice of the climatology that you wish to read
3517 !! \param [in] <i> OPTIONAL: The index of the field name that you are trying to read
3518 !! \param [in] <Time> OPTIONAL: The model time. Used for diagnostic purposes only
3519 !! \param [out] <hdata> The horizontally interpolated climatology field. This
3520 ! field will still be on the climatology vertical grid
3521 subroutine read_data(clim_type,src_field, hdata, nt,i, Time)
3523 ! INTENT IN
3524 ! clim_type : The interpolate type which contains the data
3525 ! src_field : The field type
3526 ! nt : The index of the time slice of the climatology that you wish to read.
3527 ! i : The index of the field name that you are trying to read. (optional)
3528 ! Time : The model time. Used for diagnostic purposes only. (optional)
3529 !
3530 ! INTENT OUT
3531 !
3532 ! hdata : The horizontally interpolated climatology field. This
3533 ! field will still be on the climatology vertical grid.
3534 !
3535 type(interpolate_type) , intent(in) :: clim_type
3536 type(fieldtype) , intent(in) :: src_field
3537 integer , intent(in) :: nt
3538 real , intent(out) :: hdata(:,:,:)
3539 integer , optional, intent(in) :: i
3540 type(time_type), optional, intent(in) :: time
3541 
3542 integer :: k, km
3543 ! sjs
3544 real, allocatable :: climdata(:,:,:), climdata2(:,:,:)
3545 
3546  allocate(climdata(size(clim_type%lon(:)),size(clim_type%lat(:)), &
3547  size(clim_type%levs(:))))
3548 
3549  call mpp_read(clim_type%unit,src_field, climdata,nt)
3550 
3551 ! if vertical index increases upward, flip the data so that lowest
3552 ! pressure level data is at index 1, rather than the highest pressure
3553 ! level data. the indices themselves were previously flipped.
3554  if (clim_type%vertical_indices == increasing_upward) then
3555  allocate(climdata2(size(clim_type%lon(:)), &
3556  size(clim_type%lat(:)), &
3557  size(clim_type%levs(:))))
3558  km = size(clim_type%levs(:))
3559  do k=1, km
3560  climdata2(:,:,k) = climdata(:,:,km+1-k)
3561  end do
3562  climdata = climdata2
3563  deallocate (climdata2)
3564  endif
3565 
3566  call horiz_interp(clim_type%interph, climdata, hdata)
3567  if (clim_diag_initialized) &
3568  call diag_read_data(clim_type,climdata,i, time)
3569  deallocate(climdata)
3570 
3571 
3572 end subroutine read_data
3573 
3574 !#######################################################################
3575 !
3576 !---------------------------------------------------------------------
3577 !> \brief read_data_no_time_axis receives various climate data as inputs and
3578 !! returns a horizontally interpolated climatology field without the
3579 !! time axis.
3580 !!
3581 !! \param [in] <clim_type> The interpolate type which contains the data
3582 !! \param [in] <src_field> The field type
3583 !! \param [in] <i> OPTIONAL: The index of the field name that you are trying to read
3584 !! \param [out] <hdata> The horizontally interpolated climatology field. This
3585 ! field will still be on the climatology vertical grid
3586 subroutine read_data_no_time_axis(clim_type,src_field, hdata, i)
3588 ! INTENT IN
3589 ! clim_type : The interpolate type which contains the data
3590 ! src_field : The field type
3591 ! i : The index of the field name that you are trying to read. (optional)
3592 
3593 ! INTENT OUT
3594 
3595 ! hdata : The horizontally interpolated climatology field. This
3596 ! field will still be on the climatology vertical grid.
3597 
3598 type(interpolate_type) , intent(in) :: clim_type
3599 type(fieldtype) , intent(in) :: src_field
3600 real , intent(out) :: hdata(:,:,:)
3601 integer , optional, intent(in) :: i
3602 
3603 integer :: k, km
3604 ! sjs
3605 real, allocatable :: climdata(:,:,:), climdata2(:,:,:)
3606 
3607  allocate(climdata(size(clim_type%lon(:)),size(clim_type%lat(:)), size(clim_type%levs(:))))
3608 
3609  call mpp_read(clim_type%unit,src_field, climdata)
3610 
3611 ! if vertical index increases upward, flip the data so that lowest
3612 ! pressure level data is at index 1, rather than the highest pressure
3613 ! level data. the indices themselves were previously flipped.
3614  if (clim_type%vertical_indices == increasing_upward) then
3615  allocate(climdata2(size(clim_type%lon(:)), &
3616  size(clim_type%lat(:)), &
3617  size(clim_type%levs(:))))
3618  km = size(clim_type%levs(:))
3619  do k=1, km
3620  climdata2(:,:,k) = climdata(:,:,km+1-k)
3621  end do
3622  climdata = climdata2
3623  deallocate (climdata2)
3624  endif
3625 
3626  call horiz_interp(clim_type%interph, climdata, hdata)
3627  deallocate(climdata)
3628 
3629 end subroutine read_data_no_time_axis
3630 
3631 !#######################################################################
3632 !
3633 !---------------------------------------------------------------------
3634 !> \brief diag_read_data receives the data read in by read_data as
3635 !! inputs and runs a diagnosis.
3636 !!
3637 !! \param [in] <clim_type> The interpolate type which contains the data
3638 !! \param [in] <model_data> The data read in from file that is being diagnosed
3639 !! \param [in] <i> The index of the field name that you are diagnosing
3640 !! \param [in] <Time> The model time.
3641 subroutine diag_read_data(clim_type,model_data, i, Time)
3643 ! A routine to diagnose the data read in by read_data
3644 !
3645 ! INTENT IN
3646 ! clim_type : The interpolate type.
3647 ! model_data : The data read in from file that is being diagnosed.
3648 ! i : The index of the field name that you are diagnosing.
3649 ! Time : The model time
3650 !
3651 type(interpolate_type), intent(in) :: clim_type
3652 real , intent(in) :: model_data(:,:,:)
3653 integer , intent(in) :: i
3654 type(time_type) , intent(in) :: Time
3655 
3656 integer :: j,k
3657 real :: col_data(size(model_data,1),size(model_data,2))
3658 logical :: result, found
3659 
3660 
3661 found = .false.
3662 do j = 1,size(climo_diag_name(:))
3663  if (trim(adjustl(lowercase(climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i))))) then
3664  found = .true.
3665  exit
3666  endif
3667 enddo
3668 
3669 if(found) then
3670  if(climo_diag_id(j)>0) then
3671  col_data(:,:)=0.0
3672  do k=1,size(model_data,3)
3673  col_data(:,:) = col_data(:,:) + &
3674  model_data(:,:,k)* &
3675  (clim_type%halflevs(k+1)-clim_type%halflevs(k))/grav
3676  enddo
3677  result = send_data(climo_diag_id(j),col_data(clim_type%is:clim_type%ie,clim_type%js:clim_type%je),time)
3678  endif
3679 endif
3680 
3681 end subroutine diag_read_data
3682 !
3683 !#######################################################################
3684 !
3685 !++lwh
3686 !
3687 !---------------------------------------------------------------------
3688 !> \brief query_interpolator receives an interpolate type as input
3689 !! and returns the number of fields and field names.
3690 !!
3691 !! \param [in] <clim_type> The interpolate type which contains the data
3692 !! \param [out] <nfields> OPTIONAL: No description
3693 !! \param [out] <field_names> OPTIONAL: No description
3694 subroutine query_interpolator( clim_type, nfields, field_names )
3696 ! Query an interpolate_type variable to find the number of fields and field names.
3697 !
3698 type(interpolate_type), intent(in) :: clim_type
3699 integer, intent(out), optional :: nfields
3700 character(len=*), dimension(:), intent(out), optional :: field_names
3701 
3702 if( present( nfields ) ) nfields = SIZE( clim_type%field_name(:) )
3703 if( present( field_names ) ) field_names = clim_type%field_name
3704 
3705 end subroutine query_interpolator
3706 !--lwh
3707 !
3708 !#######################################################################
3709 !
3710 !---------------------------------------------------------------------
3711 !> \brief chomp receives a string from NetCDF files and removes
3712 !! CHAR(0) from the end of this string.
3713 !!
3714 !! \param [in] <string> The string from the NetCDF file
3715 function chomp(string)
3717 ! A function to remove CHAR(0) from the end of strings read from NetCDF files.
3718 !
3719 character(len=*), intent(in) :: string
3720 character(len=64) :: chomp
3721 
3722 integer :: len
3723 
3724 len = len_trim(string)
3725 if (string(len:len) == char(0)) len = len -1
3726 
3727 chomp = string(:len)
3728 
3729 end function chomp
3730 !
3731 !#################################################################
3732 !
3733 !
3734 !---------------------------------------------------------------------
3735 !> \brief interp_weighted_scalar_2D receives the variables grdin,
3736 !! grdout, and datin as inputs and returns datout.
3737 !!
3738 !! \param [in] <grdin> No description
3739 !! \param [in] <grdout> No description
3740 !! \param [in] <datin> No description
3741 !! \param [out] <datout> No description
3742  subroutine interp_weighted_scalar_2d (grdin, grdout, datin, datout )
3743 real, intent(in), dimension(:) :: grdin, grdout
3744 real, intent(in), dimension(:,:) :: datin
3745 real, intent(out), dimension(:,:) :: datout
3746 
3747 integer :: j, k, n
3748 
3749 if (size(grdin(:)).ne. (size(datin,1)+1)) &
3750  call mpp_error(fatal,'interp_weighted_scalar : input data and pressure do not have the same number of levels')
3751 if (size(grdout(:)).ne. (size(datout,1 )+1)) &
3752  call mpp_error(fatal,'interp_weighted_scalar : output data and pressure do not have the same number of levels')
3753 
3754  do k = 1, size(datout,1 )
3755  datout(k,:) = 0.0
3756 
3757  do j = 1, size(datin,1 )
3758 
3759  if ( grdin(j) <= grdout(k) .and. &
3760  grdin(j+1) >= grdout(k) .and. &
3761  grdin(j+1) <= grdout(k+1) ) then
3762 
3763  do n= 1, size(datin,2)
3764  datout(k,n) = datout(k,n) + datin(j,n)*(grdin(j+1)-grdout(k))
3765  end do
3766 
3767  else if ( grdin(j) >= grdout(k) .and. &
3768  grdin(j) <= grdout(k+1) .and. &
3769  grdin(j+1) >= grdout(k+1) ) then
3770 
3771  do n= 1, size(datin,2)
3772  datout(k,n) = datout(k,n) + datin(j,n)*(grdout(k+1)-grdin(j))
3773  end do
3774 
3775  else if ( grdin(j) >= grdout(k) .and. &
3776  grdin(j+1) <= grdout(k+1) ) then
3777 
3778  do n= 1, size(datin,2)
3779  datout(k,n) = datout(k,n) + datin(j,n)*(grdin(j+1)-grdin(j))
3780  end do
3781 
3782  else if ( grdin(j) <= grdout(k) .and. &
3783  grdin(j+1) >= grdout(k+1) ) then
3784 
3785  do n= 1, size(datin,2)
3786  datout(k,n) = datout(k,n) + datin(j,n)*(grdout(k+1)-grdout(k))
3787 
3788  end do
3789  endif
3790 
3791  enddo
3792 
3793  do n= 1, size(datin,2)
3794  datout(k,n) = datout(k,n)/(grdout(k+1)-grdout(k))
3795  end do
3796 
3797  enddo
3798 
3799 end subroutine interp_weighted_scalar_2d
3800 
3801 
3802 !
3803 !---------------------------------------------------------------------
3804 !> \brief interp_weighted_scalar_1D receives the variables grdin,
3805 !! grdout, and datin as inputs and returns datout.
3806 !!
3807 !! \param [in] <grdin> No description
3808 !! \param [in] <grdout> No description
3809 !! \param [in] <datin> No description
3810 !! \param [out] <datout> No description
3811  subroutine interp_weighted_scalar_1d (grdin, grdout, datin, datout )
3812 real, intent(in), dimension(:) :: grdin, grdout, datin
3813 real, intent(out), dimension(:) :: datout
3814 
3815 integer :: j, k
3816 
3817 if (size(grdin(:)).ne. (size(datin(:))+1)) &
3818  call mpp_error(fatal,'interp_weighted_scalar : input data and pressure do not have the same number of levels')
3819 if (size(grdout(:)).ne. (size(datout(:))+1)) &
3820  call mpp_error(fatal,'interp_weighted_scalar : output data and pressure do not have the same number of levels')
3821 
3822  do k = 1, size(datout(:))
3823  datout(k) = 0.0
3824 
3825  do j = 1, size(datin(:))
3826 
3827  if ( grdin(j) <= grdout(k) .and. &
3828  grdin(j+1) >= grdout(k) .and. &
3829  grdin(j+1) <= grdout(k+1) ) then
3830 
3831  datout(k) = datout(k) + datin(j)*(grdin(j+1)-grdout(k))
3832 
3833  else if ( grdin(j) >= grdout(k) .and. &
3834  grdin(j) <= grdout(k+1) .and. &
3835  grdin(j+1) >= grdout(k+1) ) then
3836 
3837  datout(k) = datout(k) + datin(j)*(grdout(k+1)-grdin(j))
3838 
3839  else if ( grdin(j) >= grdout(k) .and. &
3840  grdin(j+1) <= grdout(k+1) ) then
3841 
3842  datout(k) = datout(k) + datin(j)*(grdin(j+1)-grdin(j))
3843 
3844  else if ( grdin(j) <= grdout(k) .and. &
3845  grdin(j+1) >= grdout(k+1) ) then
3846 
3847  datout(k) = datout(k) + datin(j)*(grdout(k+1)-grdout(k))
3848 
3849  endif
3850 
3851  enddo
3852 
3853  datout(k) = datout(k)/(grdout(k+1)-grdout(k))
3854 
3855  enddo
3856 
3857 end subroutine interp_weighted_scalar_1d
3858 !
3859 !#################################################################
3860 !
3861 !---------------------------------------------------------------------
3862 !> \brief interp_linear receives the variables grdin,
3863 !! grdout, and datin as inputs and returns a linear
3864 !! interpolation.
3865 !!
3866 !! \param [in] <grdin> No description
3867 !! \param [in] <grdout> No description
3868 !! \param [in] <datin> No description
3869 !! \param [out] <datout> No description
3870 subroutine interp_linear ( grdin, grdout, datin, datout )
3871 real, intent(in), dimension(:) :: grdin, grdout, datin
3872 real, intent(out), dimension(:) :: datout
3873 
3874 integer :: j, k, n
3875 real :: wt
3876 
3877 
3878 if (size(grdin(:)).ne. (size(datin(:))+1)) &
3879  call mpp_error(fatal,'interp_linear : input data and pressure do not have the same number of levels')
3880 if (size(grdout(:)).ne. (size(datout(:))+1)) &
3881  call mpp_error(fatal,'interp_linear : output data and pressure do not have the same number of levels')
3882 
3883 
3884  n = size(grdin(:))
3885 
3886  do k= 1, size(datout(:))
3887 
3888  ! ascending grid values
3889  if (grdin(1) < grdin(n)) then
3890  do j = 2, size(grdin(:))-1
3891  if (grdout(k) <= grdin(j)) exit
3892  enddo
3893  ! descending grid values
3894  else
3895  do j = size(grdin(:)), 3, -1
3896  if (grdout(k) <= grdin(j-1)) exit
3897  enddo
3898  endif
3899 
3900  ! linear interpolation
3901  wt = (grdout(k)-grdin(j-1)) / (grdin(j)-grdin(j-1))
3902 !print '(a,2i3,4f6.1)', 'k,j=',k,j,grdout(k),grdin(j-1),grdin(j),wt
3903  ! constant value extrapolation
3904  ! wt = min(max(wt,0.),1.)
3905 
3906  datout(k) = (1.-wt)*datin(j-1) + wt*datin(j)
3907 
3908  enddo
3909 
3910 end subroutine interp_linear
3911 !
3912 !########################################################################
3913 
3914 end module interpolator_mod
3915 !
3916 !#######################################################################
3917 !
3918 #ifdef test_interp
3919 program test
3920 
3921 #ifdef INTERNAL_FILE_NML
3922 use mpp_mod, only: input_nml_file
3923 #endif
3924 
3925 use mpp_mod
3926 use mpp_io_mod
3927 use mpp_domains_mod
3928 use fms_mod
3929 use time_manager_mod
3930 use diag_manager_mod!, only : diag_axis_init, file_exist, MPP_NPES, &
3931  ! MPP_PE, REGISTER_DIAG_FIELD, SEND_DATA, SET_DATE,&
3932  ! SET_TIME
3933 
3934 use interpolator_mod
3935 !use sulfate_mod
3936 !use ozone_mod
3937 use constants_mod, only : grav, constants_init, pi
3939 
3940 implicit none
3941 integer, parameter :: nsteps_per_day = 8, ndays = 16
3942 real, parameter :: delt = 1.0/nsteps_per_day
3943 ! integer, parameter :: nxd = 144, nyd = 90, ntsteps = 240, two_delt = 2*delt
3944 integer, parameter :: nxd = 20, nyd = 40, ntsteps = nsteps_per_day*ndays, two_delt = 2*delt
3945 integer :: delt_days, delt_secs
3946 integer, parameter :: max_fields = 20 ! maximum number of fields to be interpolated
3947 
3948 integer :: i,k,n,level
3949 integer :: unit, io_status
3950 integer :: ndivs
3951 integer :: jscomp, jecomp, iscomp, iecomp, isd,ied,jsd,jed
3952 integer :: numfields, domain_layout(2)
3953 integer :: num_nbrs, nbins,axes(3), interp_diagnostic_id
3954 integer :: column_diagnostic_id1, column_diagnostic_id(max_fields)
3955 
3956 real :: missing_value = -1.e10
3957 
3958 character(len=1) :: dest_grid
3959 character(len=128) :: src_file, file_out, title, units, colaer
3960 logical :: vector_field=.false., result
3961 
3962 type(axistype), allocatable, dimension(:) :: axes_out, axes_src
3963 type(axistype) :: time_axis
3964 type(fieldtype), allocatable, dimension(:) :: fields
3965 type(fieldtype) :: dest_field(max_fields), src_field(max_fields), field_geolon_t, &
3966  field_geolat_t, field_geolon_c, field_geolat_c
3967 type(atttype), allocatable, dimension(:) :: global_atts
3968 type(domain2d) :: domain
3969 type(time_type) :: model_time
3970 
3971 type(interpolate_type) :: o3, aerosol
3972 
3973 real, dimension(:,:), allocatable :: col_data
3974 real, dimension(:,:,:), allocatable :: model_data, p_half, p_full
3975 real, dimension(:), allocatable :: latb_mod(:,:),lonb_mod(:,:),lon_mod(:),lat_mod(:)
3976 real :: dx,dy
3977 real :: dtr,tpi
3978 real :: p_bot,p_top,lambda
3979 character(len=64) :: names(13)
3980 data names(:) /"so4_anthro","so4_natural","organic_carbon","black_carbon","sea_salt",&
3981 "anthro_dust_0.2","anthro_dust_0.8","anthro_dust_2.0","anthro_dust_8.0",&
3982 "natural_dust_0.2","natural_dust_0.8","natural_dust_2.0","natural_dust_8.0"/
3983 
3984 integer :: out_of_bounds(1)
3985 data out_of_bounds / constant/!, CONSTANT/!, CONSTANT, CONSTANT, CONSTANT, CONSTANT, CONSTANT, CONSTANT, CONSTANT, &
3986 !ZERO, ZERO, ZERO, ZERO /
3987 
3988 namelist /interpolator_nml/ src_file
3989 
3990 ! initialize communication modules
3991 
3992 delt_days = int(delt)
3993 delt_secs = int(delt*seconds_per_day) - delt_days*seconds_per_day
3994 
3995 write(*,*) delt, delt_days,delt_secs
3996 
3997 call mpp_init
3998 call mpp_io_init
3999 call mpp_domains_init
4001 call diag_manager_init
4002 call constants_init
4003 call time_interp_init
4004 
4005 level = 18
4006 tpi = 2.0*pi !4.*acos(0.)
4007 dtr = tpi/360.
4008 
4009 src_file = 'src_file' ! input file containing fields to be interpolated
4010 
4011 
4012 model_time = set_date(1979,12,1,0,0,0)
4013 
4014 !if (numfields.ne.2.and.vector_field) call mpp_error(FATAL,'2 components of vector field not specified')
4015 !if (numfields.gt.1.and..not.vector_field) call mpp_error(FATAL,'only 1 scalar at a time')
4016 !if (numfields .gt. max_fields) call mpp_error(FATAL,'max num fields exceeded')
4017 
4018 !--------------------------------------------------------------------
4019 ! namelist input
4020 !--------------------------------------------------------------------
4021 
4022 #ifdef INTERNAL_FILE_NML
4023  read (input_nml_file, nml=interpolator_nml, iostat=io)
4024  ierr = check_nml_error(io, 'interpolator_nml')
4025 #else
4026  call mpp_open(unit, 'input.nml', action=mpp_rdonly, form=mpp_ascii)
4027  read (unit, interpolator_nml,iostat=io_status)
4028  if (io_status .gt. 0) then
4029  call mpp_error(fatal,'=>Error reading interpolator_nml')
4030  endif
4031 call mpp_close(unit)
4032 #endif
4033 
4034 ! decompose model grid points
4035 ! mapping can get expensive so we distribute the task at this level
4036 
4037 ndivs = mpp_npes()
4038 
4039 call mpp_define_layout ((/1,nxd,1,nyd/), ndivs, domain_layout)
4040 call mpp_define_domains((/1,nxd,1,nyd/),domain_layout, domain,xhalo=0,yhalo=0)
4041 call mpp_get_data_domain(domain,isd,ied,jsd,jed)
4042 call mpp_get_compute_domain (domain, iscomp, iecomp, jscomp, jecomp)
4043 
4044 allocate(lonb_mod(nxd+1,nyd+1),lon_mod(nxd))
4045 allocate(latb_mod(nxd+1,nyd+1),lat_mod(nyd))
4046 allocate(col_data(isd:ied,jsd:jed)) ; col_data = 0.0
4047 allocate(p_half(isd:ied,jsd:jed,level+1),p_full(isd:ied,jsd:jed,level))
4048 p_top = 1.0
4049 p_bot = 101325.0 !Model level in Pa
4050 lambda = -1.0*log(p_top/p_bot)/(level+1)
4051 
4052 p_half(:,:,level+1) = p_bot
4053 do i=level,1,-1
4054  p_half(:,:,i)=p_half(:,:,i+1)*exp(-1.0*lambda)
4055 enddo
4056 do i=1,level
4057  p_full(:,:,i)=(p_half(:,:,i+1)+p_half(:,:,i))/2.0
4058 enddo
4059 
4060 allocate(model_data(isd:ied,jsd:jed,level))
4061 
4062 dx = 360./nxd
4063 dy = 180./nyd
4064 do i = 1,nxd+1
4065  lonb_mod(i,:) = (i-1)*dx
4066 enddo
4067 do i = 1,nyd+1
4068  latb_mod(:,i) = -90. + (i-1)*dy
4069 enddo
4070 do i=1,nxd
4071  lon_mod(i)=(lonb_mod(i+1,1)+lonb_mod(i,1))/2.0
4072 enddo
4073 do i=1,nyd
4074  lat_mod(i)=(latb_mod(1,i+1)+latb_mod(1,i))/2.0
4075 enddo
4076 
4077 lonb_mod = lonb_mod * dtr
4078 latb_mod = latb_mod * dtr
4079 
4080  axes(1) = diag_axis_init('x',lon_mod,units='degrees',cart_name='x',domain2=domain)
4081  axes(2) = diag_axis_init('y',lat_mod,units='degrees',cart_name='y',domain2=domain)
4082  axes(3) = diag_axis_init('z',p_full(isd,jsd,:),units='mb',cart_name='z')
4083 
4084 interp_diagnostic_id = register_diag_field('interp','ozone',axes(1:3),model_time,&
4085  'interpolated_ozone_clim', 'kg/kg', missing_value)
4086 column_diagnostic_id1 = register_diag_field('interp','colozone',axes(1:2),model_time,&
4087  'column_ozone_clim', 'kg/m2', missing_value)
4088 
4089 do i=1,size(names(:))
4090 colaer = 'col'//trim(names(i))
4091 column_diagnostic_id(i) = register_diag_field('interp',colaer,axes(1:2),model_time,&
4092  'column_aerosol_clim', 'kg/m2', missing_value)
4093 enddo
4094 
4095 
4096 call ozone_init(o3,lonb_mod(isd:ied+1,jsd:jed+1), latb_mod(isd:ied+1,jsd:jed+1), axes, model_time, &
4097  data_out_of_bounds=out_of_bounds)
4098 call init_clim_diag(o3, axes, model_time)
4099 call sulfate_init(aerosol,lonb_mod(isd:ied+1,jsd:jed+1), latb_mod(isd:ied+1,jsd:jed+1), names, &
4100  data_out_of_bounds=(/constant/) )
4101 call init_clim_diag(aerosol, axes, model_time)
4102 
4103 do n=1,ntsteps
4104  if( mpp_pe() == mpp_root_pe() ) write(*,*) n
4105 
4106  call get_ozone(o3,model_time,p_half,model_data)
4107 
4108  if(interp_diagnostic_id>0) &
4109  result = send_data(interp_diagnostic_id,&
4110  model_data(iscomp:iecomp,jscomp:jecomp,:),model_time)
4111 
4112  if(column_diagnostic_id1>0) then
4113 
4114  col_data(iscomp:iecomp,jscomp:jecomp)=0.0
4115  do k=1,level
4116  col_data(iscomp:iecomp,jscomp:jecomp)= col_data(iscomp:iecomp,jscomp:jecomp)+ &
4117  model_data(iscomp:iecomp,jscomp:jecomp,k)* &
4118  (p_half(iscomp:iecomp,jscomp:jecomp,k+1)-p_half(iscomp:iecomp,jscomp:jecomp,k))/grav
4119  enddo
4120  result = send_data(column_diagnostic_id1,col_data(:,:),model_time)
4121  endif
4122 
4123 
4124 
4125  do i=1,size(names(:))
4126 
4127 call get_anthro_sulfate(aerosol,model_time,p_half,names(i),model_data,clim_units=units)
4128 
4129  if(column_diagnostic_id(i)>0) then
4130 
4131  col_data(iscomp:iecomp,jscomp:jecomp)=0.0
4132  do k=1,level
4133  if (trim(adjustl(lowercase(units))) .eq. 'kg/m^2') then
4134  col_data(iscomp:iecomp,jscomp:jecomp)= col_data(iscomp:iecomp,jscomp:jecomp)+ &
4135  model_data(iscomp:iecomp,jscomp:jecomp,k)
4136  else
4137  col_data(iscomp:iecomp,jscomp:jecomp)= col_data(iscomp:iecomp,jscomp:jecomp)+ &
4138  model_data(iscomp:iecomp,jscomp:jecomp,k)* &
4139  (p_half(iscomp:iecomp,jscomp:jecomp,k+1)-p_half(iscomp:iecomp,jscomp:jecomp,k))/grav
4140  endif
4141  enddo
4142  result = send_data(column_diagnostic_id(i),&
4143  col_data(iscomp:iecomp,jscomp:jecomp),model_time)
4144  endif
4145 
4146  enddo
4147 
4148  model_time = model_time + set_time(delt_secs,delt_days)
4149 
4150  if (n.eq. ntsteps) call diag_manager_end(model_time)
4151 
4152 enddo
4153 
4154 call interpolator_end(aerosol)
4155 call interpolator_end(o3)
4156 
4157 deallocate(lonb_mod, lon_mod, latb_mod,lat_mod, col_data, p_half, p_full, model_data)
4158 
4159 call mpp_exit
4160 
4161 contains
4162 !
4163 !#######################################################################
4164 !
4165 subroutine sulfate_init(aerosol,lonb, latb, names, data_out_of_bounds, vert_interp, units)
4166 type(interpolate_type), intent(inout) :: aerosol
4167 real, intent(in) :: lonb(:,:),latb(:,:)
4168 character(len=64), intent(in) :: names(:)
4169 integer, intent(in) :: data_out_of_bounds(:)
4170 integer, intent(in), optional :: vert_interp(:)
4171 character(len=*), intent(out),optional :: units(:)
4172 
4173 if (.not. file_exist("INPUT/aerosol.climatology.nc") ) return
4174 call interpolator_init( aerosol, "aerosol.climatology.nc", lonb, latb, &
4175  data_names=names, data_out_of_bounds=data_out_of_bounds, &
4176  vert_interp=vert_interp, clim_units=units )
4177 
4178 end subroutine sulfate_init
4179 !
4180 !#######################################################################
4181 !
4182 subroutine get_anthro_sulfate( sulfate, model_time, p_half, name, model_data, is, js, clim_units )
4183 type(interpolate_type), intent(inout) :: sulfate
4184 type(time_type), intent(in) :: model_time
4185 real, intent(in) :: p_half(:,:,:)
4186 character(len=*), intent(in) :: name
4187 character(len=*), intent(out), optional :: clim_units
4188 real, intent(out) :: model_data(:,:,:)
4189 integer, intent(in), optional :: is,js
4190 
4191 call interpolator( sulfate, model_time, p_half, model_data, name, is, js, clim_units)
4192 
4193 end subroutine get_anthro_sulfate
4194 !
4195 !#######################################################################
4196 !
4197 subroutine ozone_init( o3, lonb, latb, axes, model_time, data_out_of_bounds, vert_interp )
4198 real, intent(in) :: lonb(:,:),latb(:,:)
4199 integer, intent(in) :: axes(:)
4200 type(time_type), intent(in) :: model_time
4201 type(interpolate_type),intent(inout) :: o3
4202 integer, intent(in) :: data_out_of_bounds(:)
4203 integer, intent(in), optional :: vert_interp(:)
4204 
4205 if (.not. file_exist("INPUT/o3.climatology.nc") ) return
4206 call interpolator_init( o3, "o3.climatology.nc", lonb, latb, &
4207  data_out_of_bounds=data_out_of_bounds, vert_interp=vert_interp )
4208 
4209 end subroutine ozone_init
4210 !
4211 !#######################################################################
4212 !
4213 subroutine get_ozone( o3, model_time, p_half, model_data, is, js )
4214 type(interpolate_type),intent(inout) :: o3
4215 type(time_type), intent(in) :: model_time
4216 real, intent(in) :: p_half(:,:,:)
4217 real, intent(out) :: model_data(:,:,:)
4218 integer, intent(in), optional :: is,js
4219 
4220 call interpolator( o3, model_time, p_half, model_data, "ozone", is, js)
4221 
4222 end subroutine get_ozone
4223 
4224 end program test
4225 
4226 #endif
Definition: fms.F90:20
subroutine, public time_interp_init()
subroutine, public get_date(time, year, month, day, hour, minute, second, tick, err_msg)
integer natt
No description.
subroutine sulfate_init(aerosol, lonb, latb, names, data_out_of_bounds, vert_interp, units)
integer, parameter f_p
Higher precision (kind=16) for grid geometrical factors.
integer, parameter, public noleap
character(len=64), dimension(max_diag_fields) climo_diag_name
No description.
real(fp), parameter, public zero
type(time_type) function, public set_date_julian(year, month, day, hour, minute, second)
integer, parameter seasonal
subroutine diag_read_data(clim_type, model_data, i, Time)
diag_read_data receives the data read in by read_data as inputs and runs a diagnosis.
logical module_is_initialized
subroutine, public interpolator_init(clim_type, file_name, lonb_mod, latb_mod, data_names, data_out_of_bounds, vert_interp, clim_units, single_year_file)
interpolator_init receives various data as input in order to initialize interpolating.
subroutine, public get_date_no_leap(time, year, month, day, hour, minute, second)
subroutine interpolator_3d(clim_type, Time, phalf, interp_data, field_name, is, js, clim_units)
interpolator_3D receives a field name as input and interpolates the field to model a 3D grid and time...
subroutine, public horiz_interp_del(Interp)
subroutine get_ozone(o3, model_time, p_half, model_data, is, js)
type(time_type) function, public get_base_time()
subroutine, public interpolate_type_eq(Out, In)
interpolator_type_eq receives the variable In and Out as input and returns Out.
subroutine, public query_interpolator(clim_type, nfields, field_names)
query_interpolator receives an interpolate type as input and returns the number of fields and field n...
subroutine, public interpolator_end(clim_type)
interpolator_end receives interpolate data as input and deallocates its memory.
character(len=32) units
No description.
integer, parameter, public interp_log_p
Flags to indicate the type of vertical interpolation.
type(axistype), dimension(:), allocatable axes
No description.
subroutine, public diag_manager_end(time)
type(fieldtype), dimension(:), allocatable varfields
No description.
integer, parameter sigma
Flags to indicate where climatology pressure levels are pressure or sigma levels. ...
integer, parameter no_conv
Definition: mpp.F90:39
integer function, public check_nml_error(IOSTAT, NML_NAME)
Definition: fms.F90:658
subroutine interpolator_2d(clim_type, Time, interp_data, field_name, is, js, clim_units)
interpolator_2D receives a field name as input and interpolates the field to model a 2D grid and time...
integer, parameter max_fields
integer ntime
No description.
subroutine interp_linear(grdin, grdout, datin, datout)
interp_linear receives the variables grdin, grdout, and datin as inputs and returns a linear interpol...
character(len=32) name
integer nlon
No description.
subroutine ozone_init(o3, lonb, latb, axes, model_time, data_out_of_bounds, vert_interp)
l_size ! loop over number of fields ke do je do ie to je n if(.NOT. d_comm%R_do_buf(list)) cycle from_pe
logical clim_diag_initialized
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
integer, parameter linear
subroutine, public set_calendar_type(type, err_msg)
Redundant climatology data between fields.
character(len=64) function chomp(string)
chomp receives a string from NetCDF files and removes CHAR(0) from the end of this string...
integer nvar
No description.
subroutine, public fms_init(localcomm)
Definition: fms.F90:353
logical retain_cm3_bug
No description.
subroutine interp_weighted_scalar_1d(grdin, grdout, datin, datout)
interp_weighted_scalar_1D receives the variables grdin, grdout, and datin as inputs and returns datou...
integer num_clim_diag
No description.
subroutine, public obtain_interpolator_time_slices(clim_type, Time)
obtain_interpolator_time_slices makes sure that the appropriate time slices are available for interpo...
subroutine, public diag_manager_init(diag_model_subset, time_init, err_msg)
integer, parameter kg_m2
Flags to indicate whether the climatology units are mixing ratio (kg/kg) or column integral (kg/m2)...
integer, parameter, public julian
subroutine latlon2xyz(p, e)
latlon2xyz receives the variable p as input and returns e as output in order to map (lon...
subroutine interp_weighted_scalar_2d(grdin, grdout, datin, datout)
interp_weighted_scalar_2D receives the variables grdin, grdout, and datin as inputs and returns datou...
subroutine cart_to_latlon(np, q, xs, ys)
car_to_latlon receives the variables np, q, xs, and ys as inputs and returns q, xs, and ys.
integer function, public get_calendar_type()
integer, parameter, public interp_weighted_p
integer nlevh
No description.
subroutine, public init_clim_diag(clim_type, mod_axes, init_time)
init_clim_diag is a routine to register diagnostic fields for the climatology file. This routine calculates the domain decompostion of the climatology fields for later export through send_data. The ids created here are for column burdens that will diagnose the vertical interpolation routine.
integer, parameter increasing_downward
type(time_type) function, public set_date_no_leap(year, month, day, hour, minute, second)
integer sense
No description.
integer, parameter, public year
subroutine, public horiz_interp_init
integer nlatb
No description.
subroutine interpolator_3d_no_time_axis(clim_type, phalf, interp_data, field_name, is, js, clim_units)
interpolator_3D_no_time_axis receives a field name as input and interpolates the field to model a 3D ...
integer, parameter increasing_upward
Flags to indicate direction of vertical axis in data file.
subroutine interpolator_4d_no_time_axis(clim_type, phalf, interp_data, field_name, is, js, clim_units)
interpolator_4D_no_time_axis receives a field name as input and interpolates the field to model a 4D ...
real, parameter, public grav
Acceleration due to gravity [m/s^2].
Definition: constants.F90:76
integer, parameter max_diag_fields
No description.
subroutine get_anthro_sulfate(sulfate, model_time, p_half, name, model_data, is, js, clim_units)
type(axistype), save time_axis
No description.
integer, dimension(max_diag_fields) climo_diag_id
integer, dimension(max_diag_fields) hinterp_id
No description.
integer nlonb
No description.
#define max(a, b)
Definition: mosaic_util.h:33
subroutine cell_center2(q1, q2, q3, q4, e2)
cell_center2 receives the variables q1, q2, q3, and q4 as inputs and returns e2.
integer, parameter, public constant
real missing_value
No description.
integer, parameter bilinear
real, parameter, public seconds_per_day
Seconds in a day [s].
Definition: constants.F90:116
integer, parameter seconds_per_day
interpolator_mod is a module to interpolate climatology data to model the grid.
#define min(a, b)
Definition: mosaic_util.h:32
integer num_fields
No description.
logical conservative_interp
No description.
subroutine, public unset_interpolator_time_flag(clim_type)
unset_interpolator_time_flag sets a flag in clim_type to false.
subroutine interpolator_4d(clim_type, Time, phalf, interp_data, field_name, is, js, clim_units)
interpolator_4D receives a field name as input and interpolates the field to model a 4D grid and time...
integer nlat
No description.
integer nlev
No description.
subroutine, public constants_init
dummy routine.
Definition: constants.F90:141
subroutine, public get_date_julian(time, year, month, day, hour, minute, second)
subroutine interpolator_2d_no_time_axis(clim_type, interp_data, field_name, is, js, clim_units)
interpolator_2D_no_time_axis receives a field name as input and interpolates the field to model a 2D ...
type(time_type) function, public decrement_time(Time, seconds, days, ticks, err_msg, allow_neg_inc)
integer, parameter pressure
integer, parameter, public interp_linear_p
subroutine read_data_no_time_axis(clim_type, src_field, hdata, i)
read_data_no_time_axis receives various climate data as inputs and returns a horizontally interpolate...
integer function check_climo_units(units)
check_climo_units checks the units that the climatology data is using. This is needed to allow for co...
subroutine, public print_date(Time, str, unit)
integer, parameter notime
Flags to indicate whether the time interpolation should be linear or some other scheme for seasonal d...
integer ndim
No description.
real(fp), parameter, public pi
integer verbose
No description.
logical read_all_on_init
No description.