|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !##################### 00002 MODULE MODI_SURF_PATCH 00003 !##################### 00004 ! 00005 INTERFACE SURF_PATCH 00006 SUBROUTINE SURF_PATCH_2D(KPATCH,PVEGTYPE,PPATCH) 00007 00008 INTEGER , INTENT(IN) :: KPATCH ! number of patches 00009 REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions 00010 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction 00011 00012 END SUBROUTINE SURF_PATCH_2D 00013 SUBROUTINE SURF_PATCH_1D(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH) 00014 00015 INTEGER , INTENT(IN) :: KPATCH ! number of patches 00016 REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions 00017 REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction 00018 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions 00019 ! ! for each patch 00020 00021 END SUBROUTINE SURF_PATCH_1D 00022 ! 00023 END INTERFACE SURF_PATCH 00024 ! 00025 END MODULE MODI_SURF_PATCH 00026 ! 00027 ! ############################################# 00028 SUBROUTINE SURF_PATCH_2D(KPATCH,PVEGTYPE,PPATCH) 00029 ! ############################################# 00030 ! 00031 !!**** *SURF_PATCH * - subroutine to compute the patch fractions in each grid 00032 !! mesh with nature in it. 00033 !! 00034 !! PURPOSE 00035 !! ------- 00036 !! 00037 !! 00038 !!** METHOD 00039 !! ------ 00040 !! 00041 !! 00042 !! 00043 !! EXTERNAL 00044 !! -------- 00045 !! 00046 !! 00047 !! 00048 !! IMPLICIT ARGUMENTS 00049 !! ------------------ 00050 !! 00051 !! 00052 !! REFERENCE 00053 !! --------- 00054 !! 00055 !! 00056 !! 00057 !! AUTHOR 00058 !! ------ 00059 !! 00060 !! V. Masson * METEO-FRANCE * 00061 !! 00062 !! MODIFICATIONS 00063 !! ------------- 00064 !! 00065 !! Original 15/03/99 00066 ! F.solmon 06/00 adaptation for patch approach 00067 !------------------------------------------------------------------------------- 00068 ! 00069 !* 0. DECLARATIONS 00070 ! ------------ 00071 ! 00072 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00073 USE MODD_SURF_PAR, ONLY : XUNDEF 00074 ! 00075 USE MODI_VEGTYPE_TO_PATCH 00076 ! 00077 ! 00078 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00079 USE PARKIND1 ,ONLY : JPRB 00080 ! 00081 IMPLICIT NONE 00082 ! 00083 !* 0.1 Declarations of dummy arguments : 00084 ! 00085 INTEGER, INTENT(IN) :: KPATCH ! number of patches 00086 REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions 00087 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction 00088 ! 00089 ! 00090 !* 0.2 Declarations of local variables for print on FM file 00091 ! 00092 ! 00093 INTEGER ::JVEG, JPATCH ! loop on patches 00094 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00095 !------------------------------------------------------------------------------- 00096 ! 00097 IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_2D',0,ZHOOK_HANDLE) 00098 PPATCH (:,:,:)=0. 00099 DO JVEG=1,NVEGTYPE 00100 JPATCH=VEGTYPE_TO_PATCH (JVEG, KPATCH) 00101 WHERE (PVEGTYPE (:,:,JVEG) /= XUNDEF) 00102 PPATCH (:,:,JPATCH)= PPATCH (:,:,JPATCH) + PVEGTYPE (:,:,JVEG) 00103 END WHERE 00104 END DO 00105 IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_2D',1,ZHOOK_HANDLE) 00106 ! 00107 ! 00108 !------------------------------------------------------------------------------- 00109 ! 00110 END SUBROUTINE SURF_PATCH_2D 00111 !------------------------------------------------------------------------------- 00112 ! 00113 ! ############################################# 00114 SUBROUTINE SURF_PATCH_1D(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH) 00115 ! ############################################# 00116 ! 00117 !!**** *SURF_PATCH * - subroutine to compute the patch fractions in each grid 00118 !! mesh with nature in it. 00119 !! 00120 !! PURPOSE 00121 !! ------- 00122 !! 00123 !! 00124 !!** METHOD 00125 !! ------ 00126 !! 00127 !! 00128 !! 00129 !! EXTERNAL 00130 !! -------- 00131 !! 00132 !! 00133 !! 00134 !! IMPLICIT ARGUMENTS 00135 !! ------------------ 00136 !! 00137 !! 00138 !! REFERENCE 00139 !! --------- 00140 !! 00141 !! 00142 !! 00143 !! AUTHOR 00144 !! ------ 00145 !! 00146 !! V. Masson * METEO-FRANCE * 00147 !! 00148 !! MODIFICATIONS 00149 !! ------------- 00150 !! 00151 !! Original 15/03/99 00152 ! F.solmon 06/00 adaptation for patch approach 00153 !------------------------------------------------------------------------------- 00154 ! 00155 !* 0. DECLARATIONS 00156 ! ------------ 00157 ! 00158 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00159 USE MODD_SURF_PAR, ONLY : XUNDEF 00160 ! 00161 USE MODI_VEGTYPE_TO_PATCH 00162 ! 00163 ! 00164 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00165 USE PARKIND1 ,ONLY : JPRB 00166 ! 00167 IMPLICIT NONE 00168 ! 00169 !* 0.1 Declarations of dummy arguments : 00170 ! 00171 INTEGER , INTENT(IN) :: KPATCH ! number of patches 00172 REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions 00173 REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction 00174 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions 00175 ! ! for each patch 00176 ! 00177 ! 00178 !* 0.2 Declarations of local variables for print on FM file 00179 ! 00180 ! 00181 INTEGER ::JVEG, JPATCH ! loop on patches 00182 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00183 !------------------------------------------------------------------------------- 00184 ! 00185 IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_1D',0,ZHOOK_HANDLE) 00186 PPATCH (:,:) =0. 00187 IF (PRESENT(PVEGTYPE_PATCH)) PVEGTYPE_PATCH (:,:,:)=0. 00188 DO JVEG=1,NVEGTYPE 00189 JPATCH=VEGTYPE_TO_PATCH (JVEG, KPATCH) 00190 WHERE (PVEGTYPE (:,JVEG) /= XUNDEF) 00191 PPATCH (:,JPATCH) = PPATCH (:,JPATCH) + PVEGTYPE (:,JVEG) 00192 END WHERE 00193 IF (PRESENT(PVEGTYPE_PATCH)) THEN 00194 WHERE (PVEGTYPE (:,JVEG) /= XUNDEF) 00195 PVEGTYPE_PATCH (:,JVEG,JPATCH)= PVEGTYPE (:,JVEG) 00196 END WHERE 00197 END IF 00198 END DO 00199 IF (PRESENT(PVEGTYPE_PATCH)) THEN 00200 DO JPATCH=1,KPATCH 00201 DO JVEG=1,NVEGTYPE 00202 WHERE (PVEGTYPE (:,JVEG) /= XUNDEF .AND. PPATCH(:,JPATCH)/= 0.) 00203 PVEGTYPE_PATCH(:,JVEG,JPATCH) = PVEGTYPE_PATCH(:,JVEG,JPATCH) / PPATCH(:,JPATCH) 00204 END WHERE 00205 END DO 00206 END DO 00207 END IF 00208 IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_1D',1,ZHOOK_HANDLE) 00209 ! 00210 ! 00211 !------------------------------------------------------------------------------- 00212 ! 00213 END SUBROUTINE SURF_PATCH_1D
1.8.0
