SIB: bc_interp_old.F90 Source File

Go to the documentation of this file.
00001 !-------------------------------------------------------------------------------
00002 subroutine bc_interp_old( 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 !-----------------------------------------------------------------------
00015 
00016 use sibtype
00017 use timetype
00018 use sib_const_module
00019 use sib_bc_module
00020 implicit none
00021 
00022 ! parameters
00023 type(sib_t), dimension(subcount), intent(inout) :: sib
00024 type(time_struct), intent(in) :: time
00025 
00026 ! local variables
00027 integer i, k  ! indices
00028 real tpgf1    ! scaling factor between 1st bc value and current time
00029 real tpgf2    ! scaling factor between 2nd bc value and current time
00030 integer k1    ! 1st month index for interpolation scaling factors
00031 integer k2    ! 2nd month index for interpolation scaling factors
00032 
00033     ! Calculate scaling factors for interpolation of boundary conditions
00034     if ( time%doy < time%mid_month(time%month) ) then
00035         k1 = time%month - 1
00036         k2 = time%month 
00037         if ( k1 < 1 ) k1 = 12
00038         tpgf1 = (time%mid_month(k2) - time%doy) * 2.0 /  &
00039             real(time%days_per_month(k1) + time%days_per_month(k2))
00040         tpgf2 = 1.0 - tpgf1
00041     else
00042         k1 = time%month
00043         k2 = time%month + 1
00044         if ( k2 > 12 ) k2 = 1
00045         tpgf2 = (time%doy - time%mid_month(k1)) * 2.0 /  &
00046             real(time%days_per_month(k1) + time%days_per_month(k2))
00047         tpgf1 = 1.0 - tpgf2
00048     endif
00049 
00050     ! update boundary conditions
00051 
00052     do i = 1, subcount
00053         sib(i)%param%aparc    = tpgf1*sib(i)%param%aparc1    + tpgf2*sib(i)%param%aparc2
00054         sib(i)%param%zlt      = tpgf1*sib(i)%param%zlt1      + tpgf2*sib(i)%param%zlt2
00055         sib(i)%param%green    = tpgf1*sib(i)%param%green1    + tpgf2*sib(i)%param%green2
00056         sib(i)%param%z0d      = tpgf1*sib(i)%param%z0d1      + tpgf2*sib(i)%param%z0d2
00057         sib(i)%param%zp_disp  = tpgf1*sib(i)%param%zp_disp1  + tpgf2*sib(i)%param%zp_disp2
00058 
00059 
00060 
00061         sib(i)%param%cc1      = tpgf1*sib(i)%param%rbc1      + tpgf2*sib(i)%param%rbc2
00062         sib(i)%param%cc2      = tpgf1*sib(i)%param%rdc1      + tpgf2*sib(i)%param%rdc2
00063         sib(i)%param%gmudmu   = tpgf1*sib(i)%param%gmudmu1   + tpgf2*sib(i)%param%gmudmu2
00064         sib(i)%param%d13cresp = tpgf1*sib(i)%param%d13cresp1 + tpgf2*sib(i)%param%d13cresp2
00065 
00066         do k=1,physmax
00067            sib(i)%param%physfrac(k) = tpgf1*sib(i)%param%physfrac1(k) +    &
00068                                    tpgf2*sib(i)%param%physfrac2(k)
00069         enddo
00070 
00071 
00072 
00073     enddo
00074 
00075 end subroutine bc_interp_old