FMS  2025.03
Flexible Modeling System
amip_interp.F90
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 !> @defgroup amip_interp_mod amip_interp_mod
21 !> @ingroup amip_interp
22 !> @brief Provides observed sea surface temperature and ice mask data sets that have been
23 !! interpolated onto your model's grid.
24 !!
25 !> @author Bruce Wyman
26 !!
27 !> When using these routines three possible data sets are available:
28 !!
29 !! 1. AMIP http://www.pcmdi.github.io/mips/amip from Jan 1979 to Jan 1989 (2 deg x 2 deg)
30 !! 2. Reynolds OI @ref amip_interp.rey_oi.txt from Nov 1981 to Jan 1999 (1 deg x 1 deg)
31 !! 3. Reynolds EOF podaac.jpl.nasa.gov/ from Jan 1950 to Dec 1998 (2 deg x 2 deg)
32 !!
33 !! All original data are observed monthly means. This module
34 !! interpolates linearly in time between pairs of monthly means.
35 !! Horizontal interpolation is done using the horiz_interp module.
36 !!
37 !! When a requested date falls outside the range of dates available
38 !! a namelist option allows for use of the climatological monthly
39 !! mean values which are computed from all of the data in a particular
40 !! data set. \n
41 !! \n AMIP 1:\n
42 !! from Jan 1979 to Jan 1989 (2 deg x 2 deg).\n\n
43 !! Reynolds OI:\n
44 !! from Nov 1981 to Jan 1999 (1 deg x 1 deg)\n
45 !! The analysis uses in situ and satellite SST's plus
46 !! SST's simulated by sea-ice cover.\n\n
47 !! Reynold's EOF:\n
48 !! from Jan 1950 to Dec 1998 (2 deg x 2 deg)\n
49 !! NCEP Reynolds Historical Reconstructed Sea Surface Temperature
50 !! The analysis uses both in-situ SSTs and satellite derived SSTs
51 !! from the NOAA Advanced Very High Resolution Radiometer.
52 !! In-situ data is used from 1950 to 1981, while both AVHRR derived
53 !! satellite SSTs and in-situ data are used from 1981 to the
54 !! end of 1998.
55 !!
56 !> @note The data set used by this module have been reformatted as 32-bit IEEE.
57 !! The data values are packed into 16-bit integers.
58 !!
59 !! The data sets are read from the following files:
60 !!
61 !! amip1 INPUT/amip1_sst.data
62 !! reynolds_io INPUT/reyoi_sst.data
63 !! reynolds_eof INPUT/reynolds_sst.data
64 !!
65 !> @var character(len=24) data_set
66 !! Name/type of SST data that will be used.
67 !! Possible values (case-insensitive) are:
68 !! 1) amip1
69 !! 2) reynolds_eof
70 !! 3) reynolds_oi
71 !! See the @ref amip_interp_oi page for more information
72 !! @var character(len=16) date_out_of_range
73 !! Controls the use of climatological monthly mean data when
74 !! the requested date falls outside the range of the data set.<BR/>
75 !! Possible values are:
76 !! <PRE>
77 !! fail - program will fail if requested date is prior
78 !! to or after the data set period.
79 !! initclimo - program uses climatological requested data is
80 !! prior to data set period and will fail if
81 !! requested date is after data set period.
82 !! climo - program uses climatological data anytime.
83 !! </PRE>
84 !! @var real tice_crit
85 !! Freezing point of sea water in degC or degK. Defaults to -1.80
86 !! @var integer verbose
87 !! Controls printed output, 0 <= verbose <= 3, default=0
88 !! additional parameters for controlling zonal prescribed sst ----
89 !! these parameters only have an effect when use_zonal=.true. ----
90 !! @var logical use_zonal
91 !! Flag to selected zonal sst or data set. Default=.false.
92 !! @var real teq
93 !! sst at the equator. Default=305
94 !! @var real tdif
95 !! Equator to pole sst difference. Default=50
96 !! @var real tann
97 !! Amplitude of annual cycle. Default=20
98 !! @var real tlag
99 !! Offset for time of year (for annual cycle). Default=0.875
100 !! @var integer amip_date
101 !! Single calendar date in integer "(year,month,day)" format
102 !! that is used only if set with year>0, month>0, day>0.
103 !! If used, model calendar date is replaced by this date,
104 !! but model time of day is still used to determine ice/sst.
105 !! Used for repeating-single-day (rsd) experiments.
106 !! Default=/-1,-1,-1/
107 !! @var real sst_pert
108 !! Temperature perturbation in degrees Kelvin added onto the SST.
109 !! The perturbation is globally-uniform (even near sea-ice).
110 !! It is only used when abs(sst_pert) > 1.e-4. SST perturbation runs
111 !! may be useful in accessing model sensitivities.
112 !! Default=0.
113 
114 !> @addtogroup amip_interp_mod
115 !> @{
116 module amip_interp_mod
117 
118 use time_interp_mod, only: time_interp, fraction_of_year
119 
120 use time_manager_mod, only: time_type, operator(+), operator(>), &
122 
123 ! add by JHC
124 use get_cal_time_mod, only: get_cal_time
125 
126 ! end add by JHC
127 
128 use horiz_interp_mod, only: horiz_interp_init, horiz_interp, &
130  horiz_interp_type, assignment(=)
131 
132 use fms_mod, only: error_mesg, write_version_number, &
133  note, warning, fatal, stdlog, check_nml_error, &
134  mpp_pe, lowercase, mpp_root_pe, &
135  note, mpp_error, fms_error_handler
136 
137 use constants_mod, only: tfreeze, pi
138 use platform_mod, only: r4_kind, r8_kind, i2_kind, fms_file_len
139 use mpp_mod, only: input_nml_file
140 use fms2_io_mod, only: fmsnetcdffile_t, fms2_io_file_exists=>file_exists, open_file, close_file, &
141  get_dimension_size, fms2_io_read_data=>read_data
142 use netcdf, only: nf90_max_name
143 
144 implicit none
145 private
146 
147 !-----------------------------------------------------------------------
148 !----------------- Public interfaces -----------------------------------
149 
151  & amip_interp_del, amip_interp_type, assignment(=)
152 
153 !-----------------------------------------------------------------------
154 !----------------- Public Data -----------------------------------
155 integer :: i_sst = 1200
156 integer :: j_sst = 600
157 real(r8_kind), parameter:: big_number = 1.e30_r8_kind
158 logical :: forecast_mode = .false.
159 
160 public i_sst, j_sst, forecast_mode, use_ncep_sst
161 
162 !-----------------------------------------------------------------------
163 !--------------------- private below here ------------------------------
164 
165 ! ---- version number -----
166 
167 ! Include variable "version" to be written to log file.
168 #include<file_version.h>
169 
170 ! add by JHC
171  real(r8_kind), allocatable, dimension(:,:) :: tempamip
172 ! end add by JHC
173 !-----------------------------------------------------------------------
174 !------ private defined data type --------
175 
176 !> @}
177 
178 !> @brief Private data type for representing a calendar date
179 !> @ingroup amip_interp_mod
181  sequence
182  integer :: year, month, day
183 end type
184 
185 !> Assignment overload to allow native assignment between amip_interp_type variables.
186 !> @ingroup amip_interp_mod
187 interface assignment(=)
188  module procedure amip_interp_type_eq
189 end interface
190 
191 !> Private logical equality overload for amip_interp_type
192 !> @ingroup amip_interp_mod
193 interface operator (==)
194  module procedure date_equals
195 end interface
196 
197 !> Private logical inequality overload for amip_interp_type
198 !> @ingroup amip_interp_mod
199 interface operator (/=)
200  module procedure date_not_equals
201 end interface
202 
203 !> Private logical greater than overload for amip_interp_type
204 !> @ingroup amip_interp_mod
205 interface operator (>)
206  module procedure date_gt
207 end interface
208 
209 !> Retrieve sea surface temperature data and interpolated grid
210 interface get_amip_sst
211  module procedure get_amip_sst_r4, get_amip_sst_r8
212 end interface
213 
214 !> AMIP interpolation for ice
215 interface get_amip_ice
216  module procedure get_amip_ice_r4, get_amip_ice_r8
217 end interface
218 
219 !> Initializes data needed for the horizontal
220 !! interpolation between the sst data and model grid.
221 !!
222 !> The returned variable of type amip_interp_type is needed when
223 !! calling get_amip_sst and get_amip_ice.
224 !!
225 !> @param lon
226 !! Longitude in radians of the model's grid box edges (1d lat/lon grid case)
227 !! or at grid box mid-point (2d case for arbitrary grids).
228 !> @param lat
229 !! Latitude in radians of the model's grid box edges (1d lat/lon grid case)
230 !! or at grid box mid-point (2d case for arbitrary grids).
231 !> @param mask
232 !! A mask for the model grid.
233 !> @param use_climo
234 !! Flag the specifies that monthly mean climatological values will be used.
235 !> @param use_annual
236 !! Flag the specifies that the annual mean climatological
237 !! will be used. If both use_annual = use_climo = true,
238 !! then use_annual = true will be used.
239 !> @param interp_method
240 !! specify the horiz_interp scheme. = "conservative" means conservative scheme,
241 !! = "bilinear" means bilinear interpolation.
242 !!
243 !> @return interp, a defined data type variable needed when calling get_amip_sst and get_amip_ice.
244 !!
245 !! \n Example usage:
246 !!
247 !! Interp = amip_interp_new ( lon, lat, mask, use_climo, use_annual, interp_method )
248 !!
249 !! This function may be called to initialize multiple variables
250 !! of type amip_interp_type. However, there currently is no
251 !! call to release the storage used by this variable.
252 !!
253 !! The size of input augment mask must be a function of the size
254 !! of input augments lon and lat. The first and second dimensions
255 !! of mask must equal (size(lon,1)-1, size(lat,2)-1).
256 !!
257 !> @throws "FATAL: the value of the namelist parameter DATA_SET being used is not allowed"
258 !! Check the value of namelist variable DATA_SET.
259 !!
260 !> @throws "FATAL: requested input data set does not exist"
261 !! The data set requested is valid but the data does not exist in
262 !! the INPUT subdirectory. You may have requested amip2 data which
263 !! has not been officially set up.
264 !! See the section on DATA SETS to properly set the data up.
265 !!
266 !> @throws "FATAL: use_climo mismatch"
267 !! The namelist variable date_out_of_range = 'fail' and the amip_interp_new
268 !! argument use_climo = true. This combination is not allowed.
269 !!
270 !> @throws "FATAL: use_annual(climo) mismatch"
271 !! The namelist variable date_out_of_range = 'fail' and the amip_interp_new
272 !! argument use_annual = true. This combination is not allowed.
273 !!
274 !> @ingroup amip_interp_mod
276  module procedure amip_interp_new_1d_r4, amip_interp_new_1d_r8
277  module procedure amip_interp_new_2d_r4, amip_interp_new_2d_r8
278 end interface
279 
280 !----- public data type ------
281 
282 !> @brief Contains information needed by the interpolation module (exchange_mod) and buffers
283 !! data (r4_kind flavor).
284 !> @ingroup amip_interp_mod
286  private
287  type (horiz_interp_type) :: Hintrp, Hintrp2 ! add by JHC
288  real(r4_kind), dimension(:,:), allocatable :: data1_r4, data2_r4
289  real(r8_kind), dimension(:,:), allocatable :: data1_r8, data2_r8
290  type (date_type) :: Date1, Date2
291  logical :: use_climo, use_annual
292  logical :: I_am_initialized=.false.
293 end type amip_interp_type
294 
295 !> @addtogroup amip_interp_mod
296 !> @{
297 !-----------------------------------------------------------------------
298 ! ---- resolution/grid variables ----
299 
300  integer :: mobs, nobs
301  real(r8_kind), allocatable, dimension(:) :: lon_bnd, lat_bnd
302 
303 ! ---- global unit & date ----
304 
305  integer :: iunit
306  character(len=FMS_FILE_LEN) :: file_name_sst, file_name_ice
307  type(FmsNetcdfFile_t), target :: fileobj_sst, fileobj_ice
308 
309  type (date_type) :: Curr_date = date_type( -99, -99, -99 )
310  type (date_type) :: Date_end = date_type( -99, -99, -99 )
311 
312  real(r8_kind) :: tice_crit_k
313  integer(i2_kind) :: ice_crit
314 
315  logical :: module_is_initialized = .false.
316 
317 !-----------------------------------------------------------------------
318 !---- namelist ----
319 
320  character(len=24) :: data_set = 'amip1' !< use 'amip1', 'amip2', 'reynolds_eof'
321  !! 'reynolds_oi', 'hurrell', or 'daily',
322  !! when "use_daily=.T."
323  ! add by JHC
324 
325  character(len=16) :: date_out_of_range = 'fail' !< use 'fail', 'initclimo', or 'climo'
326 
327  real(r8_kind) :: tice_crit = -1.80_r8_kind !< in degC or degK
328  integer :: verbose = 0 !< 0 <= verbose <= 3
329 
330  logical :: use_zonal = .false. !< parameters for prescribed zonal sst option
331  real(r8_kind) :: teq = 305._r8_kind !< parameters for prescribed zonal sst option
332  real(r8_kind) :: tdif = 50._r8_kind !< parameters for prescribed zonal sst option
333  real(r8_kind) :: tann = 20._r8_kind !< parameters for prescribed zonal sst option
334  real(r8_kind) :: tlag = 0.875_r8_kind !< parameters for prescribed zonal sst option
335 
336 
337  integer :: amip_date(3)=(/-1,-1,-1/) !< amip date for repeating single day (rsd) option
338 
339  real(r8_kind) :: sst_pert = 0._r8_kind !< global temperature perturbation used for sensitivity experiments
340 
341  character(len=6) :: sst_pert_type = 'fixed' !< use 'random' or 'fixed'
342  logical :: do_sst_pert = .false.
343  logical :: use_daily = .false. !< if '.true.', give 'data_set = 'daily''
344 
345  logical :: use_ncep_sst = .false. !< SJL: During nudging: use_ncep_sst = .T.; no_anom_sst = .T.
346  !! during forecast: use_ncep_sst = .T.; no_anom_sst = .F.
347  logical :: no_anom_sst = .true. !< SJL: During nudging: use_ncep_sst = .T.; no_anom_sst = .T.
348  !! during forecast: use_ncep_sst = .T.; no_anom_sst = .F.
349  logical :: use_ncep_ice = .false. !< For seasonal forecast: use_ncep_ice = .F.
350  logical :: interp_oi_sst = .false. !< changed to false for regular runs
351  logical :: use_mpp_io = .false. !< Set to .true. to use mpp_io, otherwise fms2io is used
352 
353  namelist /amip_interp_nml/ use_ncep_sst, no_anom_sst, use_ncep_ice, tice_crit, &
356  ! add by JHC
357  sst_pert, sst_pert_type, do_sst_pert, &
358  use_daily, &
359  ! end add by JHC
360  verbose, i_sst, j_sst, forecast_mode, &
361  use_mpp_io
362 
363 !-----------------------------------------------------------------------
364 
365 contains
366 
367  !> initialize @ref amip_interp_mod for use
368  subroutine amip_interp_init
369  integer :: iunit,io,ierr
370 
371 !-----------------------------------------------------------------------
372 
373  call horiz_interp_init
374 
375 ! ---- read namelist ----
376 
377  read (input_nml_file, amip_interp_nml, iostat=io)
378  ierr = check_nml_error(io,'amip_interp_nml')
379 
380 ! ----- write namelist/version info -----
381  call write_version_number("AMIP_INTERP_MOD", version)
382 
383  iunit = stdlog( )
384  if (mpp_pe() == 0) then
385  write (iunit,nml=amip_interp_nml)
386  endif
387 
388  if (use_mpp_io) then
389  !! USE_MPP_IO_WARNING
390  call mpp_error ('amip_interp_mod', &
391  'MPP_IO is no longer supported. Please remove use_mpp_io from amip_interp_nml',&
392  fatal)
393  endif
394  if ( .not. use_ncep_sst ) interp_oi_sst = .false.
395 
396 ! ---- freezing point of sea water in deg K ---
397 
398  tice_crit_k = tice_crit
399  if ( tice_crit_k < 200._r8_kind ) then
400  tice_crit_k = tice_crit_k + tfreeze
401  endif
402  ice_crit = nint((tice_crit_k-tfreeze)*100._r8_kind, i2_kind)
403 
404 ! ---- set up file dependent variable ----
405 ! ---- global file name ----
406 ! ---- grid box edges ----
407 ! ---- initialize zero size grid if not pe 0 ------
408 
409  if (lowercase(trim(data_set)) == 'amip1') then
410  file_name_sst = 'INPUT/' // 'amip1_sst.data'
411  file_name_ice = 'INPUT/' // 'amip1_sst.data'
412  mobs = 180; nobs = 91
413  call set_sst_grid_edges_amip1
414  if (mpp_pe() == 0) &
415  call error_mesg ('amip_interp_init', 'using AMIP 1 sst', note)
416  date_end = date_type( 1989, 1, 0 )
417  else if (lowercase(trim(data_set)) == 'amip2') then
418  file_name_sst = 'INPUT/' // 'amip2_sst.data'
419  file_name_ice = 'INPUT/' // 'amip2_ice.data'
420  mobs = 360; nobs = 180
421  call set_sst_grid_edges_oi
422 ! --- specfied min for amip2 ---
423  tice_crit_k = 271.38_r8_kind
424  if (mpp_pe() == 0) &
425  call error_mesg ('amip_interp_init', 'using AMIP 2 sst', note)
426  date_end = date_type( 1996, 3, 0 )
427  else if (lowercase(trim(data_set)) == 'hurrell') then
428  file_name_sst = 'INPUT/' // 'hurrell_sst.data'
429  file_name_ice = 'INPUT/' // 'hurrell_ice.data'
430  mobs = 360; nobs = 180
431  call set_sst_grid_edges_oi
432 ! --- specfied min for hurrell ---
433  tice_crit_k = 271.38_r8_kind
434  if (mpp_pe() == 0) &
435  call error_mesg ('amip_interp_init', 'using HURRELL sst', note)
436  date_end = date_type( 2011, 8, 16 ) ! updated by JHC
437 ! add by JHC
438  else if (lowercase(trim(data_set)) == 'daily') then
439  file_name_sst = 'INPUT/' // 'hurrell_sst.data'
440  file_name_ice = 'INPUT/' // 'hurrell_ice.data'
441  mobs = 360; nobs = 180
442  call set_sst_grid_edges_oi
443  if (mpp_pe() == 0) &
444  call error_mesg ('amip_interp_init', 'using AVHRR daily sst', note)
445  date_end = date_type( 2011, 8, 16 )
446 ! end add by JHC
447  else if (lowercase(trim(data_set)) == 'reynolds_eof') then
448  file_name_sst = 'INPUT/' // 'reynolds_sst.data'
449  file_name_ice = 'INPUT/' // 'reynolds_sst.data'
450  mobs = 180; nobs = 90
451  call set_sst_grid_edges_oi
452  if (mpp_pe() == 0) &
453  call error_mesg ('amip_interp_init', &
454  'using NCEP Reynolds Historical Reconstructed SST', note)
455  date_end = date_type( 1998, 12, 0 )
456  else if (lowercase(trim(data_set)) == 'reynolds_oi') then
457  file_name_sst = 'INPUT/' // 'reyoi_sst.data'
458  file_name_ice = 'INPUT/' // 'reyoi_sst.data'
459 !--- Added by SJL ----------------------------------------------
460  if ( use_ncep_sst ) then
461  mobs = i_sst; nobs = j_sst
462  else
463  mobs = 360; nobs = 180
464  endif
465 !--- Added by SJL ----------------------------------------------
466  call set_sst_grid_edges_oi
467  if (mpp_pe() == 0) &
468  call error_mesg ('amip_interp_init', 'using Reynolds OI SST', &
469  note)
470  date_end = date_type( 1999, 1, 0 )
471  else
472  call error_mesg ('amip_interp_init', 'the value of the &
473  &namelist parameter DATA_SET being used is not allowed', fatal)
474  endif
475 
476  if (verbose > 1 .and. mpp_pe() == 0) &
477  print *, 'ice_crit,tice_crit_k=',ice_crit,tice_crit_k
478 
479 ! --- check existence of sst data file ??? ---
480  file_name_sst = trim(file_name_sst)//'.nc'
481  file_name_ice = trim(file_name_ice)//'.nc'
482 
483  if (.not. fms2_io_file_exists(trim(file_name_sst)) ) then
484  call error_mesg ('amip_interp_init', &
485  'file '//trim(file_name_sst)//' does not exist', fatal)
486  endif
487  if (.not. fms2_io_file_exists(trim(file_name_ice)) ) then
488  call error_mesg ('amip_interp_init', &
489  'file '//trim(file_name_ice)//' does not exist', fatal)
490  endif
491 
492  if (.not. open_file(fileobj_sst, trim(file_name_sst), 'read')) &
493  call error_mesg ('amip_interp_init', 'Error in opening file '//trim(file_name_sst), fatal)
494  if (.not. open_file(fileobj_ice, trim(file_name_ice), 'read')) &
495  call error_mesg ('amip_interp_init', 'Error in opening file '//trim(file_name_ice), fatal)
496  module_is_initialized = .true.
497  end subroutine amip_interp_init
498 
499  subroutine set_sst_grid_edges_amip1
500  integer :: i, j
501  real(r8_kind) :: hpie, dlon, dlat, wb, sb
502 
503  allocate(lon_bnd(mobs+1))
504  allocate(lat_bnd(nobs+1))
505 
506 ! ---- compute grid edges (do only once) -----
507 
508  hpie = pi / 2._r8_kind
509 
510  dlon = 4._r8_kind*hpie/real(mobs, r8_kind)
511  wb = -0.5_r8_kind*dlon
512 
513  do i = 1, mobs+1
514  lon_bnd(i) = wb + dlon*real(i-1, r8_kind)
515  enddo
516  lon_bnd(mobs+1) = lon_bnd(1) + 4._r8_kind*hpie
517 
518  dlat = 2._r8_kind*hpie/real(nobs-1, r8_kind)
519  sb = -hpie + 0.5_r8_kind*dlat
520 
521  lat_bnd(1) = -hpie
522  lat_bnd(nobs+1) = hpie
523  do j = 2, nobs
524  lat_bnd(j) = sb + dlat * real(j-2, r8_kind)
525  enddo
526  end subroutine set_sst_grid_edges_amip1
527 
528  subroutine set_sst_grid_edges_oi
529  integer :: i, j
530  real(r8_kind) :: hpie, dlon, dlat, wb, sb
531 
532 ! add by JHC
533  if(allocated(lon_bnd)) deallocate(lon_bnd)
534  if(allocated(lat_bnd)) deallocate(lat_bnd)
535 ! end add by JHC
536 
537  allocate(lon_bnd(mobs+1))
538  allocate(lat_bnd(nobs+1))
539 
540 ! ---- compute grid edges (do only once) -----
541 
542  hpie = pi / 2._r8_kind
543  dlon = 4._r8_kind*hpie/real(mobs, r8_kind)
544  wb = 0.0_r8_kind
545 
546  lon_bnd(1) = wb
547  do i = 2, mobs+1
548  lon_bnd(i) = wb + dlon * real(i-1, r8_kind)
549  enddo
550  lon_bnd(mobs+1) = lon_bnd(1) + 4._r8_kind*hpie
551 
552  dlat = 2._r8_kind*hpie/real(nobs, r8_kind)
553  sb = -hpie
554 
555  lat_bnd(1) = sb
556  lat_bnd(nobs+1) = hpie
557  do j = 2, nobs
558  lat_bnd(j) = sb + dlat * real(j-1, r8_kind)
559  enddo
560  end subroutine set_sst_grid_edges_oi
561 
562 !> Frees data associated with a amip_interp_type variable. Should be used for any
563 !! variables initialized via @ref amip_interp_new.
564 !> @param[inout] Interp A defined data type variable initialized by amip_interp_new and used
565 !! when calling get_amip_sst and get_amip_ice.
566  subroutine amip_interp_del (Interp)
567  type (amip_interp_type), intent(inout) :: interp
568 
569  if(allocated(interp%data1_r4)) deallocate(interp%data1_r4)
570  if(allocated(interp%data1_r8)) deallocate(interp%data1_r8)
571  if(allocated(interp%data2_r4)) deallocate(interp%data2_r4)
572  if(allocated(interp%data2_r8)) deallocate(interp%data2_r8)
573 
574  if(allocated(lon_bnd)) deallocate(lon_bnd)
575  if(allocated(lat_bnd)) deallocate(lat_bnd)
576 
577  call horiz_interp_del ( interp%Hintrp )
578 
579  interp%I_am_initialized = .false.
580  end subroutine amip_interp_del
581 
582 !> @brief Returns the size (i.e., number of longitude and latitude
583 !! points) of the observed data grid.
584 !! @throws FATAL have not called amip_interp_new
585 !! Must call amip_interp_new before get_sst_grid_size.
586  subroutine get_sst_grid_size (nlon, nlat)
587  integer, intent(out) :: nlon !> The number of longitude points (first dimension) in the
588  !! observed data grid. For AMIP 1 nlon = 180, and the Reynolds nlon = 360.
589  integer, intent(out) :: nlat !> The number of latitude points (second dimension) in the
590  !! observed data grid. For AMIP 1 nlon = 91, and the Reynolds nlon = 180.
591 
592  if ( .not.module_is_initialized ) call amip_interp_init
593 
594  nlon = mobs; nlat = nobs
595  end subroutine get_sst_grid_size
596 
597 !> @return logical answer
598 function date_equals (Left, Right) result (answer)
599 type (date_type), intent(in) :: left, right
600 logical :: answer
601 
602  if (left % year == right % year .and. &
603  left % month == right % month .and. &
604  left % day == right % day ) then
605  answer = .true.
606  else
607  answer = .false.
608  endif
609 end function date_equals
610 
611 !> @return logical answer
612 function date_not_equals (Left, Right) result (answer)
613 type (date_type), intent(in) :: left, right
614 logical :: answer
615 
616  if (left % year == right % year .and. &
617  left % month == right % month .and. &
618  left % day == right % day ) then
619  answer = .false.
620  else
621  answer = .true.
622  endif
623 end function date_not_equals
624 
625 !> @return logical answer
626 function date_gt (Left, Right) result (answer)
627 type (date_type), intent(in) :: left, right
628 logical :: answer
629 integer :: i, dif(3)
630 
631  dif(1) = left%year - right%year
632  dif(2) = left%month - right%month
633  dif(3) = left%day - right%day
634  answer = .false.
635  do i = 1, 3
636  if (dif(i) == 0) cycle
637  if (dif(i) < 0) exit
638  if (dif(i) > 0) then
639  answer = .true.
640  exit
641  endif
642  enddo
643 end function date_gt
644 
645 subroutine amip_interp_type_eq (amip_interp_out, amip_interp_in)
646  type(amip_interp_type), intent(inout) :: amip_interp_out
647  type(amip_interp_type), intent(in) :: amip_interp_in
648 
649  if(.not.amip_interp_in%I_am_initialized) then
650  call mpp_error(fatal,'amip_interp_type_eq: amip_interp_type variable on right hand side is unassigned')
651  endif
652 
653  amip_interp_out%Hintrp = amip_interp_in%Hintrp
654  amip_interp_out%Hintrp2 = amip_interp_in%Hintrp2 !< missing assignment statement; added by GPP
655  amip_interp_out%data1_r4 = amip_interp_in%data1_r4
656  amip_interp_out%data1_r8 = amip_interp_in%data1_r8
657  amip_interp_out%data2_r4 = amip_interp_in%data2_r4
658  amip_interp_out%data2_r8 = amip_interp_in%data2_r8
659  amip_interp_out%Date1 = amip_interp_in%Date1
660  amip_interp_out%Date2 = amip_interp_in%Date2
661  amip_interp_out%Date1 = amip_interp_in%Date1
662  amip_interp_out%Date2 = amip_interp_in%Date2
663  amip_interp_out%use_climo = amip_interp_in%use_climo
664  amip_interp_out%use_annual = amip_interp_in%use_annual
665  amip_interp_out%I_am_initialized = .true.
666 end subroutine amip_interp_type_eq
667 
668 #include "amip_interp_r4.fh"
669 #include "amip_interp_r8.fh"
670 
671 end module amip_interp_mod
672 !> @}
673 ! <INFO>
674 
675 ! <FUTURE>
676 ! Add AMIP 2 data set.
677 !
678 ! Other data sets (or extend current data sets).
679 ! </FUTURE>
680 
681 ! </INFO>
real(r8_kind) tice_crit
in degC or degK
character(len=24) data_set
use 'amip1', 'amip2', 'reynolds_eof' 'reynolds_oi', 'hurrell', or 'daily', when "use_daily=....
real(r8_kind) teq
parameters for prescribed zonal sst option
logical function date_not_equals(Left, Right)
logical interp_oi_sst
changed to false for regular runs
subroutine, public amip_interp_init
initialize amip_interp_mod for use
logical use_mpp_io
Set to .true. to use mpp_io, otherwise fms2io is used.
real(r8_kind) tann
parameters for prescribed zonal sst option
logical no_anom_sst
SJL: During nudging: use_ncep_sst = .T.; no_anom_sst = .T. during forecast: use_ncep_sst = ....
logical use_ncep_ice
For seasonal forecast: use_ncep_ice = .F.
logical function date_equals(Left, Right)
real(r8_kind) sst_pert
global temperature perturbation used for sensitivity experiments
integer verbose
0 <= verbose <= 3
character(len=16) date_out_of_range
use 'fail', 'initclimo', or 'climo'
subroutine, public amip_interp_del(Interp)
Frees data associated with a amip_interp_type variable. Should be used for any variables initialized ...
logical, public use_ncep_sst
SJL: During nudging: use_ncep_sst = .T.; no_anom_sst = .T. during forecast: use_ncep_sst = ....
real(r8_kind) tlag
parameters for prescribed zonal sst option
integer, dimension(3) amip_date
amip date for repeating single day (rsd) option
logical use_zonal
parameters for prescribed zonal sst option
logical use_daily
if '.true.', give 'data_set = 'daily''
logical function date_gt(Left, Right)
subroutine get_sst_grid_size(nlon, nlat)
Returns the size (i.e., number of longitude and latitude points) of the observed data grid.
subroutine amip_interp_type_eq(amip_interp_out, amip_interp_in)
character(len=6) sst_pert_type
use 'random' or 'fixed'
real(r8_kind) tdif
parameters for prescribed zonal sst option
Initializes data needed for the horizontal interpolation between the sst data and model grid.
Contains information needed by the interpolation module (exchange_mod) and buffers data (r4_kind flav...
Private data type for representing a calendar date.
Close a netcdf or domain file opened with open_file or open_virtual_file.
Definition: fms2_io.F90:166
Opens a given netcdf or domain file.
Definition: fms2_io.F90:122
Read data from a defined field in a file.
Definition: fms2_io.F90:292
integer function, public check_nml_error(IOSTAT, NML_NAME)
Checks the iostat argument that is returned after reading a namelist and determines if the error code...
Definition: fms.F90:524
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
Definition: fms.F90:702
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
Definition: fms.F90:469
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
Definition: fms.F90:442
Added for mixed precision support. Updates force time_manager math to be done with kind=8 reals _wrap...
subroutine, public horiz_interp_del(Interp)
Deallocates memory used by "horiz_interp_type" variables. Must be called before reinitializing with h...
subroutine, public horiz_interp_init
Initialize module and writes version number to logfile.out.
Subroutine for performing the horizontal interpolation between two grids.
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
Definition: mpp_util.inc:59
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407
Error handler.
Definition: mpp.F90:382
real(r8_kind) function, public fraction_of_year(Time)
Wrapper function to return the fractional time into the current year Always returns an r8_kind,...
Returns a weight and dates or indices for interpolating between two dates. The interface fraction_of_...
subroutine, public get_date(time, year, month, day, hour, minute, second, tick, err_msg)
Gets the date for different calendar types. Given a time_interval, returns the corresponding date und...
Given an input date in year, month, days, etc., creates a time_type that represents this time interva...
Given some number of seconds and days, returns the corresponding time_type.
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.
AMIP interpolation for ice.
Retrieve sea surface temperature data and interpolated grid.
Allocates space and initializes a derived-type variable that contains pre-computed interpolation indi...