83 #include <fms_platform.h> 121 use fms_mod,
only : lowercase, write_version_number, &
123 file_exist, mpp_root_pe, stdlog, &
124 open_namelist_file, close_file, &
231 interface assignment(=)
255 #include<file_version.h> 263 real,
pointer :: lat(:) =>null()
264 real,
pointer :: lon(:) =>null()
265 real,
pointer :: latb(:) =>null()
266 real,
pointer :: lonb(:) =>null()
267 real,
pointer :: levs(:) =>null()
268 real,
pointer :: halflevs(:) =>null()
269 type(horiz_interp_type) :: interph
272 character(len=64) :: file_name
274 integer :: level_type
275 integer :: is,ie,js,je
276 integer :: vertical_indices
278 logical :: climatological_year
282 character(len=64),
pointer :: field_name(:) =>null()
283 integer,
pointer :: time_init(:,:) =>null()
284 integer,
pointer :: mr(:) =>null()
285 integer,
pointer :: out_of_bounds(:) =>null()
287 integer,
pointer :: vert_interp(:) =>null()
289 real,
pointer :: data(:,:,:,:,:) =>null()
291 real,
pointer :: pmon_pyear(:,:,:,:) =>null()
292 real,
pointer :: pmon_nyear(:,:,:,:) =>null()
293 real,
pointer :: nmon_nyear(:,:,:,:) =>null()
294 real,
pointer :: nmon_pyear(:,:,:,:) =>null()
296 integer,
dimension(:),
pointer :: indexm =>null()
297 integer,
dimension(:),
pointer :: indexp =>null()
298 integer,
dimension(:),
pointer :: climatology =>null()
301 logical :: separate_time_vary_calc
365 #ifdef NO_QUAD_PRECISION 367 integer,
parameter::
f_p = selected_real_kind(15)
370 integer,
parameter::
f_p = selected_real_kind(20)
378 namelist /interpolator_nml/ &
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
404 out%interph = in%interph
405 if (
associated(in%time_slice)) out%time_slice => in%time_slice
407 out%file_name = in%file_name
408 out%time_flag = in%time_flag
409 out%level_type = in%level_type
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
466 data_names, data_out_of_bounds, &
467 vert_interp, clim_units, single_year_file)
469 character(len=*),
intent(in) :: file_name
470 real ,
intent(in) :: lonb_mod(:,:), latb_mod(:,:)
471 character(len=*),
intent(in) ,
optional :: data_names(:)
473 integer ,
intent(in) :: data_out_of_bounds(:)
474 integer ,
intent(in),
optional :: vert_interp(:)
476 character(len=*),
intent(out),
optional :: clim_units(:)
477 logical,
intent(out),
optional :: single_year_file
494 character(len=64) :: src_file
499 logical :: name_present
501 integer :: fileday, filemon, fileyr, filehr, filemin,filesec, m,m1
502 character(len= 20) :: fileunits
503 real,
dimension(:),
allocatable :: alpha
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
511 type(
time_type) :: julian_time, noleap_time
512 real,
allocatable :: time_in(:)
513 real,
allocatable,
save :: agrid_mod(:,:,:)
526 if(file_exist(
'input.nml'))
then 527 #ifdef INTERNAL_FILE_NML 531 unit = open_namelist_file(
'input.nml')
532 ierr=1;
do while (ierr /= 0)
533 read(unit, nml = interpolator_nml, iostat=io, end=10)
536 10
call close_file(unit)
542 clim_type%separate_time_vary_calc = .false.
552 src_file =
'INPUT/'//trim(file_name)
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 )
559 call mpp_error(fatal,
'Interpolator_init : Data file '//trim(src_file)//
' does not exist')
564 clim_type%unit = unit
565 clim_type%file_name = trim(file_name)
568 if(
present(data_names))
num_fields=
size(data_names(:))
583 clim_type%level_type = 0
592 clim_type%vertical_indices = 0
600 allocate(clim_type%lat(
nlat))
601 call mpp_get_axis_data(
axes(i),clim_type%lat)
602 select case(
units(1:6))
604 clim_type%lat = clim_type%lat*dtr
607 call mpp_error(fatal,
"interpolator_init : Units for lat not recognised in file "//file_name)
611 allocate(clim_type%lon(
nlon))
612 call mpp_get_axis_data(
axes(i),clim_type%lon)
613 select case(
units(1:6))
615 clim_type%lon = clim_type%lon*dtr
618 call mpp_error(fatal,
"interpolator_init : Units for lon not recognised in file "//file_name)
622 allocate(clim_type%latb(
nlatb))
623 call mpp_get_axis_data(
axes(i),clim_type%latb)
624 select case(
units(1:6))
626 clim_type%latb = clim_type%latb*dtr
629 call mpp_error(fatal,
"interpolator_init : Units for latb not recognised in file "//file_name)
633 allocate(clim_type%lonb(
nlonb))
634 call mpp_get_axis_data(
axes(i),clim_type%lonb)
635 select case(
units(1:6))
637 clim_type%lonb = clim_type%lonb*dtr
640 call mpp_error(fatal,
"interpolator_init : Units for lonb not recognised in file "//file_name)
644 allocate(clim_type%levs(
nlev))
645 call mpp_get_axis_data(
axes(i),clim_type%levs)
648 if( trim(adjustl(lowercase(
chomp(
units)))) ==
"mb" .or. trim(adjustl(lowercase(
chomp(
units)))) ==
"hpa")
then 649 clim_type%levs = clim_type%levs * 100.
654 if(
sense == 1 )
then 656 allocate (alpha(
nlev))
658 alpha(n) = clim_type%levs(
nlev-n+1)
661 clim_type%levs(n) = alpha(n)
670 allocate(clim_type%halflevs(
nlevh))
671 call mpp_get_axis_data(
axes(i),clim_type%halflevs)
674 if( trim(adjustl(lowercase(
chomp(
units)))) ==
"mb" .or. trim(adjustl(lowercase(
chomp(
units)))) ==
"hpa")
then 675 clim_type%halflevs = clim_type%halflevs * 100.
680 if(
sense == 1 )
then 682 allocate (alpha(
nlevh))
684 alpha(n) = clim_type%halflevs(
nlevh-n+1)
687 clim_type%halflevs(n) = alpha(n)
695 allocate(clim_type%levs(
nlev))
696 call mpp_get_axis_data(
axes(i),clim_type%levs)
697 clim_type%level_type =
sigma 700 allocate(clim_type%halflevs(
nlevh))
701 call mpp_get_axis_data(
axes(i),clim_type%halflevs)
702 clim_type%level_type =
sigma 712 select case(
units(:3))
714 fileunits =
units(12:)
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', &
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
729 fileunits =
units(14:)
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', &
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
744 call mpp_error(fatal,
'Interpolator_init : Time units not recognised in file '//file_name)
747 clim_type%climatological_year = (fileyr == 0)
749 if (.not. clim_type%climatological_year)
then 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 & 763 base_time =
set_date(fileyr, filemon, fileday, filehr, &
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')
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')
780 & filehr, filemin, filesec)
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')
804 allocate(time_in(
ntime), clim_type%time_slice(
ntime))
805 allocate(clim_type%clim_times(12,(
ntime+11)/12))
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)
813 non_monthly = .false.
816 if (time_in(n+1) > (time_in(n) + 32.))
then 821 if (clim_type%climatological_year)
then 822 call mpp_error (note,
'interpolator_mod :' // &
823 trim(file_name) //
' is a year-independent climatology file')
825 call mpp_error (note,
'interpolator_mod :' // &
826 trim(file_name) //
' is a timeseries file')
833 if (clim_type%climatological_year)
then 839 clim_type%time_slice(n) = &
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 861 clim_type%time_slice(n) = &
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
878 str=
'for file ' // trim(file_name) //
', the & 879 &first time slice is mapped to :')
883 str=
'for file ' // trim(file_name) //
', the & 884 &last time slice is mapped to:')
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
899 str=
'for file ' // trim(file_name) //
', the & 900 &first time slice is mapped to :')
904 str=
'for file ' // trim(file_name) //
', the & 905 &last time slice is mapped to:')
915 m = (n-1)/12 +1 ; m1 = n- (m-1)*12
916 clim_type%clim_times(m1,m) = clim_type%time_slice(n)
919 allocate(time_in(1), clim_type%time_slice(1))
920 allocate(clim_type%clim_times(1,1))
922 clim_type%time_slice =
set_time(0,0) + base_time
923 clim_type%clim_times(1,1) =
set_time(0,0) + base_time
934 if( .not.
associated(clim_type%levs) )
then 935 allocate( clim_type%levs(
nlev) )
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
943 else if (clim_type%level_type ==
sigma )
then 944 clim_type%halflevs(
nlev+1) = 1.0
947 clim_type%halflevs(n) = 0.5*(clim_type%levs(n) + &
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)
959 if (.not.
associated(clim_type%lonb) )
then 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
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
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)
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
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
1001 clim_type%lonb, clim_type%latb, &
1005 call mpp_error(note,
"Using Bilinear interpolation")
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))
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,:))
1025 clim_type%lonb, clim_type%latb, &
1026 agrid_mod(:,:,1), agrid_mod(:,:,2), interp_method=
"bilinear")
1047 if (non_monthly)
then 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
1062 allocate(clim_type%data(
size(lonb_mod,1)-1,
size(latb_mod,2)-1,
nlev, 2,
num_fields))
1064 allocate(clim_type%data(
size(lonb_mod,1)-1,
size(latb_mod,2)-1,
nlev, &
1067 clim_type%data = 0.0
1068 clim_type%TIME_FLAG =
linear 1079 allocate(clim_type%data(
size(lonb_mod,1)-1,
size(latb_mod,2)-1,
nlev, 2,
num_fields))
1081 allocate(clim_type%data(
size(lonb_mod,1)-1,
size(latb_mod,2)-1,
nlev, &
1084 clim_type%data = 0.0
1085 clim_type%TIME_FLAG =
linear 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))
1107 if(clim_type%TIME_FLAG .eq.
linear )
then 1115 clim_type%time_init(:,:) = 0
1116 clim_type%indexm(:) = 0
1117 clim_type%indexp(:) = 0
1118 clim_type%climatology(:) = 0
1124 allocate(clim_type%out_of_bounds(
num_fields))
1125 clim_type%out_of_bounds(:)=0
1127 clim_type%vert_interp(:)=0
1133 call mpp_get_fields(clim_type%unit,
varfields)
1135 if(
present(data_names))
then 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)')
1147 do j=1,
size(data_names(:))
1148 name_present = .false.
1151 if( trim(adjustl(lowercase(
name))) == trim(adjustl(lowercase(data_names(j)))) )
then 1153 if (mpp_pe() == 0 )
write(*,*)
'Initializing src field : ',trim(
name)
1154 clim_type%field_name(j) =
name 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(:))) )
1168 call mpp_error(fatal,
"Interpolator_init: vert_interp must be& 1169 & set to INTERP_WEIGHTED_P or INTERP_LINEAR_P")
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.')
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')
1193 if (mpp_pe() ==0 )
write(*,*)
'Initializing src field : ',trim(
name)
1194 clim_type%field_name(i) = lowercase(trim(
name))
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(:))) )
1207 call mpp_error(fatal,
"Interpolator_init: vert_interp must be& 1208 & set to INTERP_WEIGHTED_P or INTERP_LINEAR_P")
1219 if( clim_type%TIME_FLAG .eq.
seasonal )
then 1223 call read_data( clim_type, clim_type%field_type(i), &
1224 clim_type%data(:,:,:,n,i), n, i, base_time )
1233 call read_data( clim_type, clim_type%field_type(i), &
1234 clim_type%data(:,:,:,n,i), n, i, base_time )
1238 call mpp_close (unit)
1241 if( clim_type%TIME_FLAG .eq.
notime )
then 1245 clim_type%data(:,:,:,1,i), i )
1247 call mpp_close (unit)
1250 if (
present (single_year_file))
then 1251 single_year_file = clim_type%climatological_year
1259 call write_version_number(
"INTERPOLATOR_MOD", version)
1261 if (mpp_pe() == mpp_root_pe() ) &
1262 write (stdlog(), nml=interpolator_nml)
1277 real ,
intent(in ) :: q1(2), q2(2), q3(2), q4(2)
1278 real ,
intent(out) :: e2(2)
1280 real p1(3), p2(3), p3(3), p4(3)
1291 ec(k) = p1(k) + p2(k) + p3(k) + p4(k)
1293 dd = sqrt( ec(1)**2 + ec(2)**2 + ec(3)**2 )
1313 integer,
intent(in):: np
1314 real,
intent(inout):: q(3,np)
1315 real,
intent(inout):: xs(np), ys(np)
1317 real,
parameter:: esl=1.e-10
1319 real (f_p):: dist, lat, lon
1326 dist = sqrt(p(1)**2 + p(2)**2 + p(3)**2)
1331 if ( (abs(p(1))+abs(p(2))) < esl )
then 1334 lon = atan2( p(2), p(1) )
1337 if ( lon < 0.) lon = 2.*
pi + lon
1360 real,
intent(in) :: p(2)
1361 real,
intent(out):: e(3)
1365 real (f_p):: e1, e2, e3
1371 e1 = cos(q(2)) * cos(q(1))
1372 e2 = cos(q(2)) * sin(q(1))
1402 character(len=*),
intent(in) ::
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')
1452 integer ,
intent(in) :: mod_axes(:)
1453 type(
time_type) ,
intent(in) :: init_time
1455 integer ::
axes(2),nxd,nyd,ndivs,i
1457 integer :: domain_layout(2), iscomp, iecomp,jscomp,jecomp
1461 call mpp_error(fatal,
"init_clim_diag : You must call interpolator_init before calling init_clim_diag")
1465 nxd =
size(clim_type%lon(:))
1466 nyd =
size(clim_type%lat(:))
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
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(:))
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
1539 integer :: indexm, indexp, yearm, yearp
1541 character(len=256) :: err_msg
1543 if (clim_type%climatological_year)
then 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)
1553 clim_type%tweight = 0.
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)
1563 if(clim_type%TIME_FLAG .eq.
bilinear )
then 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 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)
1581 do m = 1,
size(clim_type%clim_times(:,:),2)
1583 call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
1584 if (year1 == climyear) climatology = m
1588 call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
1589 if ( month1 == modmonth )
then 1591 if ( modday < day )
then 1592 indexm = m-1 ; indexp = m
1594 indexm = m ; indexp = m+1
1599 if ( indexm == 0 )
then 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 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)
1618 call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg )
1620 if (taum==2 .and. taup==2) clim_type%tweight3 = 1.
1622 if(trim(err_msg) /=
'')
then 1623 call mpp_error(fatal,
'interpolator_timeslice 3: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
1632 if (taum==2 .and. taup==2) clim_type%tweight1 = 1.
1634 if(trim(err_msg) /=
'')
then 1635 call mpp_error(fatal,
'interpolator_timeslice 4: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
1644 if (taum==2 .and. taup==2) clim_type%tweight2 = 1.
1646 if(trim(err_msg) /=
'')
then 1647 call mpp_error(fatal,
'interpolator_timeslice 5: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
1650 if (indexm == clim_type%indexm(1) .and. &
1651 indexp == clim_type%indexp(1) .and. &
1652 climatology == clim_type%climatology(1))
then 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)
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)
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 1684 call read_data(clim_type,clim_type%field_type(i), &
1685 clim_type%pmon_pyear(:,:,:,i), taum,i,time)
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
1700 clim_type%indexm(:) = 0
1701 clim_type%indexp(:) = 0
1702 clim_type%climatology(:) = 0
1706 clim_type%tweight1 = 0.0
1707 clim_type%tweight2 = 0.0
1708 clim_type%tweight3 = clim_type%tweight
1712 if(clim_type%TIME_FLAG .eq.
linear .and. &
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
1722 if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0)
then 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
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
1736 if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0)
then 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?')
1741 if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0)
then 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
1754 clim_type%separate_time_vary_calc = .true.
1774 clim_type%separate_time_vary_calc = .false.
1813 field_name, is,js, clim_units)
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
1860 call mpp_error(fatal,
"interpolator_4D : You must call interpolator_init before calling interpolator")
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)
1868 call mpp_error (fatal,
'interpolator_mod: & 1869 &cannot use 4D interface to interpolator for this file')
1877 if (
present(is)) istart = is
1878 iend = istart - 1 +
size(interp_data,1)
1881 if (
present(js)) jstart = js
1882 jend = jstart - 1 +
size(interp_data,2)
1884 do i= 1,
size(clim_type%field_name(:))
1886 if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) )
then 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)
1908 if ( .not. clim_type%separate_time_vary_calc)
then 1912 if (clim_type%climatological_year)
then 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)
1922 clim_type%tweight = 0.
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)
1932 if(clim_type%TIME_FLAG .eq.
bilinear )
then 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 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)
1950 do m = 1,
size(clim_type%clim_times(:,:),2)
1952 call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
1953 if (year1 == climyear) climatology = m
1957 call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
1958 if ( month1 == modmonth )
then 1960 if ( modday < day )
then 1961 indexm = m-1 ; indexp = m
1963 indexm = m ; indexp = m+1
1968 if ( indexm == 0 )
then 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 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)
1987 call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg )
1989 if (taum==2 .and. taup==2) clim_type%tweight3 = 1.
1991 if(trim(err_msg) /=
'')
then 1992 call mpp_error(fatal,
'interpolator_4D 3: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
2001 if (taum==2 .and. taup==2) clim_type%tweight1 = 1.
2003 if(trim(err_msg) /=
'')
then 2004 call mpp_error(fatal,
'interpolator_4D 4: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
2012 if (taum==2 .and. taup==2) clim_type%tweight2 = 1.
2014 if(trim(err_msg) /=
'')
then 2015 call mpp_error(fatal,
'interpolator_4D 5: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
2018 if (indexm == clim_type%indexm(1) .and. &
2019 indexp == clim_type%indexp(1) .and. &
2020 climatology == clim_type%climatology(1))
then 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)
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)
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 2052 call read_data(clim_type,clim_type%field_type(i), &
2053 clim_type%pmon_pyear(:,:,:,i), taum,i,time)
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
2068 clim_type%indexm(:) = 0
2069 clim_type%indexp(:) = 0
2070 clim_type%climatology(:) = 0
2074 clim_type%tweight1 = 0.0
2075 clim_type%tweight2 = 0.0
2076 clim_type%tweight3 = clim_type%tweight
2080 if(clim_type%TIME_FLAG .eq.
linear .and. &
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
2090 if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0)
then 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
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
2104 if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0)
then 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?')
2109 if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0)
then 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
2126 select case(clim_type%TIME_FLAG)
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)
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)
2151 select case(clim_type%level_type)
2155 p_fact = maxval(phalf,3)
2159 do i= 1,
size(clim_type%field_name(:))
2161 select case(clim_type%mr(i))
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 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)
2177 do i= 1,
size(clim_type%field_name(:))
2180 if ( trim(adjustl(lowercase(
climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i)))))
then 2188 result = send_data(
hinterp_id(j),col_data(:,:,i),time,is_in=istart,js_in=jstart)
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 2202 call mpp_error(note,
"Interpolator: model surface pressure& 2203 & is greater than climatology surface pressure for "&
2204 // trim(clim_type%file_name))
2206 select case(clim_type%out_of_bounds(i))
2208 pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
2213 if ( minval(phalf(ilon,j,:)) < minval(pclim) )
then 2215 call mpp_error(note,
"Interpolator: model top pressure& 2216 & is less than climatology top pressure for "&
2217 // trim(clim_type%file_name))
2219 select case(clim_type%out_of_bounds(i))
2221 pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
2226 select case(clim_type%vert_interp(i))
2228 call interp_weighted_scalar(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,:),interp_data(ilon,j,:,:))
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))
2239 do i= 1,
size(clim_type%field_name(:))
2241 select case(clim_type%mr(i))
2243 do k = 1,
size(interp_data,3)
2244 interp_data(:,:,k,i) = interp_data(:,:,k,i)*(phalf(:,:,k+1)-phalf(:,:,k))
2250 if( .not. found_field)
then 2251 call mpp_error(fatal,
"Interpolator: the field name is not contained in this & 2252 &intepolate_type: "//trim(field_name))
2287 subroutine interpolator_3d(clim_type, Time, phalf, interp_data,field_name, is,js, clim_units)
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
2332 call mpp_error(fatal,
"interpolator_3D : You must call interpolator_init before calling interpolator")
2335 if (
present(is)) istart = is
2336 iend = istart - 1 +
size(interp_data,1)
2339 if (
present(js)) jstart = js
2340 jend = jstart - 1 +
size(interp_data,2)
2342 do i= 1,
size(clim_type%field_name(:))
2344 if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) )
then 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)
2359 if ( .not. clim_type%separate_time_vary_calc)
then 2362 if (clim_type%climatological_year)
then 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)
2372 clim_type%tweight = 0.
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)
2384 clim_type%itaum=taum
2385 clim_type%itaup=taup
2388 if(clim_type%TIME_FLAG .eq.
bilinear )
then 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 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)
2406 do m = 1,
size(clim_type%clim_times(:,:),2)
2408 call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
2409 if (year1 == climyear) climatology = m
2413 call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
2414 if ( month1 == modmonth )
then 2416 if ( modday < day )
then 2417 indexm = m-1 ; indexp = m
2419 indexm = m ; indexp = m+1
2424 if ( indexm == 0 )
then 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 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)
2443 call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg )
2445 if (taum==2 .and. taup==2) clim_type%tweight3 = 1.
2447 if(trim(err_msg) /=
'')
then 2448 call mpp_error(fatal,
'interpolator_3D 3: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
2457 if (taum==2 .and. taup==2) clim_type%tweight1 = 1.
2459 if(trim(err_msg) /=
'')
then 2460 call mpp_error(fatal,
'interpolator_3D 4: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
2469 if (taum==2 .and. taup==2) clim_type%tweight2 = 1.
2471 if(trim(err_msg) /=
'')
then 2472 call mpp_error(fatal,
'interpolator_3D 5: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
2476 if (indexm == clim_type%indexm(i) .and. &
2477 indexp == clim_type%indexp(i) .and. &
2478 climatology == clim_type%climatology(i))
then 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)
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)
2503 if (taum /= clim_type%time_init(i,1) .or. &
2504 taup /= clim_type%time_init(i,2) )
then 2506 call read_data(clim_type,clim_type%field_type(i), clim_type%pmon_pyear(:,:,:,i), taum,i,time)
2508 call read_data(clim_type,clim_type%field_type(i), clim_type%nmon_pyear(:,:,:,i), taup,i,time)
2518 clim_type%indexm(i) = 0
2519 clim_type%indexp(i) = 0
2520 clim_type%climatology(i) = 0
2523 clim_type%time_init(i,1) = taum
2524 clim_type%time_init(i,2) = taup
2527 clim_type%tweight1 = 0.0 ; clim_type%tweight2 = 0.0
2528 clim_type%tweight3 = clim_type%tweight
2534 if(clim_type%TIME_FLAG .eq.
linear .and. &
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
2544 if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0)
then 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
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
2556 if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0)
then 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?')
2561 if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0)
then 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
2573 select case(clim_type%TIME_FLAG)
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)
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)
2590 select case(clim_type%level_type)
2594 p_fact = maxval(phalf,3)
2598 select case(clim_type%mr(i))
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 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)
2615 if ( trim(adjustl(lowercase(
climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i)))))
then 2623 result = send_data(
hinterp_id(j),col_data,time,is_in=istart,js_in=jstart)
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 2634 call mpp_error(note,
"Interpolator: model surface pressure& 2635 & is greater than climatology surface pressure for "&
2636 // trim(clim_type%file_name))
2638 select case(clim_type%out_of_bounds(i))
2640 pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
2645 if ( minval(phalf(ilon,j,:)) < minval(pclim) )
then 2647 call mpp_error(note,
"Interpolator: model top pressure& 2648 & is less than climatology top pressure for "&
2649 // trim(clim_type%file_name))
2651 select case(clim_type%out_of_bounds(i))
2653 pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
2658 select case(clim_type%vert_interp(i))
2662 call interp_linear(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
2670 select case(clim_type%mr(i))
2672 do k = 1,
size(interp_data,3)
2673 interp_data(:,:,k) = interp_data(:,:,k)*(phalf(:,:,k+1)-phalf(:,:,k))
2679 if( .not. found_field)
then 2680 call mpp_error(fatal,
"Interpolator: the field name is not contained in this & 2681 &intepolate_type: "//trim(field_name))
2711 subroutine interpolator_2d(clim_type, Time, interp_data, field_name, is, js, clim_units)
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
2747 character(len=256) :: err_msg
2750 call mpp_error(fatal,
"interpolator_2D : You must call interpolator_init before calling interpolator")
2753 if (
present(is)) istart = is
2754 iend = istart - 1 +
size(interp_data,1)
2757 if (
present(js)) jstart = js
2758 jend = jstart - 1 +
size(interp_data,2)
2760 do i= 1,
size(clim_type%field_name(:))
2762 if ( trim(adjustl(lowercase(field_name))) == trim(adjustl(lowercase(clim_type%field_name(i)))) )
then 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)
2779 if ( .not. clim_type%separate_time_vary_calc)
then 2782 if (clim_type%climatological_year)
then 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)
2792 clim_type%tweight = 0.
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)
2806 clim_type%itaum=taum
2807 clim_type%itaup=taup
2834 if(clim_type%TIME_FLAG .eq.
bilinear )
then 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 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)
2852 do m = 1,
size(clim_type%clim_times(:,:),2)
2854 call get_date(clim_type%clim_times(1,m), year1, month1, day, hour, minute, second)
2855 if (year1 == climyear) climatology = m
2859 call get_date(clim_type%clim_times(m,climatology), year1, month1, day, hour, minute, second)
2860 if ( month1 == modmonth )
then 2862 if ( modday < day )
then 2863 indexm = m-1 ; indexp = m
2865 indexm = m ; indexp = m+1
2870 if ( indexm == 0 )
then 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 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)
2889 call time_interp(time, month, clim_type%tweight3, taum, taup, err_msg=err_msg )
2891 if (taum==2 .and. taup==2) clim_type%tweight3 = 1.
2893 if(trim(err_msg) /=
'')
then 2894 call mpp_error(fatal,
'interpolator_2D 3: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
2903 if (taum==2 .and. taup==2) clim_type%tweight1 = 1.
2905 if(trim(err_msg) /=
'')
then 2906 call mpp_error(fatal,
'interpolator_2D 4: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
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 )
2915 if (taum==2 .and. taup==2) clim_type%tweight2 = 1.
2917 if(trim(err_msg) /=
'')
then 2918 call mpp_error(fatal,
'interpolator_2D 5: '//trim(err_msg)//
' file='//trim(clim_type%file_name), fatal)
2922 if (indexm == clim_type%indexm(i) .and. &
2923 indexp == clim_type%indexp(i) .and. &
2924 climatology == clim_type%climatology(i))
then 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)
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)
2949 if (taum /= clim_type%time_init(i,1) .or. &
2950 taup /= clim_type%time_init(i,2) )
then 2952 call read_data(clim_type,clim_type%field_type(i), clim_type%pmon_pyear(:,:,:,i), taum,i,time)
2954 call read_data(clim_type,clim_type%field_type(i), clim_type%nmon_pyear(:,:,:,i), taup,i,time)
2964 clim_type%indexm(i) = 0
2965 clim_type%indexp(i) = 0
2966 clim_type%climatology(i) = 0
2969 clim_type%time_init(i,1) = taum
2970 clim_type%time_init(i,2) = taup
2973 clim_type%tweight1 = 0.0 ; clim_type%tweight2 = 0.0
2974 clim_type%tweight3 = clim_type%tweight
2979 if(clim_type%TIME_FLAG .eq.
linear .and. &
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
2989 if (clim_type%itaum.eq.0 .and. clim_type%itaup.eq.0)
then 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
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
3001 if (clim_type%itaum.eq.0 .and. clim_type%itaup.ne.0)
then 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?')
3006 if (clim_type%itaum.ne.0 .and. clim_type%itaup.eq.0)
then 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
3019 select case(clim_type%TIME_FLAG)
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)
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)
3036 if (trim(adjustl(lowercase(
climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i)))))
then 3044 result = send_data(
hinterp_id(j),hinterp_data,time,is_in=istart,js_in=jstart)
3048 interp_data(:,:) = hinterp_data(:,:,1)
3053 if( .not. found_field)
then 3054 call mpp_error(fatal,
"Interpolator: the field name is not contained in this & 3055 &intepolate_type: "//trim(field_name))
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
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
3115 logical :: found_field=.false.
3116 integer :: i, j, k, n
3119 call mpp_error(fatal,
"interpolator_4D_no_time_axis : You must call interpolator_init before calling interpolator")
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)
3127 call mpp_error (fatal,
'interpolator_mod: & 3128 &cannot use 4D interface to interpolator for this file')
3133 if (
present(is)) istart = is
3134 iend = istart - 1 +
size(interp_data,1)
3137 if (
present(js)) jstart = js
3138 jend = jstart - 1 +
size(interp_data,2)
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 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)
3153 do n=1,
size(clim_type%field_name(:))
3154 hinterp_data(:,:,:,n) = clim_type%data(istart:iend,jstart:jend,:,1,n)
3157 select case(clim_type%level_type)
3161 p_fact = maxval(phalf,3)
3164 do i= 1,
size(clim_type%field_name(:))
3165 select case(clim_type%mr(i))
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)
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 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))
3184 select case(clim_type%out_of_bounds(i))
3186 pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
3189 if ( minval(phalf(ilon,j,:)) < minval(pclim) )
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))
3195 select case(clim_type%out_of_bounds(i))
3197 pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
3200 select case(clim_type%vert_interp(i))
3202 call interp_weighted_scalar(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:,:),interp_data(ilon,j,:,:))
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))
3211 do i= 1,
size(clim_type%field_name(:))
3213 select case(clim_type%mr(i))
3215 do k = 1,
size(interp_data,3)
3216 interp_data(:,:,k,i) = interp_data(:,:,k,i)*(phalf(:,:,k+1)-phalf(:,:,k))
3222 if( .not. found_field)
then 3223 call mpp_error(fatal,
"Interpolator: the field name is not contained in this & 3224 &intepolate_type: "//trim(field_name))
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
3279 integer :: taum, taup, ilon
3280 real :: hinterp_data(size(interp_data,1),size(interp_data,2),size(clim_type%levs(:)))
3281 real :: p_fact(size(interp_data,1),size(interp_data,2))
3282 real :: pclim(size(clim_type%halflevs(:)))
3283 integer :: istart,iend,jstart,jend
3285 logical :: found_field=.false.
3286 integer :: i, j, k, n
3289 call mpp_error(fatal,
"interpolator_3D_no_time_axis : You must call interpolator_init before calling interpolator")
3292 if (
present(is)) istart = is
3293 iend = istart - 1 +
size(interp_data,1)
3296 if (
present(js)) jstart = js
3297 jend = jstart - 1 +
size(interp_data,2)
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 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)
3307 hinterp_data = clim_type%data(istart:iend,jstart:jend,:,1,i)
3309 select case(clim_type%level_type)
3313 p_fact = maxval(phalf,3)
3316 select case(clim_type%mr(i))
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)
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 3328 call mpp_error(note,
"Interpolator: model surface pressure& 3329 & is greater than climatology surface pressure for "&
3330 // trim(clim_type%file_name))
3332 select case(clim_type%out_of_bounds(i))
3334 pclim( maxloc(pclim) ) = maxval( phalf(ilon,j,:) )
3337 if ( minval(phalf(ilon,j,:)) < minval(pclim) )
then 3339 call mpp_error(note,
"Interpolator: model top pressure& 3340 & is less than climatology top pressure for "&
3341 // trim(clim_type%file_name))
3343 select case(clim_type%out_of_bounds(i))
3345 pclim( minloc(pclim) ) = minval( phalf(ilon,j,:) )
3348 select case(clim_type%vert_interp(i))
3352 call interp_linear(pclim, phalf(ilon,j,:),hinterp_data(ilon,j,:),interp_data(ilon,j,:))
3357 select case(clim_type%mr(i))
3359 do k = 1,
size(interp_data,3)
3360 interp_data(:,:,k) = interp_data(:,:,k)*(phalf(:,:,k+1)-phalf(:,:,k))
3366 if( .not. found_field)
then 3367 call mpp_error(fatal,
"Interpolator: the field name is not contained in this & 3368 &intepolate_type: "//trim(field_name))
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
3415 logical :: found_field=.false.
3416 integer :: j, k, i, n
3419 call mpp_error(fatal,
"interpolator_2D_no_time_axis : You must call interpolator_init before calling interpolator")
3422 if (
present(is)) istart = is
3423 iend = istart - 1 +
size(interp_data,1)
3426 if (
present(js)) jstart = js
3427 jend = jstart - 1 +
size(interp_data,2)
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 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)
3439 hinterp_data = clim_type%data(istart:iend,jstart:jend,:,1,i)
3441 interp_data(:,:) = hinterp_data(:,:,1)
3446 if( .not. found_field)
then 3447 call mpp_error(fatal,
"Interpolator: the field name is not contained in this & 3448 &intepolate_type: "//trim(field_name))
3470 if ( mpp_pe() == mpp_root_pe() )
then 3471 write (logunit,
'(/,(a))')
'Exiting interpolator, have a nice day ...' 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)
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)
3497 if( .not. (clim_type%TIME_FLAG .eq.
linear .and. &
3500 call mpp_close(clim_type%unit)
3521 subroutine read_data(clim_type,src_field, hdata, nt,i, Time)
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
3544 real,
allocatable :: climdata(:,:,:), climdata2(:,:,:)
3546 allocate(climdata(
size(clim_type%lon(:)),
size(clim_type%lat(:)), &
3547 size(clim_type%levs(:))))
3549 call mpp_read(clim_type%unit,src_field, climdata,nt)
3555 allocate(climdata2(
size(clim_type%lon(:)), &
3556 size(clim_type%lat(:)), &
3557 size(clim_type%levs(:))))
3558 km =
size(clim_type%levs(:))
3560 climdata2(:,:,k) = climdata(:,:,km+1-k)
3562 climdata = climdata2
3563 deallocate (climdata2)
3566 call horiz_interp(clim_type%interph, climdata, hdata)
3569 deallocate(climdata)
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
3605 real,
allocatable :: climdata(:,:,:), climdata2(:,:,:)
3607 allocate(climdata(
size(clim_type%lon(:)),
size(clim_type%lat(:)),
size(clim_type%levs(:))))
3609 call mpp_read(clim_type%unit,src_field, climdata)
3615 allocate(climdata2(
size(clim_type%lon(:)), &
3616 size(clim_type%lat(:)), &
3617 size(clim_type%levs(:))))
3618 km =
size(clim_type%levs(:))
3620 climdata2(:,:,k) = climdata(:,:,km+1-k)
3622 climdata = climdata2
3623 deallocate (climdata2)
3626 call horiz_interp(clim_type%interph, climdata, hdata)
3627 deallocate(climdata)
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
3657 real :: col_data(size(model_data,1),size(model_data,2))
3658 logical :: result, found
3663 if (trim(adjustl(lowercase(
climo_diag_name(j)))) .eq. trim(adjustl(lowercase(clim_type%field_name(i)))))
then 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
3677 result = send_data(
climo_diag_id(j),col_data(clim_type%is:clim_type%ie,clim_type%js:clim_type%je),time)
3699 integer,
intent(out),
optional :: nfields
3700 character(len=*),
dimension(:),
intent(out),
optional :: field_names
3702 if(
present( nfields ) ) nfields =
SIZE( clim_type%field_name(:) )
3703 if(
present( field_names ) ) field_names = clim_type%field_name
3715 function chomp(string)
3719 character(len=*),
intent(in) ::
string 3720 character(len=64) ::
chomp 3743 real,
intent(in),
dimension(:) :: grdin, grdout
3744 real,
intent(in),
dimension(:,:) :: datin
3745 real,
intent(out),
dimension(:,:) :: datout
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')
3754 do k = 1,
size(datout,1 )
3757 do j = 1,
size(datin,1 )
3759 if ( grdin(j) <= grdout(k) .and. &
3760 grdin(j+1) >= grdout(k) .and. &
3761 grdin(j+1) <= grdout(k+1) )
then 3763 do n= 1,
size(datin,2)
3764 datout(k,n) = datout(k,n) + datin(j,n)*(grdin(j+1)-grdout(k))
3767 else if ( grdin(j) >= grdout(k) .and. &
3768 grdin(j) <= grdout(k+1) .and. &
3769 grdin(j+1) >= grdout(k+1) )
then 3771 do n= 1,
size(datin,2)
3772 datout(k,n) = datout(k,n) + datin(j,n)*(grdout(k+1)-grdin(j))
3775 else if ( grdin(j) >= grdout(k) .and. &
3776 grdin(j+1) <= grdout(k+1) )
then 3778 do n= 1,
size(datin,2)
3779 datout(k,n) = datout(k,n) + datin(j,n)*(grdin(j+1)-grdin(j))
3782 else if ( grdin(j) <= grdout(k) .and. &
3783 grdin(j+1) >= grdout(k+1) )
then 3785 do n= 1,
size(datin,2)
3786 datout(k,n) = datout(k,n) + datin(j,n)*(grdout(k+1)-grdout(k))
3793 do n= 1,
size(datin,2)
3794 datout(k,n) = datout(k,n)/(grdout(k+1)-grdout(k))
3812 real,
intent(in),
dimension(:) :: grdin, grdout, datin
3813 real,
intent(out),
dimension(:) :: datout
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')
3822 do k = 1,
size(datout(:))
3825 do j = 1,
size(datin(:))
3827 if ( grdin(j) <= grdout(k) .and. &
3828 grdin(j+1) >= grdout(k) .and. &
3829 grdin(j+1) <= grdout(k+1) )
then 3831 datout(k) = datout(k) + datin(j)*(grdin(j+1)-grdout(k))
3833 else if ( grdin(j) >= grdout(k) .and. &
3834 grdin(j) <= grdout(k+1) .and. &
3835 grdin(j+1) >= grdout(k+1) )
then 3837 datout(k) = datout(k) + datin(j)*(grdout(k+1)-grdin(j))
3839 else if ( grdin(j) >= grdout(k) .and. &
3840 grdin(j+1) <= grdout(k+1) )
then 3842 datout(k) = datout(k) + datin(j)*(grdin(j+1)-grdin(j))
3844 else if ( grdin(j) <= grdout(k) .and. &
3845 grdin(j+1) >= grdout(k+1) )
then 3847 datout(k) = datout(k) + datin(j)*(grdout(k+1)-grdout(k))
3853 datout(k) = datout(k)/(grdout(k+1)-grdout(k))
3871 real,
intent(in),
dimension(:) :: grdin, grdout, datin
3872 real,
intent(out),
dimension(:) :: datout
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')
3886 do k= 1,
size(datout(:))
3889 if (grdin(1) < grdin(n))
then 3890 do j = 2,
size(grdin(:))-1
3891 if (grdout(k) <= grdin(j))
exit 3895 do j =
size(grdin(:)), 3, -1
3896 if (grdout(k) <= grdin(j-1))
exit 3901 wt = (grdout(k)-grdin(j-1)) / (grdin(j)-grdin(j-1))
3906 datout(k) = (1.-wt)*datin(j-1) + wt*datin(j)
3921 #ifdef INTERNAL_FILE_NML 3941 integer,
parameter :: nsteps_per_day = 8, ndays = 16
3942 real,
parameter :: delt = 1.0/nsteps_per_day
3944 integer,
parameter :: nxd = 20, nyd = 40, ntsteps = nsteps_per_day*ndays, two_delt = 2*delt
3945 integer :: delt_days, delt_secs
3948 integer :: i,k,n,level
3949 integer :: unit, io_status
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)
3958 character(len=1) :: dest_grid
3959 character(len=128) :: src_file, file_out, title,
units, colaer
3960 logical :: vector_field=.false., result
3962 type(
axistype),
allocatable,
dimension(:) :: axes_out, axes_src
3964 type(
fieldtype),
allocatable,
dimension(:) :: fields
3966 field_geolat_t, field_geolon_c, field_geolat_c
3967 type(
atttype),
allocatable,
dimension(:) :: global_atts
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(:)
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"/
3984 integer :: out_of_bounds(1)
3988 namelist /interpolator_nml/ src_file
3992 delt_days = int(delt)
3995 write(*,*) delt, delt_days,delt_secs
3999 call mpp_domains_init
4009 src_file =
'src_file' 4012 model_time =
set_date(1979,12,1,0,0,0)
4022 #ifdef INTERNAL_FILE_NML 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')
4031 call mpp_close(unit)
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))
4050 lambda = -1.0*log(p_top/p_bot)/(level+1)
4052 p_half(:,:,level+1) = p_bot
4054 p_half(:,:,i)=p_half(:,:,i+1)*exp(-1.0*lambda)
4057 p_full(:,:,i)=(p_half(:,:,i+1)+p_half(:,:,i))/2.0
4060 allocate(model_data(isd:ied,jsd:jed,level))
4065 lonb_mod(i,:) = (i-1)*dx
4068 latb_mod(:,i) = -90. + (i-1)*dy
4071 lon_mod(i)=(lonb_mod(i+1,1)+lonb_mod(i,1))/2.0
4074 lat_mod(i)=(latb_mod(1,i+1)+latb_mod(1,i))/2.0
4077 lonb_mod = lonb_mod * dtr
4078 latb_mod = latb_mod * dtr
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')
4089 do i=1,
size(names(:))
4090 colaer =
'col'//trim(names(i))
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)
4099 call sulfate_init(aerosol,lonb_mod(isd:ied+1,jsd:jed+1), latb_mod(isd:ied+1,jsd:jed+1), names, &
4104 if( mpp_pe() == mpp_root_pe() )
write(*,*) n
4106 call get_ozone(o3,model_time,p_half,model_data)
4108 if(interp_diagnostic_id>0) &
4109 result =
send_data(interp_diagnostic_id,&
4110 model_data(iscomp:iecomp,jscomp:jecomp,:),model_time)
4112 if(column_diagnostic_id1>0)
then 4114 col_data(iscomp:iecomp,jscomp:jecomp)=0.0
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 4120 result =
send_data(column_diagnostic_id1,col_data(:,:),model_time)
4125 do i=1,
size(names(:))
4129 if(column_diagnostic_id(i)>0)
then 4131 col_data(iscomp:iecomp,jscomp:jecomp)=0.0
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)
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 4142 result =
send_data(column_diagnostic_id(i),&
4143 col_data(iscomp:iecomp,jscomp:jecomp),model_time)
4148 model_time = model_time +
set_time(delt_secs,delt_days)
4157 deallocate(lonb_mod, lon_mod, latb_mod,lat_mod, col_data, p_half, p_full, model_data)
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(:)
4173 if (.not. file_exist(
"INPUT/aerosol.climatology.nc") )
return 4175 data_names=names, data_out_of_bounds=data_out_of_bounds, &
4176 vert_interp=vert_interp, clim_units=units )
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
4191 call interpolator( sulfate, model_time, p_half, model_data, name, is, js, clim_units)
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(:)
4205 if (.not. file_exist(
"INPUT/o3.climatology.nc") )
return 4207 data_out_of_bounds=data_out_of_bounds, vert_interp=vert_interp )
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
4220 call interpolator( o3, model_time, p_half, model_data,
"ozone", is, js)
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
integer function, public check_nml_error(IOSTAT, NML_NAME)
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...
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
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)
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].
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.
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].
integer, parameter seconds_per_day
interpolator_mod is a module to interpolate climatology data to model the grid.
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.
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.