|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 SUBROUTINE INI_VAR_FROM_PATCH(HPROGRAM,KLUOUT,HNAME,PFIELD,KPTS,PDEF) 00002 !! 00003 !! PURPOSE 00004 !! ------- 00005 !! 00006 !! (1) KPTS=n interpol field with n pts 00007 !! (2) KPTS=0 conserve cells mass 00008 !! Case 2 : simple extrapolation based on the inside cell informations. 00009 !! this is donne before conserving cell or global mass 00010 !! 00011 !! METHOD 00012 !! ------ 00013 !! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! AUTHOR 00024 !! ------ 00025 !! 00026 !! R. Alkama Meteo-France 00027 !! 00028 !! MODIFICATION 00029 !! ------------ 00030 !! Original 12/2010 00031 !! 00032 !---------------------------------------------------------------------------- 00033 !!* 0. DECLARATION 00034 ! ----------- 00035 ! 00036 USE MODD_SURF_PAR, ONLY : XUNDEF 00037 USE MODD_SURF_ATM_n, ONLY : NSIZE_FULL 00038 USE MODD_ISBA_n, ONLY : XPATCH_OLD, XPATCH, XLAI 00039 ! 00040 USE MODI_GET_SURF_MASK_n 00041 USE MODI_INTERPOL_FIELD 00042 USE MODI_UNPACK_SAME_RANK 00043 USE MODI_PACK_SAME_RANK 00044 ! 00045 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00046 USE PARKIND1 ,ONLY : JPRB 00047 ! 00048 IMPLICIT NONE 00049 ! 00050 !* 0.1 Declaration of arguments 00051 ! ------------------------ 00052 ! 00053 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! host model 00054 INTEGER, INTENT(IN ) :: KLUOUT 00055 INTEGER, INTENT(IN ) :: KPTS 00056 CHARACTER(LEN=*), INTENT(IN ) :: HNAME 00057 REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD 00058 ! 00059 REAL, DIMENSION(: ), OPTIONAL, INTENT(IN) :: PDEF 00060 ! 00061 !* 0.2 Declaration of local variables 00062 ! ------------------------------ 00063 ! 00064 LOGICAL, DIMENSION(SIZE(XLAI,1),SIZE(XLAI,2)) :: GVEG 00065 REAL, DIMENSION(SIZE(PFIELD,1)) :: ZFIELD1_TOT, ZFIELD2_TOT 00066 INTEGER, DIMENSION(SIZE(PFIELD,1)) :: IMASK ! mask for packing from complete field to nature field 00067 INTEGER, DIMENSION(SIZE(PFIELD,1)) :: NSIZE 00068 INTEGER, DIMENSION(NSIZE_FULL) :: NSIZE_TOT 00069 REAL, DIMENSION(NSIZE_FULL) :: ZFIELD_TOT 00070 INTEGER :: INI, IPATCH, IFULL, INPTS 00071 INTEGER :: JPATCH ! loop counter on patch 00072 REAL :: ZRATIO_TOT 00073 ! 00074 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00075 ! 00076 !------------------------------------------------------------------------------- 00077 ! (1) & (2) INTERPOL FILED 00078 !------------------------- 00079 ! 00080 IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_PATCH',0,ZHOOK_HANDLE) 00081 ! 00082 INI=SIZE(PFIELD,1) 00083 IPATCH=SIZE(PFIELD,2) 00084 ! 00085 IF (KPTS>0)THEN 00086 ! 00087 CALL GET_SURF_MASK_n('NATURE',INI,IMASK,NSIZE_FULL,KLUOUT) 00088 ! 00089 DO JPATCH=1,IPATCH 00090 NSIZE(:)=0 00091 WHERE (PFIELD(:,JPATCH).NE.XUNDEF) NSIZE(:)=1 00092 WHERE (XPATCH(:,JPATCH)==0.) NSIZE(:)=-1 00093 CALL UNPACK_SAME_RANK(IMASK,NSIZE,NSIZE_TOT,-1) 00094 CALL UNPACK_SAME_RANK(IMASK,PFIELD(:,JPATCH),ZFIELD_TOT) 00095 IF(PRESENT(PDEF))THEN 00096 CALL INTERPOL_FIELD(HPROGRAM,KLUOUT,NSIZE_TOT,ZFIELD_TOT,HNAME,PDEF=PDEF(JPATCH),KNPTS=KPTS) 00097 ELSE 00098 CALL INTERPOL_FIELD(HPROGRAM,KLUOUT,NSIZE_TOT,ZFIELD_TOT,HNAME,KNPTS=KPTS) 00099 ENDIF 00100 CALL PACK_SAME_RANK(IMASK,ZFIELD_TOT,PFIELD(:,JPATCH)) 00101 ENDDO 00102 ! 00103 ELSE 00104 ! 00105 !------------------------------------------------------------------------------- 00106 ! (3) Cell mass conservative + simple interpolation based on global cell 00107 ! informations 00108 !---------------------------- 00109 ! 00110 ! 00111 ZFIELD1_TOT(:)=0. 00112 ZFIELD2_TOT(:)=0. 00113 ! 00114 GVEG(:,:)=.TRUE. 00115 ! 00116 IF (TRIM(HNAME)=='WR')THEN 00117 !no interception over soil(1), roc(2) and glaciers(3) 00118 DO JPATCH=1,IPATCH 00119 WHERE(XPATCH(:,JPATCH) /=0. .AND. XPATCH_OLD(:,JPATCH) ==0..AND.XLAI(:,JPATCH)==0.) 00120 PFIELD(:,JPATCH) = 0. 00121 GVEG (:,JPATCH) = .FALSE. 00122 ENDWHERE 00123 END DO 00124 END IF 00125 ! 00126 !quantity of water before restart in each grid point 00127 DO JPATCH=1,IPATCH 00128 ZFIELD1_TOT(:)=ZFIELD1_TOT(:)+ XPATCH_OLD(:,JPATCH)*PFIELD(:,JPATCH) 00129 END DO 00130 ! 00131 DO JPATCH=1,IPATCH 00132 !if a patch appears in a grid point, it takes the quantity of water in the 00133 !whole grid point before 00134 WHERE(XPATCH(:,JPATCH) /=0. .AND. XPATCH_OLD(:,JPATCH)==0. .AND. GVEG (:,JPATCH)) 00135 PFIELD(:,JPATCH)=ZFIELD1_TOT(:) 00136 ENDWHERE 00137 !quantity of water after restart and landuse in each grid point 00138 ZFIELD2_TOT(:)=ZFIELD2_TOT(:)+ XPATCH(:,JPATCH)*PFIELD(:,JPATCH) 00139 END DO 00140 ! 00141 ! Conserve cell mass if not WG and WGI 00142 ! If WG or WGI conserve global mass via CONSERV_GLOBAL_MASS routine 00143 ! is recomanded 00144 ! 00145 IF (TRIM(HNAME)/='WG' .AND. TRIM(HNAME)/='WGI') THEN 00146 DO JPATCH=1,IPATCH 00147 WHERE(ZFIELD2_TOT(:) > 1.E-12) 00148 PFIELD(:,JPATCH)=(ZFIELD1_TOT(:)/ZFIELD2_TOT(:))*PFIELD(:,JPATCH) 00149 ENDWHERE 00150 END DO 00151 ENDIF 00152 ! 00153 WHERE(XPATCH(:,:) ==0.)PFIELD(:,:)=XUNDEF 00154 ! 00155 ENDIF 00156 ! 00157 !------------------------------------------------------------------------------- 00158 ! 00159 IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_PATCH',1,ZHOOK_HANDLE) 00160 ! 00161 !------------------------------------------------------------------------------- 00162 ! 00163 END SUBROUTINE INI_VAR_FROM_PATCH
1.8.0
