SIB: clm_combo.F90 Source File

Go to the documentation of this file.
00001 !----------------------------------------------------------------------
00002 subroutine CLM_COMBO(dz1,liq1,ice1,temp1,dz2,liq2,ice2,temp2)
00003 
00004     use kinds
00005     use eau_params, only: &
00006         lfus
00007     use physical_parameters, only: &
00008         tice
00009     use sib_const_module, only: &
00010         cpice, &
00011         cpliq 
00012 
00013     implicit none
00014     real(kind=dbl_kind),intent(inout) :: dz1
00015     real(kind=dbl_kind),intent(inout) :: liq1
00016     real(kind=dbl_kind),intent(inout) :: ice1
00017     real(kind=dbl_kind),intent(inout) :: temp1
00018 
00019     real(kind=dbl_kind),intent(in) :: dz2
00020     real(kind=dbl_kind),intent(in) :: liq2
00021     real(kind=dbl_kind),intent(in) :: ice2
00022     real(kind=dbl_kind),intent(in) :: temp2
00023 
00024 
00025     !...local variables...
00026     real(kind=dbl_kind) :: dzc
00027     real(kind=dbl_kind) :: wicec
00028     real(kind=dbl_kind) :: wliqc
00029     real(kind=dbl_kind) :: tc
00030     real(kind=dbl_kind) :: h1
00031     real(kind=dbl_kind) :: h2
00032     real(kind=dbl_kind) :: hc
00033 
00034     !
00035     !   Code based on CLM subroutine CLM_COMBO, modified for use
00036     !   with SiB
00037     !
00038     !   CLM Web Info:  http://clm.gsfc.nasa.gov
00039     !
00040     !   Description
00041     !   Combines two elements, and returns dz (thickness) temperature
00042     !   www_liq and www_ice.
00043     !
00044     !   Revision History:
00045     !   15 September 1999; Yongjiu Dai, original code
00046     !   15 December 1999;  Paul Houser and Jon Radakovich, F90 revision
00047     !   01 March 2002;     Ian Baker, SiB integration
00048 
00049     dzc   = dz1 + dz2
00050     wicec = ice1 + ice2
00051     wliqc = liq1 + liq2
00052 
00053     h1    = (cpice*ice1+cpliq*liq1) &
00054         *(temp1-tice)+lfus*liq1
00055     h2    = (cpice*ice2+cpliq*liq2) &
00056         *(temp2-tice)+lfus*liq2
00057     hc    = h1 + h2
00058 
00059     if(hc < 0.0) then
00060         tc = tice + hc/(cpice*wicec+cpliq*wliqc)
00061     elseif(hc <= lfus*wliqc) then
00062         tc = tice
00063     else
00064         tc = tice + (hc - lfus*wliqc)/(cpice*wicec &
00065             +cpliq*wliqc)
00066     endif
00067 
00068     dz1   = dzc
00069     ice1  = wicec
00070     liq1  = wliqc
00071     temp1 = tc
00072 
00073     return
00074 end subroutine clm_combo