unpack_ch_isba_patchn.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
SUBROUTINE unpack_ch_isba_patch_n (CHI, PKCI, &
                                   kmask,ksize,knpatch,kpatch)
!##############################################
!
!!****  *UNPACK_CH_ISBA_PATCH_n* - unpacks ISBA prognostic variables
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     A. Boone
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!------------------------------------------------------------------
!
!
!
USE modd_ch_isba_n, ONLY : ch_isba_t
USE modd_pack_ch_isba, ONLY : pack_ch_isba_t
!
USE modd_surf_par,       ONLY : xundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
TYPE(ch_isba_t), INTENT(INOUT) :: chi
TYPE(pack_ch_isba_t), INTENT(INOUT) :: pkci
!
INTEGER, INTENT(IN)               :: ksize, kpatch, knpatch
!
INTEGER, DIMENSION(:), INTENT(IN) :: kmask
!
INTEGER :: jj, ji, jsv
REAL(KIND=JPRB) :: zhook_handle
!
!
! Only save values for patches which are in use:
!
IF (lhook) CALL dr_hook('UNPACK_CH_ISBA_PATCH_N',0,zhook_handle)
 chi%XDEP(:,:,kpatch) = xundef
!
IF (knpatch==1) THEN
  DO jsv=1,SIZE(chi%XDEP,2)
    chi%XDEP(:,jsv,kpatch) = pkci%XP_DEP        (:,jsv) 
  END DO

ELSE
  DO jsv=1,SIZE(chi%XDEP,2)
    DO jj=1,ksize
      ji                  = kmask(jj)
      chi%XDEP(ji,jsv,kpatch) = pkci%XP_DEP        (jj,jsv) 
    END DO
  END DO
END IF
!
pkci%XP_SOILRC_SO2 => null()
pkci%XP_SOILRC_O3  => null()
!
DEALLOCATE(pkci%XBLOCK_SIMPLE)
DEALLOCATE(pkci%XP_DEP)
!
IF (lhook) CALL dr_hook('UNPACK_CH_ISBA_PATCH_N',1,zhook_handle)
!
END SUBROUTINE unpack_ch_isba_patch_n