|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE FLAG_TEB_GARDEN_n(KFLAG) 00003 ! ################################## 00004 ! 00005 !!**** *FLAG_TEB_GARDEN_n* - routine to flag ISBA variables where gardens are 00006 !! not present 00007 !! 00008 !! 00009 !! PURPOSE 00010 !! ------- 00011 !! 00012 !!** METHOD 00013 !! ------ 00014 !! 00015 !! EXTERNAL 00016 !! -------- 00017 !! 00018 !! 00019 !! IMPLICIT ARGUMENTS 00020 !! ------------------ 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! 00025 !! 00026 !! AUTHOR 00027 !! ------ 00028 !! V. Masson *Meteo France* 00029 !! 00030 !! MODIFICATIONS 00031 !! ------------- 00032 !! Original 10/2011 00033 !! 00034 !------------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATIONS 00037 ! ------------ 00038 ! 00039 ! 00040 USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN 00041 USE MODD_TEB_n, ONLY : XGARDEN 00042 USE MODD_TEB_VEG_n, ONLY : CPHOTO, CISBA, CRESPSL 00043 USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, & 00044 XTG, XWG, XWGI, XWR, XLAI, TSNOW, & 00045 XRESA, XANFM, XAN, XLE, XANDAY, & 00046 XBSLAI, XBIOMASS, XRESP_BIOMASS, & 00047 XSNOWFREE_ALB, XSNOWFREE_ALB_VEG, & 00048 XSNOWFREE_ALB_SOIL 00049 ! 00050 USE MODD_SURF_PAR, ONLY : XUNDEF 00051 ! 00052 USE MODI_FLAG_GR_SNOW 00053 ! 00054 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00055 USE PARKIND1 ,ONLY : JPRB 00056 ! 00057 IMPLICIT NONE 00058 ! 00059 !* 0.1 Declarations of arguments 00060 ! ------------------------- 00061 ! 00062 INTEGER, INTENT(IN) :: KFLAG ! 1 : to put physical values to run ISBA afterwards 00063 ! ! 2 : to flag with XUNDEF value for points wihtout garden 00064 ! 00065 !* 0.2 Declarations of local variables 00066 ! ------------------------------- 00067 ! 00068 REAL :: ZWR, ZTG, ZWG, ZRESA, ZANFM, ZDEF 00069 INTEGER :: JL1, JL2 ! loop counter on layers 00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00071 ! 00072 !------------------------------------------------------------------------------- 00073 ! 00074 ! 00075 !* 1D physical dimension 00076 ! 00077 IF (LHOOK) CALL DR_HOOK('FLAG_TEB_GARDEN_N',0,ZHOOK_HANDLE) 00078 ! 00079 ZWR = XUNDEF 00080 ! 00081 IF (KFLAG==1) THEN 00082 ZTG = 300. 00083 ZWG = 0.5 00084 ZRESA = 100. 00085 ZANFM = XANFMINIT 00086 ZDEF = 0. 00087 ELSEIF (KFLAG==2) THEN 00088 ZTG = XUNDEF 00089 ZWG = XUNDEF 00090 ZRESA = XUNDEF 00091 ZANFM = XUNDEF 00092 ZDEF = XUNDEF 00093 ENDIF 00094 ! 00095 !------------------------------------------------------------------------------- 00096 ! 00097 ! 00098 DO JL1=1,NGROUND_LAYER 00099 WHERE (XGARDEN(:)==0.) 00100 XTG (:,JL1) = ZTG 00101 XWG (:,JL1) = ZWG 00102 XWGI(:,JL1) = ZDEF 00103 END WHERE 00104 END DO 00105 ! 00106 WHERE (XGARDEN(:)==0.) 00107 XWR (:) = ZWR 00108 XRESA(:) = ZRESA 00109 END WHERE 00110 ! 00111 IF (CPHOTO/='NON') THEN 00112 ! 00113 WHERE (XGARDEN(:)==0.) 00114 XANFM (:) = ZANFM 00115 XAN (:) = ZDEF 00116 XANDAY(:) = ZDEF 00117 XLE (:) = ZDEF 00118 END WHERE 00119 ! 00120 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN 00121 ! 00122 WHERE (XGARDEN(:)==0.) XLAI(:) = ZDEF 00123 ! 00124 ELSE IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN 00125 ! 00126 DO JL1=1,SIZE(XBIOMASS,2) 00127 WHERE (XGARDEN(:)==0.) 00128 XBIOMASS (:,JL1) = ZDEF 00129 XRESP_BIOMASS(:,JL1) = ZDEF 00130 END WHERE 00131 END DO 00132 ! 00133 END IF 00134 ! 00135 ENDIF 00136 ! 00137 ! 00138 !------------------------------------------------------------------------------- 00139 ! 00140 !* Flag snow characteristics 00141 ! 00142 CALL FLAG_GR_SNOW(KFLAG,XGARDEN(:)==0.,TSNOW) 00143 ! 00144 ! 00145 !* snow-free characteristics 00146 ! 00147 IF (KFLAG==1) THEN 00148 WHERE (XGARDEN==0.) XSNOWFREE_ALB = 0.2 00149 WHERE (XGARDEN==0.) XSNOWFREE_ALB_VEG = 0.2 00150 WHERE (XGARDEN==0.) XSNOWFREE_ALB_SOIL = 0.2 00151 ELSEIF (KFLAG==2) THEN 00152 WHERE (XGARDEN==0.) XSNOWFREE_ALB = XUNDEF 00153 WHERE (XGARDEN==0.) XSNOWFREE_ALB_VEG = XUNDEF 00154 WHERE (XGARDEN==0.) XSNOWFREE_ALB_SOIL = XUNDEF 00155 END IF 00156 ! 00157 !------------------------------------------------------------------------------- 00158 ! 00159 IF (LHOOK) CALL DR_HOOK('FLAG_TEB_GARDEN_N',1,ZHOOK_HANDLE) 00160 ! 00161 !------------------------------------------------------------------------------- 00162 ! 00163 END SUBROUTINE FLAG_TEB_GARDEN_n
1.8.0
