print_update_clm.F90 Source File


Source Code

!-------------------------------------------------------------------------------------------
!Copyright (c) 2013-2016 by Wolfgang Kurtz and Guowei He (Forschungszentrum Juelich GmbH)
!
!This file is part of TSMP-PDAF
!
!TSMP-PDAF is free software: you can redistribute it and/or modify
!it under the terms of the GNU Lesser General Public License as published by
!the Free Software Foundation, either version 3 of the License, or
!(at your option) any later version.
!
!TSMP-PDAF is distributed in the hope that it will be useful,
!but WITHOUT ANY WARRANTY; without even the implied warranty of
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!GNU LesserGeneral Public License for more details.
!
!You should have received a copy of the GNU Lesser General Public License
!along with TSMP-PDAF.  If not, see <http://www.gnu.org/licenses/>.
!-------------------------------------------------------------------------------------------
!
!
!-------------------------------------------------------------------------------------------
!print_update_clm.F90: Module for printing updated CLM ensemble
!-------------------------------------------------------------------------------------------
#if defined CLMSA
subroutine print_update_clm(ts,ttot) bind(C,name="print_update_clm")

    use iso_c_binding

    use shr_kind_mod , only : r8 => shr_kind_r8
    use clm_atmlnd   , only : clm_l2a, atm_l2a, clm_mapl2a
    use clmtype      , only : clm3, nameg, namec
    use subgridavemod, only : p2g, c2g
    use domainmod    , only : latlon_type
    use clm_varpar   , only : nlevsoi
    use decompmod    , only : get_proc_global, get_proc_bounds, adecomp
    use spmdgathscatmod , only : gather_data_to_master
    use spmdmod      , only : masterproc
    use clm_time_manager        , only : get_nstep, dtime, nelapse
    use netcdf
    use enkf_clm_mod, only : clmupdate_swc,clmupdate_texture,clmprint_swc

    implicit none

    integer(c_int), intent(in) :: ts,ttot

    ! *** local variables ***
    integer :: numg           ! total number of gridcells across all processors
    integer :: numl           ! total number of landunits across all processors
    integer :: numc           ! total number of columns across all processors
    integer :: nump           ! total number of pfts across all processors
    integer :: begg,endg      ! local beg/end gridcells gdc
    integer :: begl,endl      ! local beg/end landunits
    integer :: begc,endc      ! local beg/end columns
    integer :: begp,endp      ! local beg/end pfts

    integer ::   isec, info, jn, jj, ji, g1, jx    ! temporary integer
    real(r8), pointer :: swc(:,:)
    real(r8), pointer :: psand(:,:)
    real(r8), pointer :: pclay(:,:)
    real(r8), pointer :: clmstate_tmp_local(:,:)
    real(r8), pointer :: clmstate_tmp_global(:,:)
    real(r8), allocatable :: clmstate_out(:,:,:)
    integer ,dimension(4) :: dimids
    integer ,dimension(1) :: il_var_id
    integer :: il_file_id, ncvarid(3), status
    character(len = 300) :: update_filename
    integer :: nerror
    integer :: ndlon,ndlat


    call get_proc_global(numg,numl,numc,nump)
    call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp)
    allocate(clmstate_tmp_local(nlevsoi,begc:endc), stat=nerror)

    ndlon = adecomp%gdc2i(numg)
    ndlat = adecomp%gdc2j(numg)

    if (masterproc) then
      allocate(clmstate_tmp_global(nlevsoi,numg), stat=nerror)
      allocate(clmstate_out(ndlon,ndlat,nlevsoi), stat=nerror)
    end if

    if(masterproc) then
      call get_update_filename(update_filename)
      if(ts.eq.1) then
        status =  nf90_create(update_filename, NF90_CLOBBER, il_file_id)
        status =  nf90_def_dim(il_file_id, "x", ndlon, dimids(1))
        status =  nf90_def_dim(il_file_id, "y", ndlat, dimids(2))
        status =  nf90_def_dim(il_file_id, "z", nlevsoi, dimids(3))
        status =  nf90_def_dim(il_file_id, "t", ttot, dimids(4))
        if(clmprint_swc.eq.1)     status =  nf90_def_var(il_file_id, "swc", NF90_DOUBLE, dimids, ncvarid(1))
        if(clmupdate_texture.eq.1) status =  nf90_def_var(il_file_id, "sand", NF90_DOUBLE, dimids, ncvarid(2))
        if(clmupdate_texture.eq.1) status =  nf90_def_var(il_file_id, "clay", NF90_DOUBLE, dimids, ncvarid(3))
        status =  nf90_enddef(il_file_id)
      else
        status = nf90_open(update_filename,NF90_WRITE,il_file_id)
      endif
    endif


    if(clmprint_swc.eq.1) then
      swc  => clm3%g%l%c%cws%h2osoi_vol
      ! swc
      clmstate_tmp_local = transpose(swc)
      call gather_data_to_master(clmstate_tmp_local,clmstate_tmp_global, clmlevel=nameg)

      if(masterproc) then
        ji = adecomp%gdc2i(numg)
        jj = adecomp%gdc2j(numg)
        do jn = 1, nlevsoi
          do g1 = 1, numg
             ji = adecomp%gdc2i(g1)
             jj = adecomp%gdc2j(g1)
             clmstate_out(ji,jj,jn) = clmstate_tmp_global(jn,g1)
          end do
        end do
        status = nf90_inq_varid(il_file_id, "swc" , ncvarid(1))
        status = nf90_put_var( il_file_id, ncvarid(1), clmstate_out(:,:,:), &
                 start = (/ 1, 1, 1, ts/), count = (/ ndlon, ndlat, nlevsoi, 1 /) )
        !status = nf90_close(il_file_id)
      end if
    end if

    if(clmupdate_texture.eq.1) then
      psand => clm3%g%l%c%cps%psand
      pclay => clm3%g%l%c%cps%pclay
      ! sand
      clmstate_tmp_local = transpose(psand)
      call gather_data_to_master(clmstate_tmp_local,clmstate_tmp_global, clmlevel=nameg)

      if(masterproc) then
        ji = adecomp%gdc2i(numg)
        jj = adecomp%gdc2j(numg)
        do jn = 1, nlevsoi
          do g1 = 1, numg
             ji = adecomp%gdc2i(g1)
             jj = adecomp%gdc2j(g1)
             clmstate_out(ji,jj,jn) = clmstate_tmp_global(jn,g1)
          end do
        end do
        status = nf90_inq_varid(il_file_id, "sand" , ncvarid(2))
        status = nf90_put_var( il_file_id, ncvarid(2), clmstate_out(:,:,:), &
                 start = (/ 1, 1, 1, ts/), count = (/ ndlon, ndlat, nlevsoi, 1 /) )
        !status = nf90_close(il_file_id)
      end if

      ! clay
      clmstate_tmp_local = transpose(pclay)
      call gather_data_to_master(clmstate_tmp_local,clmstate_tmp_global, clmlevel=nameg)

      if(masterproc) then
        ji = adecomp%gdc2i(numg)
        jj = adecomp%gdc2j(numg)
        do jn = 1, nlevsoi
          do g1 = 1, numg
             ji = adecomp%gdc2i(g1)
             jj = adecomp%gdc2j(g1)
             clmstate_out(ji,jj,jn) = clmstate_tmp_global(jn,g1)
          end do
        end do
        status = nf90_inq_varid(il_file_id, "clay" , ncvarid(3))
        status = nf90_put_var( il_file_id, ncvarid(3), clmstate_out(:,:,:), &
                 start = (/ 1, 1, 1, ts/), count = (/ ndlon, ndlat, nlevsoi, 1 /) )
        !status = nf90_close(il_file_id)
      end if
    end if

    if(masterproc) then
      status = nf90_close(il_file_id)
      deallocate(clmstate_out)
      deallocate(clmstate_tmp_global)
    end if

    deallocate(clmstate_tmp_local)

end subroutine print_update_clm
#endif

subroutine get_update_filename (iofile)
    ! !USES:
    use clm_varctl, only : caseid
    use clm_time_manager, only : get_curr_date, get_prev_date
    ! !ARGUMENTS:
    implicit none
    character(len=300),intent(inout) :: iofile
    ! LOCAL VARIABLES:
    character(len=256) :: cdate       !date char string
    integer :: day                    !day (1 -> 31)
    integer :: mon                    !month (1 -> 12)
    integer :: yr                     !year (0 -> ...)
    integer :: sec                    !seconds into current day
    !-----------------------------------------------------------------------

    call get_prev_date (yr, mon, day, sec)
    write(cdate,'(i4.4,"-",i2.2)') yr,mon                         !other
    call get_curr_date (yr, mon, day, sec)
    write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec
    !iofile = trim(caseid)//".update."//trim(cdate)//".nc"
    iofile = trim(caseid)//".update.nc"
end subroutine get_update_filename