SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/pack_ch_isba

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE PACK_CH_ISBA_PATCH_n(KMASK,KSIZE,KNPATCH,KPATCH)
00003 !##############################################
00004 !
00005 !
00006 !!****  *PACK_CH_ISBA_PATCH_n * - packs chemistry variables
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    REFERENCE
00015 !!    ---------
00016 !!      
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!     V. Masson
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    01/2004
00025 !!------------------------------------------------------------------
00026 !
00027 USE MODD_CH_ISBA_n,      ONLY : XSOILRC_SO2, XSOILRC_O3, NBEQ
00028 USE MODD_PACK_CH_ISBA,   ONLY : XP_DEP, XP_SOILRC_SO2, XP_SOILRC_O3, &
00029                                 XBLOCK_SIMPLE
00030 !
00031 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00032 USE PARKIND1  ,ONLY : JPRB
00033 !
00034 IMPLICIT NONE
00035 !
00036 INTEGER, INTENT(IN)               :: KSIZE, KPATCH, KNPATCH
00037 !
00038 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00039 !
00040 INTEGER JJ, JI
00041 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00042 !
00043 !------------------------------------------------------------------------
00044 !
00045 ! Packed surface module variables:
00046 !
00047 IF (LHOOK) CALL DR_HOOK('PACK_CH_ISBA_PATCH_N',0,ZHOOK_HANDLE)
00048 !
00049 ALLOCATE(XBLOCK_SIMPLE(KSIZE,2))
00050 !
00051 XP_SOILRC_SO2 => XBLOCK_SIMPLE(:,1)
00052 XP_SOILRC_O3 => XBLOCK_SIMPLE(:,2)
00053 !
00054 ALLOCATE(XP_DEP(KSIZE,NBEQ))
00055 !
00056 !------------------------------------------------------------------------
00057 !
00058 IF (KNPATCH==1) THEN
00059   XP_SOILRC_SO2   (:)    =    XSOILRC_SO2   (:, 1)
00060   XP_SOILRC_O3    (:)    =    XSOILRC_O3    (:, 1)
00061 ELSE
00062   DO JJ=1,KSIZE
00063     JI                      =    KMASK(JJ)
00064     XP_SOILRC_SO2   (JJ)    =    XSOILRC_SO2   (JI, KPATCH)
00065     XP_SOILRC_O3    (JJ)    =    XSOILRC_O3    (JI, KPATCH)
00066   ENDDO
00067 END IF
00068 IF (LHOOK) CALL DR_HOOK('PACK_CH_ISBA_PATCH_N',1,ZHOOK_HANDLE)
00069 !
00070 !------------------------------------------------------------------------
00071 !
00072 END SUBROUTINE PACK_CH_ISBA_PATCH_n