pack_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 pack_ch_isba_patch_n (CHI, PKCI, &
                                 kmask,ksize,knpatch,kpatch)
!##############################################
!
!
!!****  *PACK_CH_ISBA_PATCH_n * - packs chemistry variables
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!------------------------------------------------------------------
!
!
!
USE modd_ch_isba_n, ONLY : ch_isba_t
USE modd_pack_ch_isba, ONLY : pack_ch_isba_t
!
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
REAL(KIND=JPRB) :: zhook_handle
!
!------------------------------------------------------------------------
!
! Packed surface module variables:
!
IF (lhook) CALL dr_hook('PACK_CH_ISBA_PATCH_N',0,zhook_handle)
!
ALLOCATE(pkci%XBLOCK_SIMPLE(ksize,2))
!
pkci%XP_SOILRC_SO2 => pkci%XBLOCK_SIMPLE(:,1)
pkci%XP_SOILRC_O3 => pkci%XBLOCK_SIMPLE(:,2)
!
ALLOCATE(pkci%XP_DEP(ksize,chi%SVI%NBEQ))
!
!------------------------------------------------------------------------
!
IF (knpatch==1) THEN
  pkci%XP_SOILRC_SO2   (:)    =    chi%XSOILRC_SO2   (:, 1)
  pkci%XP_SOILRC_O3    (:)    =    chi%XSOILRC_O3    (:, 1)
ELSE
  DO jj=1,ksize
    ji                      =    kmask(jj)
    pkci%XP_SOILRC_SO2   (jj)    =    chi%XSOILRC_SO2   (ji, kpatch)
    pkci%XP_SOILRC_O3    (jj)    =    chi%XSOILRC_O3    (ji, kpatch)
  ENDDO
END IF
IF (lhook) CALL dr_hook('PACK_CH_ISBA_PATCH_N',1,zhook_handle)
!
!------------------------------------------------------------------------
!
END SUBROUTINE pack_ch_isba_patch_n