endif! time comment for history interval    if (masterproc) then       beg2d(1) = 1        ; len2d(1) = len_trim(timcom(nf))       beg2d(2) = ntim(nf) ; len2d(2) = 1       call wrap_put_vara_text (ncid(nf), timcom_id(nf), beg2d, len2d, timcom(nf))    endif! active single-level fields (either grid averages or 1-d vectors)#if (defined SPMD)    if (slfld%num(nf) > 0) then       allocate (buf1d(begpatch:endpatch))       allocate (gather1d(numpatch))       call compute_mpigs_patch(1, numsend, numrecvv, displsv)       do n = 1, slfld%num(nf)          do k = begpatch, endpatch             buf1d(k) = slfld%value(k,n,nf)          end do          call mpi_gatherv (buf1d(begpatch), numsend , mpir8, &               gather1d, numrecvv, displsv, mpir8, 0, mpicom, ier)          if (masterproc) then             do k = 1, numpatch                slfld%value(k,n,nf) = gather1d(k)              end do          endif       end do       deallocate (buf1d)       deallocate (gather1d)    endif#endif    if (masterproc) then       if (hist_dov2xy(nf)) then          beg3d(1) = 1        ; len3d(1) = lsmlon          beg3d(2) = 1        ; len3d(2) = lsmlat          beg3d(3) = ntim(nf) ; len3d(3) = 1          do i = 1, slfld%num(nf)             call v2xy (slfld%value(1,i,nf), spval, slfxy)             call wrap_put_vara_realx (ncid(nf), slfld_id(i,nf), beg3d, len3d, slfxy)          end do       else          beg2d(1) = 1        ; len2d(1) = numpatch          beg2d(2) = ntim(nf) ; len2d(2) = 1          do i = 1, slfld%num(nf)             call wrap_put_vara_realx (ncid(nf), slfld_id(i,nf), beg2d, len2d, slfld%value(1,i,nf))          end do       endif    endif! active multi-level soil fields (either grid averages or 1-d vectors)#if (defined SPMD)    if (mlsoifld%num(nf) > 0) then       allocate (buf2d(nlevsoi,begpatch:endpatch))       allocate (gather2d(nlevsoi,numpatch))       call compute_mpigs_patch(nlevsoi, numsend, numrecvv, displsv)       do n = 1, mlsoifld%num(nf)          do l = 1, nlevsoi             do k = begpatch, endpatch                buf2d(l,k) = mlsoifld%value(k,l,n,nf)             end do          end do          call mpi_gatherv (buf2d(1,begpatch), numsend , mpir8, &               gather2d, numrecvv, displsv, mpir8, 0, mpicom, ier)          if (masterproc) then             do l = 1, nlevsoi                do k = 1, numpatch                   mlsoifld%value(k,l,n,nf) = gather2d(l,k)                  end do             end do          endif       end do       deallocate (buf2d)       deallocate (gather2d)    endif#endif    if (masterproc) then       if (hist_dov2xy(nf)) then          beg4d(1) = 1       ; len4d(1) = lsmlon          beg4d(2) = 1       ; len4d(2) = lsmlat          beg4d(3) = 1       ; len4d(3) = nlevsoi          beg4d(4) = ntim(nf); len4d(4) = 1          do i = 1, mlsoifld%num(nf)             do l = 1, nlevsoi                call v2xy (mlsoifld%value(1,l,i,nf), spval, mlsoifxy(1,1,l))             end do             call wrap_put_vara_realx (ncid(nf), mlsoifld_id(i,nf), &                  beg4d, len4d, mlsoifxy)          end do       else          beg3d(1) = 1        ; len3d(1) = numpatch          beg3d(2) = 1        ; len3d(2) = nlevsoi          beg3d(3) = ntim(nf) ; len3d(3) = 1          do i = 1, mlsoifld%num(nf)             call wrap_put_vara_realx (ncid(nf), mlsoifld_id(i,nf), &                  beg3d, len3d, mlsoifld%value(1,1,i,nf))          end do       endif    endif    return   end subroutine histwrt!=======================================================================  subroutine histcls (nf)!----------------------------------------------------------------------- ! ! Purpose: ! close netCDF file !! Method: ! ! Author: Gordon Bonan! !-----------------------------------------------------------------------    include 'netcdf.inc'! ------------------------ arguments ---------------------------------    integer, intent(in) :: nf           !history file number! --------------------------------------------------------------------    call wrap_close(ncid(nf))    return  end subroutine histcls!=======================================================================  subroutine histslf (name, fld)!----------------------------------------------------------------------- ! ! Purpose: ! accumulate single-level field over history time interval!! Method: ! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------    use precision    use clm_varmap, only : begpatch, endpatch! ------------------------ arguments ------------------------------    character(len=*), intent(in) :: name            !field name    real(r8), intent(in) :: fld(begpatch:endpatch)  !field values for current time step! -----------------------------------------------------------------! ------------------------ local variables ------------------------    integer i,n,m,k     !loop indices    real(r8), pointer :: value(:)    integer , pointer :: count(:)    character(len= 8) :: type! -----------------------------------------------------------------    do m = 1, nhist       ! find field index. return if "name" is not on active list       n = 0       do i = 1, slfld%num(m)          if (name == slfld%nam(i,m)) n = i       end do       if (n == 0) go to 1000            ! determine field attributes       type  =  slfld%typ(n,m)       value => slfld%value(:,n,m)       count => slfld%count(:,n,m)       !$OMP PARALLEL DO PRIVATE (K)       do k = begpatch,endpatch                  ! accumulate field           if (fld(k) /= spval) then             if (type == naver) then           !time average field                if (count(k) == 0) value(k) = 0.                  value(k) = value(k) + fld(k)                count(k) = count(k) + 1             else if (type == ncnst) then      !constant field value                if (count(k) == 0) then                   value(k) = fld(k)                   count(k) = 1                endif             else if (type == ninst) then      !instantaneous field value                value(k) = fld(k)                count(k) = 1             else if (type == nmaxi) then      !maximum field value                if (count(k) == 0) value(k) = -1.e50                value(k) = max( value(k), fld(k) )                count(k) = 1             else if (type == nmini) then      !minimum field value                if (count(k) == 0) value(k) = +1.e50                value(k) = min( value(k), fld(k) )                count(k) = 1             end if          else             if (count(k)== 0) value(k) = fld(k)          endif                    ! end of history interval: normalize accumulated values           if (ehi(m)) then             if (type == naver .and. count(k)/=0) then                  value(k) = value(k) / float(count(k))             end if          endif                 end do!$OMP END PARALLEL DO     1000   continue    end do    return  end subroutine histslf!=======================================================================  subroutine histmlf (name, fld, nlev)!----------------------------------------------------------------------- ! ! Purpose: ! accumulate multi-level field over history time interval!! Method: ! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------    use precision    use clm_varmap , only : begpatch, endpatch    use clm_varpar , only : nlevsoi  ! ------------------------ arguments ------------------------------    character(len=*), intent(in) :: name                !field name    integer , intent(in) :: nlev                        !number of levels    real(r8), intent(in) :: fld(begpatch:endpatch,nlev) !field values for current time step! -----------------------------------------------------------------! ------------------------ local variables ------------------------    integer i,j,n,m,k         !do loop indices    real(r8), pointer :: value(:,:)    integer , pointer :: count(:,:)    character(len= 8) :: type! -----------------------------------------------------------------! loop over history tapes        do m = 1, nhist              ! find field index. return if "name" is not on active list       n = 0       do i = 1, mlsoifld%num(m)          if (name == mlsoifld%nam(i,m)) n = i       end do       if (n == 0) go to 1000              ! initialize field attributes       type  =  mlsoifld%typ(n,m)       value => mlsoifld%value(:,:,n,m)       count => mlsoifld%count(:,:,n,m)       !$OMP PARALLEL DO PRIVATE (J,K)       do k = begpatch,endpatch          do j = 1, nlev                        ! accumulate field              if (fld(k,j) /= spval) then                if (type == naver) then           !time average field                   if (count(k,j) == 0) value(k,j) = 0.                     value(k,j) = value(k,j) + fld(k,j)                   count(k,j) = count(k,j) + 1                else if (type == ncnst) then      !constant field value                   if (count(k,j) == 0) then                      value(k,j) = fld(k,j)                      count(k,j) = 1                   endif                else if (type == ninst) then      !instantaneous field value                   value(k,j) = fld(k,j)                   count(k,j) = 1                else if (type == nmaxi) then      !maximum field value                   if (count(k,j) == 0) value(k,j) = -spval                   value(k,j) = max(value(k,j),fld(k,j))                   count(k,j) = 1                else if (type == nmini) then      !minimum field value                   if (count(k,j) == 0) value(k,j) = +spval                   value(k,j) = min(value(k,j),fld(k,j))                   count(k,j) = 1                end if             else                if (count(k,j)== 0) value(k,j) = fld(k,j)             endif                          ! end of history interval, normalize accumulated values              if (ehi(m)) then                if (type==naver .and. count(k,j)/=0) then                   value(k,j) = value(k,j) / float(count(k,j))                endif             endif                       end do       end do!$OMP END PARALLEL DO     1000   continue    end do      return  end subroutine histmlf!=======================================================================  subroutine histzero(nfile)!----------------------------------------------------------------------- ! ! Purpose: ! zero out history counters!!