SURFEX v7.3
General documentation of Surfex
|
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