SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/unpack_ch_isba_patchn.F90
Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE UNPACK_CH_ISBA_PATCH_n(KMASK,KSIZE,KNPATCH,KPATCH)
00003 !##############################################
00004 !
00005 !!****  *UNPACK_CH_ISBA_PATCH_n* - unpacks ISBA prognostic variables
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    REFERENCE
00014 !!    ---------
00015 !!      
00016 !!
00017 !!    AUTHOR
00018 !!    ------
00019 !!     A. Boone
00020 !!
00021 !!    MODIFICATIONS
00022 !!    -------------
00023 !!      Original    01/2004
00024 !!------------------------------------------------------------------
00025 !
00026 USE MODD_CH_ISBA_n,      ONLY : XDEP
00027 USE MODD_PACK_CH_ISBA,   ONLY : XP_DEP, XP_SOILRC_SO2, XP_SOILRC_O3, &
00028                                 XBLOCK_SIMPLE
00029 !
00030 USE MODD_SURF_PAR,       ONLY : XUNDEF
00031 !
00032 !
00033 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00034 USE PARKIND1  ,ONLY : JPRB
00035 !
00036 IMPLICIT NONE
00037 !
00038 INTEGER, INTENT(IN)               :: KSIZE, KPATCH, KNPATCH
00039 !
00040 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00041 !
00042 INTEGER :: JJ, JI, JSV
00043 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00044 !
00045 !
00046 ! Only save values for patches which are in use:
00047 !
00048 IF (LHOOK) CALL DR_HOOK('UNPACK_CH_ISBA_PATCH_N',0,ZHOOK_HANDLE)
00049 XDEP(:,:,KPATCH) = XUNDEF
00050 !
00051 IF (KNPATCH==1) THEN
00052   DO JSV=1,SIZE(XDEP,2)
00053     XDEP(:,JSV,KPATCH) = XP_DEP        (:,JSV) 
00054   END DO
00055 
00056 ELSE
00057   DO JSV=1,SIZE(XDEP,2)
00058     DO JJ=1,KSIZE
00059       JI                  = KMASK         (JJ)
00060       XDEP(JI,JSV,KPATCH) = XP_DEP        (JJ,JSV) 
00061     END DO
00062   END DO
00063 END IF
00064 !
00065 XP_SOILRC_SO2 => NULL()
00066 XP_SOILRC_O3  => NULL()
00067 !
00068 DEALLOCATE(XBLOCK_SIMPLE)
00069 DEALLOCATE(XP_DEP)
00070 !
00071 IF (LHOOK) CALL DR_HOOK('UNPACK_CH_ISBA_PATCH_N',1,ZHOOK_HANDLE)
00072 !
00073 END SUBROUTINE UNPACK_CH_ISBA_PATCH_n