cbl_trimb.F90 Source File


This file depends on

sourcefile~~cbl_trimb.f90~~EfferentGraph sourcefile~cbl_trimb.f90 cbl_trimb.F90 sourcefile~cbl_soilsnow_data.f90 cbl_soilsnow_data.F90 sourcefile~cbl_trimb.f90->sourcefile~cbl_soilsnow_data.f90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cbl_soilsnow_data.f90->sourcefile~cable_common.f90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~cbl_soilsnow_data.f90->sourcefile~cable_define_types.f90 sourcefile~cable_phys_constants_mod.f90 cable_phys_constants_mod.F90 sourcefile~cbl_soilsnow_data.f90->sourcefile~cable_phys_constants_mod.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90

Files dependent on this one

sourcefile~~cbl_trimb.f90~~AfferentGraph sourcefile~cbl_trimb.f90 cbl_trimb.F90 sourcefile~cbl_gw.f90 cbl_GW.F90 sourcefile~cbl_gw.f90->sourcefile~cbl_trimb.f90 sourcefile~cbl_smoisturev.f90 cbl_smoisturev.F90 sourcefile~cbl_smoisturev.f90->sourcefile~cbl_trimb.f90 sourcefile~cbl_stempv.f90 cbl_stempv.F90 sourcefile~cbl_stempv.f90->sourcefile~cbl_trimb.f90 sourcefile~cbl_soilsnow_main.f90 cbl_soilsnow_main.F90 sourcefile~cbl_soilsnow_main.f90->sourcefile~cbl_stempv.f90 sourcefile~cbl_surfbv.f90 cbl_surfbv.F90 sourcefile~cbl_soilsnow_main.f90->sourcefile~cbl_surfbv.f90 sourcefile~cbl_surfbv.f90->sourcefile~cbl_smoisturev.f90 sourcefile~cbl_thermal.f90 cbl_thermal.F90 sourcefile~cbl_thermal.f90->sourcefile~cbl_gw.f90 sourcefile~cbl_model_driver_offline.f90 cbl_model_driver_offline.F90 sourcefile~cbl_model_driver_offline.f90->sourcefile~cbl_soilsnow_main.f90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_mpiworker.f90 cable_mpiworker.F90 sourcefile~cable_mpiworker.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90

Source Code

MODULE trimb_mod

USE cbl_ssnow_data_mod, ONLY : r_2

PUBLIC  trimb

CONTAINS
! this routine solves the system:
!	   a(k)*u(k-1)+b(k)*u(k)+c(k)*u(k+1)=rhs(k)    for k=2,kmax-1
!	   with  b(k)*u(k)+c(k)*u(k+1)=rhs(k)	       for k=1
!	   and	 a(k)*u(k-1)+b(k)*u(k)=rhs(k)	       for k=kmax
!
!	 the Thomas algorithm is used for solving sets of linear equation
!	 rhs initially contains rhs; leaves with answer (jlm)
!	 n.b. this one does not assume b = 1-a-c

SUBROUTINE trimb (a, b, c, rhs, kmax)

IMPLICIT NONE
  INTEGER, INTENT(IN)                  :: kmax ! no. of discrete layers

  REAL(r_2), DIMENSION(:,:), INTENT(IN) ::                                    &
       a,    & ! coef "A" in finite diff eq
       b,    & ! coef "B" in finite diff eq
       c       ! coef "C" in finite diff eq

  REAL(r_2), DIMENSION(:,:), INTENT(INOUT)  :: rhs ! right hand side of eq

  REAL(r_2), DIMENSION(SIZE(a,1),SIZE(a,2)) ::                                &
       e, temp, g

  INTEGER :: k   ! do lloop counter

  e(:,1) = c(:,1) / b(:,1)
  DO k = 2, kmax - 1
     temp(:,k) = 1. / ( b(:,k) - a(:,k) * e(:,k-1) )
     e(:,k) = c(:,k) * temp(:,k)
  END DO

  g(:,1) = rhs(:,1) / b(:,1)
  DO k = 2, kmax - 1
     g(:,k) = ( rhs(:,k) - a(:,k) * g(:,k-1) ) * temp(:,k)
  END DO

  ! do back substitution to give answer now
  rhs(:,kmax) = ( rhs(:,kmax) - a(:,kmax) * g(:,kmax-1) )                     &
       / ( b(:,kmax) - a(:,kmax) * e(:,kmax-1) )

  DO k = kmax - 1, 1, - 1
     rhs(:,k) = g(:,k) - e(:,k) * rhs(:,k + 1)
  END DO

END SUBROUTINE trimb

END MODULE trimb_mod