00001 !------------------------------------------------------------------------------- 00002 subroutine bc_interp( sib, time ) 00003 !------------------------------------------------------------------------------- 00004 ! interpolates between bc data points 00005 ! 00006 ! Modifications: 00007 ! Kevin Schaefer created subrotine from bc_update_sib code (3/14/03) 00008 ! Kevin Schaefer removed print statements (3/17/03) 00009 ! Kevin Schaefer moved isotope interpolation to separate routine (2/21/03) 00010 ! Kevin Schaefer deleted LAI underflow patch, already done in laigrn (4/4/03) 00011 ! Kevin Schaefer added ndvi interpolation (7/9/03) 00012 ! Kevin Schaefer changed ndvi variable names to match bc convention (3/15/05) 00013 ! prevndvi to ndvi1 curndvi to ndvi2 00014 ! Kevin Schaefer changed to generic interpolation (8/2/05) 00015 !----------------------------------------------------------------------- 00016 ! 00017 use sibtype 00018 use timetype 00019 use sib_const_module 00020 use sib_bc_module 00021 ! 00022 implicit none 00023 ! 00024 ! parameters 00025 type(sib_t), dimension(subcount), intent(inout) :: sib 00026 type(time_struct), intent(in) :: time 00027 00028 ! local variables 00029 integer i, k ! indices 00030 real fac1 ! scaling factor between ndvi1 and current time 00031 real fac2 ! scaling factor between ndvi2 and current time 00032 real time1 ! (day) local version of ndvi1 time 00033 real time2 ! (day) local version of ndvi2 time 00034 logical(kind=log_kind) :: switch_param ! switch parameters for single point 00035 ! 00036 ! loop through sib points 00037 do i = 1, subcount 00038 ! 00039 !itb_modis 00040 ! switch to local ndvi times 00041 ! time1=sib(i)%param%ndvi_time1 00042 ! time2=sib(i)%param%ndvi_time2 00043 00044 time1=sib(i)%param%modis_time1 00045 time2=sib(i)%param%modis_time2 00046 00047 ! interpolation times in different years 00048 00049 ! if (sib(i)%param%ndvi_time1>sib(i)%param%ndvi_time2) then 00050 if (sib(i)%param%modis_time1>sib(i)%param%modis_time2) then 00051 ! time1 in previous year 00052 ! if(time%real_doy<=time%ndvi_stop(1)) then 00053 if(time%real_doy<=time%modis_stop(1)) then 00054 ! time1=sib(i)%param%ndvi_time1-real(time%days_per_year) 00055 time1=sib(i)%param%modis_time1-real(time%days_per_year) 00056 endif 00057 ! time2 in next year 00058 ! if(time%real_doy>=time%ndvi_start(nper))then 00059 if(time%real_doy>=time%modis_start(nper))then 00060 ! time2=sib(i)%param%ndvi_time2+real(time%days_per_year) 00061 time2=sib(i)%param%modis_time2+real(time%days_per_year) 00062 endif 00063 endif 00064 if(time1==time2) then 00065 print'(a,i5,2f10.3)', '(bc_interp)Seatbelts on, we gonna crash!', i,time1,time2 00066 endif 00067 ! 00068 ! Calculate scaling factors for parameter interpolation 00069 fac2=(time%real_doy-time1)/(time2-time1) 00070 fac1=1.0-fac2 00071 ! 00072 ! interpolate parameters 00073 ! sib(i)%param%ndvi = fac1*sib(i)%param%ndvi1 + fac2*sib(i)%param%ndvi2 00074 sib(i)%param%mlai = fac1*sib(i)%param%mlai1 + fac2*sib(i)%param%mlai2 00075 !print*,'MODIS:',sib(i)%param%mlai3,sib(i)%param%mfpar3 00076 sib(i)%param%mfpar = fac1*sib(i)%param%mfpar1 + fac2*sib(i)%param%mfpar2 00077 sib(i)%param%aparc = fac1*sib(i)%param%aparc1 + fac2*sib(i)%param%aparc2 00078 sib(i)%param%zlt = fac1*sib(i)%param%zlt1 + fac2*sib(i)%param%zlt2 00079 sib(i)%param%green = fac1*sib(i)%param%green1 + fac2*sib(i)%param%green2 00080 sib(i)%param%z0d = fac1*sib(i)%param%z0d1 + fac2*sib(i)%param%z0d2 00081 sib(i)%param%zp_disp = fac1*sib(i)%param%zp_disp1 + fac2*sib(i)%param%zp_disp2 00082 sib(i)%param%cc1 = fac1*sib(i)%param%rbc1 + fac2*sib(i)%param%rbc2 00083 sib(i)%param%cc2 = fac1*sib(i)%param%rdc1 + fac2*sib(i)%param%rdc2 00084 sib(i)%param%gmudmu = fac1*sib(i)%param%gmudmu1 + fac2*sib(i)%param%gmudmu2 00085 sib(i)%param%d13cresp = fac1*sib(i)%param%d13cresp1 + fac2*sib(i)%param%d13cresp2 00086 00087 00088 do k=1,physmax 00089 sib(i)%param%physfrac(k) = fac1*sib(i)%param%physfrac1(k) + & 00090 fac2*sib(i)%param%physfrac2(k) 00091 enddo 00092 00093 !if(i==840) then 00094 ! print*, time1 , time%real_doy , time2 00095 ! print*, sib(i)%param%ndvi1 , sib(i)%param%ndvi , sib(i)%param%ndvi2 00096 ! print*, sib(i)%param%aparc1 , sib(i)%param%aparc , sib(i)%param%aparc2 00097 ! print*, sib(i)%param%zlt1 , sib(i)%param%zlt , sib(i)%param%zlt2 00098 ! print*, sib(i)%param%green1 , sib(i)%param%green , sib(i)%param%green2 00099 ! print*, sib(i)%param%z0d1 , sib(i)%param%z0d , sib(i)%param%z0d2 00100 ! print*, sib(i)%param%zp_disp1 , sib(i)%param%zp_disp , sib(i)%param%zp_disp2 00101 ! print*, sib(i)%param%rbc1 , sib(i)%param%cc1 , sib(i)%param%rbc2 00102 ! print*, sib(i)%param%rdc1 , sib(i)%param%cc2 , sib(i)%param%rdc2 00103 ! print*, sib(i)%param%gmudmu1 , sib(i)%param%gmudmu , sib(i)%param%gmudmu2 00104 ! print*, sib(i)%param%d13cresp1 , sib(i)%param%d13cresp , sib(i)%param%d13cresp2 00105 !endif 00106 00107 enddo 00108 ! 00109 end subroutine bc_interp
1.7.1