FMS  2024.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 real(r8_kind), allocatable, dimension(:,:) :: sst_ncep, sst_anom
160 
161 public i_sst, j_sst, sst_ncep, sst_anom, forecast_mode, use_ncep_sst
162 
163 !-----------------------------------------------------------------------
164 !--------------------- private below here ------------------------------
165 
166 ! ---- version number -----
167 
168 ! Include variable "version" to be written to log file.
169 #include<file_version.h>
170 
171 ! add by JHC
172  real(r8_kind), allocatable, dimension(:,:) :: tempamip
173 ! end add by JHC
174 !-----------------------------------------------------------------------
175 !------ private defined data type --------
176 
177 !> @}
178 
179 !> @brief Private data type for representing a calendar date
180 !> @ingroup amip_interp_mod
182  sequence
183  integer :: year, month, day
184 end type
185 
186 !> Assignment overload to allow native assignment between amip_interp_type variables.
187 !> @ingroup amip_interp_mod
188 interface assignment(=)
189  module procedure amip_interp_type_eq
190 end interface
191 
192 !> Private logical equality overload for amip_interp_type
193 !> @ingroup amip_interp_mod
194 interface operator (==)
195  module procedure date_equals
196 end interface
197 
198 !> Private logical inequality overload for amip_interp_type
199 !> @ingroup amip_interp_mod
200 interface operator (/=)
201  module procedure date_not_equals
202 end interface
203 
204 !> Private logical greater than overload for amip_interp_type
205 !> @ingroup amip_interp_mod
206 interface operator (>)
207  module procedure date_gt
208 end interface
209 
210 !> Retrieve sea surface temperature data and interpolated grid
211 interface get_amip_sst
212  module procedure get_amip_sst_r4, get_amip_sst_r8
213 end interface
214 
215 !> AMIP interpolation for ice
216 interface get_amip_ice
217  module procedure get_amip_ice_r4, get_amip_ice_r8
218 end interface
219 
220 !> Initializes data needed for the horizontal
221 !! interpolation between the sst data and model grid.
222 !!
223 !> The returned variable of type amip_interp_type is needed when
224 !! calling get_amip_sst and get_amip_ice.
225 !!
226 !> @param lon
227 !! Longitude in radians of the model's grid box edges (1d lat/lon grid case)
228 !! or at grid box mid-point (2d case for arbitrary grids).
229 !> @param lat
230 !! Latitude in radians of the model's grid box edges (1d lat/lon grid case)
231 !! or at grid box mid-point (2d case for arbitrary grids).
232 !> @param mask
233 !! A mask for the model grid.
234 !> @param use_climo
235 !! Flag the specifies that monthly mean climatological values will be used.
236 !> @param use_annual
237 !! Flag the specifies that the annual mean climatological
238 !! will be used. If both use_annual = use_climo = true,
239 !! then use_annual = true will be used.
240 !> @param interp_method
241 !! specify the horiz_interp scheme. = "conservative" means conservative scheme,
242 !! = "bilinear" means bilinear interpolation.
243 !!
244 !> @return interp, a defined data type variable needed when calling get_amip_sst and get_amip_ice.
245 !!
246 !! \n Example usage:
247 !!
248 !! Interp = amip_interp_new ( lon, lat, mask, use_climo, use_annual, interp_method )
249 !!
250 !! This function may be called to initialize multiple variables
251 !! of type amip_interp_type. However, there currently is no
252 !! call to release the storage used by this variable.
253 !!
254 !! The size of input augment mask must be a function of the size
255 !! of input augments lon and lat. The first and second dimensions
256 !! of mask must equal (size(lon,1)-1, size(lat,2)-1).
257 !!
258 !> @throws "FATAL: the value of the namelist parameter DATA_SET being used is not allowed"
259 !! Check the value of namelist variable DATA_SET.
260 !!
261 !> @throws "FATAL: requested input data set does not exist"
262 !! The data set requested is valid but the data does not exist in
263 !! the INPUT subdirectory. You may have requested amip2 data which
264 !! has not been officially set up.
265 !! See the section on DATA SETS to properly set the data up.
266 !!
267 !> @throws "FATAL: use_climo mismatch"
268 !! The namelist variable date_out_of_range = 'fail' and the amip_interp_new
269 !! argument use_climo = true. This combination is not allowed.
270 !!
271 !> @throws "FATAL: use_annual(climo) mismatch"
272 !! The namelist variable date_out_of_range = 'fail' and the amip_interp_new
273 !! argument use_annual = true. This combination is not allowed.
274 !!
275 !> @ingroup amip_interp_mod
277  module procedure amip_interp_new_1d_r4, amip_interp_new_1d_r8
278  module procedure amip_interp_new_2d_r4, amip_interp_new_2d_r8
279 end interface
280 
281 !----- public data type ------
282 
283 !> @brief Contains information needed by the interpolation module (exchange_mod) and buffers
284 !! data (r4_kind flavor).
285 !> @ingroup amip_interp_mod
287  private
288  type (horiz_interp_type) :: Hintrp, Hintrp2 ! add by JHC
289  real(r4_kind), dimension(:,:), allocatable :: data1_r4, data2_r4
290  real(r8_kind), dimension(:,:), allocatable :: data1_r8, data2_r8
291  type (date_type) :: Date1, Date2
292  logical :: use_climo, use_annual
293  logical :: I_am_initialized=.false.
294 end type amip_interp_type
295 
296 !> @addtogroup amip_interp_mod
297 !> @{
298 !-----------------------------------------------------------------------
299 ! ---- resolution/grid variables ----
300 
301  integer :: mobs, nobs
302  real(r8_kind), allocatable, dimension(:) :: lon_bnd, lat_bnd
303 
304 ! ---- global unit & date ----
305 
306  integer :: iunit
307  character(len=FMS_FILE_LEN) :: file_name_sst, file_name_ice
308  type(FmsNetcdfFile_t), target :: fileobj_sst, fileobj_ice
309 
310  type (date_type) :: Curr_date = date_type( -99, -99, -99 )
311  type (date_type) :: Date_end = date_type( -99, -99, -99 )
312 
313  real(r8_kind) :: tice_crit_k
314  integer(i2_kind) :: ice_crit
315 
316  logical :: module_is_initialized = .false.
317 
318 !-----------------------------------------------------------------------
319 !---- namelist ----
320 
321  character(len=24) :: data_set = 'amip1' !< use 'amip1', 'amip2', 'reynolds_eof'
322  !! 'reynolds_oi', 'hurrell', or 'daily',
323  !! when "use_daily=.T."
324  ! add by JHC
325 
326  character(len=16) :: date_out_of_range = 'fail' !< use 'fail', 'initclimo', or 'climo'
327 
328  real(r8_kind) :: tice_crit = -1.80_r8_kind !< in degC or degK
329  integer :: verbose = 0 !< 0 <= verbose <= 3
330 
331  logical :: use_zonal = .false. !< parameters for prescribed zonal sst option
332  real(r8_kind) :: teq = 305._r8_kind !< parameters for prescribed zonal sst option
333  real(r8_kind) :: tdif = 50._r8_kind !< parameters for prescribed zonal sst option
334  real(r8_kind) :: tann = 20._r8_kind !< parameters for prescribed zonal sst option
335  real(r8_kind) :: tlag = 0.875_r8_kind !< parameters for prescribed zonal sst option
336 
337 
338  integer :: amip_date(3)=(/-1,-1,-1/) !< amip date for repeating single day (rsd) option
339 
340  real(r8_kind) :: sst_pert = 0._r8_kind !< global temperature perturbation used for sensitivity experiments
341 
342  character(len=6) :: sst_pert_type = 'fixed' !< use 'random' or 'fixed'
343  logical :: do_sst_pert = .false.
344  logical :: use_daily = .false. !< if '.true.', give 'data_set = 'daily''
345 
346  logical :: use_ncep_sst = .false. !< SJL: During nudging: use_ncep_sst = .T.; no_anom_sst = .T.
347  !! during forecast: use_ncep_sst = .T.; no_anom_sst = .F.
348  logical :: no_anom_sst = .true. !< SJL: During nudging: use_ncep_sst = .T.; no_anom_sst = .T.
349  !! during forecast: use_ncep_sst = .T.; no_anom_sst = .F.
350  logical :: use_ncep_ice = .false. !< For seasonal forecast: use_ncep_ice = .F.
351  logical :: interp_oi_sst = .false. !< changed to false for regular runs
352  logical :: use_mpp_io = .false. !< Set to .true. to use mpp_io, otherwise fms2io is used
353 
354  namelist /amip_interp_nml/ use_ncep_sst, no_anom_sst, use_ncep_ice, tice_crit, &
357  ! add by JHC
358  sst_pert, sst_pert_type, do_sst_pert, &
359  use_daily, &
360  ! end add by JHC
361  verbose, i_sst, j_sst, forecast_mode, &
362  use_mpp_io
363 
364 !-----------------------------------------------------------------------
365 
366 contains
367 
368  !> initialize @ref amip_interp_mod for use
369  subroutine amip_interp_init
370  integer :: iunit,io,ierr
371 
372 !-----------------------------------------------------------------------
373 
374  call horiz_interp_init
375 
376 ! ---- read namelist ----
377 
378  read (input_nml_file, amip_interp_nml, iostat=io)
379  ierr = check_nml_error(io,'amip_interp_nml')
380 
381 ! ----- write namelist/version info -----
382  call write_version_number("AMIP_INTERP_MOD", version)
383 
384  iunit = stdlog( )
385  if (mpp_pe() == 0) then
386  write (iunit,nml=amip_interp_nml)
387  endif
388 
389  if (use_mpp_io) then
390  !! USE_MPP_IO_WARNING
391  call mpp_error ('amip_interp_mod', &
392  'MPP_IO is no longer supported. Please remove use_mpp_io from amip_interp_nml',&
393  fatal)
394  endif
395  if ( .not. use_ncep_sst ) interp_oi_sst = .false.
396 
397 ! ---- freezing point of sea water in deg K ---
398 
399  tice_crit_k = tice_crit
400  if ( tice_crit_k < 200._r8_kind ) then
401  tice_crit_k = tice_crit_k + tfreeze
402  endif
403  ice_crit = nint((tice_crit_k-tfreeze)*100._r8_kind, i2_kind)
404 
405 ! ---- set up file dependent variable ----
406 ! ---- global file name ----
407 ! ---- grid box edges ----
408 ! ---- initialize zero size grid if not pe 0 ------
409 
410  if (lowercase(trim(data_set)) == 'amip1') then
411  file_name_sst = 'INPUT/' // 'amip1_sst.data'
412  file_name_ice = 'INPUT/' // 'amip1_sst.data'
413  mobs = 180; nobs = 91
414  call set_sst_grid_edges_amip1
415  if (mpp_pe() == 0) &
416  call error_mesg ('amip_interp_init', 'using AMIP 1 sst', note)
417  date_end = date_type( 1989, 1, 0 )
418  else if (lowercase(trim(data_set)) == 'amip2') then
419  file_name_sst = 'INPUT/' // 'amip2_sst.data'
420  file_name_ice = 'INPUT/' // 'amip2_ice.data'
421  mobs = 360; nobs = 180
422  call set_sst_grid_edges_oi
423 ! --- specfied min for amip2 ---
424  tice_crit_k = 271.38_r8_kind
425  if (mpp_pe() == 0) &
426  call error_mesg ('amip_interp_init', 'using AMIP 2 sst', note)
427  date_end = date_type( 1996, 3, 0 )
428  else if (lowercase(trim(data_set)) == 'hurrell') then
429  file_name_sst = 'INPUT/' // 'hurrell_sst.data'
430  file_name_ice = 'INPUT/' // 'hurrell_ice.data'
431  mobs = 360; nobs = 180
432  call set_sst_grid_edges_oi
433 ! --- specfied min for hurrell ---
434  tice_crit_k = 271.38_r8_kind
435  if (mpp_pe() == 0) &
436  call error_mesg ('amip_interp_init', 'using HURRELL sst', note)
437  date_end = date_type( 2011, 8, 16 ) ! updated by JHC
438 ! add by JHC
439  else if (lowercase(trim(data_set)) == 'daily') then
440  file_name_sst = 'INPUT/' // 'hurrell_sst.data'
441  file_name_ice = 'INPUT/' // 'hurrell_ice.data'
442  mobs = 360; nobs = 180
443  call set_sst_grid_edges_oi
444  if (mpp_pe() == 0) &
445  call error_mesg ('amip_interp_init', 'using AVHRR daily sst', note)
446  date_end = date_type( 2011, 8, 16 )
447 ! end add by JHC
448  else if (lowercase(trim(data_set)) == 'reynolds_eof') then
449  file_name_sst = 'INPUT/' // 'reynolds_sst.data'
450  file_name_ice = 'INPUT/' // 'reynolds_sst.data'
451  mobs = 180; nobs = 90
452  call set_sst_grid_edges_oi
453  if (mpp_pe() == 0) &
454  call error_mesg ('amip_interp_init', &
455  'using NCEP Reynolds Historical Reconstructed SST', note)
456  date_end = date_type( 1998, 12, 0 )
457  else if (lowercase(trim(data_set)) == 'reynolds_oi') then
458  file_name_sst = 'INPUT/' // 'reyoi_sst.data'
459  file_name_ice = 'INPUT/' // 'reyoi_sst.data'
460 !--- Added by SJL ----------------------------------------------
461  if ( use_ncep_sst ) then
462  mobs = i_sst; nobs = j_sst
463  if (.not. allocated (sst_ncep)) then
464  allocate (sst_ncep(i_sst,j_sst))
465  sst_ncep(:,:) = big_number
466  endif
467  if (.not. allocated (sst_anom)) then
468  allocate (sst_anom(i_sst,j_sst))
469  sst_anom(:,:) = big_number
470  endif
471  else
472  mobs = 360; nobs = 180
473  endif
474 !--- Added by SJL ----------------------------------------------
475  call set_sst_grid_edges_oi
476  if (mpp_pe() == 0) &
477  call error_mesg ('amip_interp_init', 'using Reynolds OI SST', &
478  note)
479  date_end = date_type( 1999, 1, 0 )
480  else
481  call error_mesg ('amip_interp_init', 'the value of the &
482  &namelist parameter DATA_SET being used is not allowed', fatal)
483  endif
484 
485  if (verbose > 1 .and. mpp_pe() == 0) &
486  print *, 'ice_crit,tice_crit_k=',ice_crit,tice_crit_k
487 
488 ! --- check existence of sst data file ??? ---
489  file_name_sst = trim(file_name_sst)//'.nc'
490  file_name_ice = trim(file_name_ice)//'.nc'
491 
492  if (.not. fms2_io_file_exists(trim(file_name_sst)) ) then
493  call error_mesg ('amip_interp_init', &
494  'file '//trim(file_name_sst)//' does not exist', fatal)
495  endif
496  if (.not. fms2_io_file_exists(trim(file_name_ice)) ) then
497  call error_mesg ('amip_interp_init', &
498  'file '//trim(file_name_ice)//' does not exist', fatal)
499  endif
500 
501  if (.not. open_file(fileobj_sst, trim(file_name_sst), 'read')) &
502  call error_mesg ('amip_interp_init', 'Error in opening file '//trim(file_name_sst), fatal)
503  if (.not. open_file(fileobj_ice, trim(file_name_ice), 'read')) &
504  call error_mesg ('amip_interp_init', 'Error in opening file '//trim(file_name_ice), fatal)
505  module_is_initialized = .true.
506  end subroutine amip_interp_init
507 
508  subroutine set_sst_grid_edges_amip1
509  integer :: i, j
510  real(r8_kind) :: hpie, dlon, dlat, wb, sb
511 
512  allocate(lon_bnd(mobs+1))
513  allocate(lat_bnd(nobs+1))
514 
515 ! ---- compute grid edges (do only once) -----
516 
517  hpie = pi / 2._r8_kind
518 
519  dlon = 4._r8_kind*hpie/real(mobs, r8_kind)
520  wb = -0.5_r8_kind*dlon
521 
522  do i = 1, mobs+1
523  lon_bnd(i) = wb + dlon*real(i-1, r8_kind)
524  enddo
525  lon_bnd(mobs+1) = lon_bnd(1) + 4._r8_kind*hpie
526 
527  dlat = 2._r8_kind*hpie/real(nobs-1, r8_kind)
528  sb = -hpie + 0.5_r8_kind*dlat
529 
530  lat_bnd(1) = -hpie
531  lat_bnd(nobs+1) = hpie
532  do j = 2, nobs
533  lat_bnd(j) = sb + dlat * real(j-2, r8_kind)
534  enddo
535  end subroutine set_sst_grid_edges_amip1
536 
537  subroutine set_sst_grid_edges_oi
538  integer :: i, j
539  real(r8_kind) :: hpie, dlon, dlat, wb, sb
540 
541 ! add by JHC
542  if(allocated(lon_bnd)) deallocate(lon_bnd)
543  if(allocated(lat_bnd)) deallocate(lat_bnd)
544 ! end add by JHC
545 
546  allocate(lon_bnd(mobs+1))
547  allocate(lat_bnd(nobs+1))
548 
549 ! ---- compute grid edges (do only once) -----
550 
551  hpie = pi / 2._r8_kind
552  dlon = 4._r8_kind*hpie/real(mobs, r8_kind)
553  wb = 0.0_r8_kind
554 
555  lon_bnd(1) = wb
556  do i = 2, mobs+1
557  lon_bnd(i) = wb + dlon * real(i-1, r8_kind)
558  enddo
559  lon_bnd(mobs+1) = lon_bnd(1) + 4._r8_kind*hpie
560 
561  dlat = 2._r8_kind*hpie/real(nobs, r8_kind)
562  sb = -hpie
563 
564  lat_bnd(1) = sb
565  lat_bnd(nobs+1) = hpie
566  do j = 2, nobs
567  lat_bnd(j) = sb + dlat * real(j-1, r8_kind)
568  enddo
569  end subroutine set_sst_grid_edges_oi
570 
571 !> Frees data associated with a amip_interp_type variable. Should be used for any
572 !! variables initialized via @ref amip_interp_new.
573 !> @param[inout] Interp A defined data type variable initialized by amip_interp_new and used
574 !! when calling get_amip_sst and get_amip_ice.
575  subroutine amip_interp_del (Interp)
576  type (amip_interp_type), intent(inout) :: interp
577 
578  if(allocated(interp%data1_r4)) deallocate(interp%data1_r4)
579  if(allocated(interp%data1_r8)) deallocate(interp%data1_r8)
580  if(allocated(interp%data2_r4)) deallocate(interp%data2_r4)
581  if(allocated(interp%data2_r8)) deallocate(interp%data2_r8)
582 
583  if(allocated(lon_bnd)) deallocate(lon_bnd)
584  if(allocated(lat_bnd)) deallocate(lat_bnd)
585 
586  call horiz_interp_del ( interp%Hintrp )
587 
588  interp%I_am_initialized = .false.
589  end subroutine amip_interp_del
590 
591 !> @brief Returns the size (i.e., number of longitude and latitude
592 !! points) of the observed data grid.
593 !! @throws FATAL have not called amip_interp_new
594 !! Must call amip_interp_new before get_sst_grid_size.
595  subroutine get_sst_grid_size (nlon, nlat)
596  integer, intent(out) :: nlon !> The number of longitude points (first dimension) in the
597  !! observed data grid. For AMIP 1 nlon = 180, and the Reynolds nlon = 360.
598  integer, intent(out) :: nlat !> The number of latitude points (second dimension) in the
599  !! observed data grid. For AMIP 1 nlon = 91, and the Reynolds nlon = 180.
600 
601  if ( .not.module_is_initialized ) call amip_interp_init
602 
603  nlon = mobs; nlat = nobs
604  end subroutine get_sst_grid_size
605 
606 !> @return logical answer
607 function date_equals (Left, Right) result (answer)
608 type (date_type), intent(in) :: left, right
609 logical :: answer
610 
611  if (left % year == right % year .and. &
612  left % month == right % month .and. &
613  left % day == right % day ) then
614  answer = .true.
615  else
616  answer = .false.
617  endif
618 end function date_equals
619 
620 !> @return logical answer
621 function date_not_equals (Left, Right) result (answer)
622 type (date_type), intent(in) :: left, right
623 logical :: answer
624 
625  if (left % year == right % year .and. &
626  left % month == right % month .and. &
627  left % day == right % day ) then
628  answer = .false.
629  else
630  answer = .true.
631  endif
632 end function date_not_equals
633 
634 !> @return logical answer
635 function date_gt (Left, Right) result (answer)
636 type (date_type), intent(in) :: left, right
637 logical :: answer
638 integer :: i, dif(3)
639 
640  dif(1) = left%year - right%year
641  dif(2) = left%month - right%month
642  dif(3) = left%day - right%day
643  answer = .false.
644  do i = 1, 3
645  if (dif(i) == 0) cycle
646  if (dif(i) < 0) exit
647  if (dif(i) > 0) then
648  answer = .true.
649  exit
650  endif
651  enddo
652 end function date_gt
653 
654 subroutine amip_interp_type_eq (amip_interp_out, amip_interp_in)
655  type(amip_interp_type), intent(inout) :: amip_interp_out
656  type(amip_interp_type), intent(in) :: amip_interp_in
657 
658  if(.not.amip_interp_in%I_am_initialized) then
659  call mpp_error(fatal,'amip_interp_type_eq: amip_interp_type variable on right hand side is unassigned')
660  endif
661 
662  amip_interp_out%Hintrp = amip_interp_in%Hintrp
663  amip_interp_out%Hintrp2 = amip_interp_in%Hintrp2 !< missing assignment statement; added by GPP
664  amip_interp_out%data1_r4 = amip_interp_in%data1_r4
665  amip_interp_out%data1_r8 = amip_interp_in%data1_r8
666  amip_interp_out%data2_r4 = amip_interp_in%data2_r4
667  amip_interp_out%data2_r8 = amip_interp_in%data2_r8
668  amip_interp_out%Date1 = amip_interp_in%Date1
669  amip_interp_out%Date2 = amip_interp_in%Date2
670  amip_interp_out%Date1 = amip_interp_in%Date1
671  amip_interp_out%Date2 = amip_interp_in%Date2
672  amip_interp_out%use_climo = amip_interp_in%use_climo
673  amip_interp_out%use_annual = amip_interp_in%use_annual
674  amip_interp_out%I_am_initialized = .true.
675 end subroutine amip_interp_type_eq
676 
677 #include "amip_interp_r4.fh"
678 #include "amip_interp_r8.fh"
679 
680 end module amip_interp_mod
681 !> @}
682 ! <INFO>
683 
684 ! <FUTURE>
685 ! Add AMIP 2 data set.
686 !
687 ! Other data sets (or extend current data sets).
688 ! </FUTURE>
689 
690 ! </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:580
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:758
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
Definition: fms.F90:525
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
Definition: fms.F90:498
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...