|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PGD_FIELD(HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,OPRESENT) 00003 ! ############################################################## 00004 ! 00005 !!**** *PGD_FIELD* monitor for averaging and interpolations of ISBA physiographic fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 ! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! AUTHOR 00024 !! ------ 00025 !! 00026 !! V. Masson Meteo-France 00027 !! 00028 !! MODIFICATION 00029 !! ------------ 00030 !! 00031 !! Original 10/12/97 00032 !! 09/2010 (E. Kourzeneva): interpolation of the lake depth 00033 !! is not allowed and not necessary 00034 !! 00035 !---------------------------------------------------------------------------- 00036 ! 00037 !* 0. DECLARATION 00038 ! ----------- 00039 ! 00040 USE MODD_SURF_PAR, ONLY : XUNDEF 00041 USE MODD_PGD_GRID, ONLY : NL 00042 USE MODD_PGDWORK, ONLY : XSUMVAL, NSIZE, CATYPE, & 00043 NVALNBR, NVALCOUNT, XVALLIST, JPVALMAX 00044 USE MODD_SURF_ATM_n, ONLY : XNATURE, XSEA, XTOWN, XWATER 00045 ! 00046 USE MODI_GET_LUOUT 00047 USE MODI_TREAT_FIELD 00048 USE MODI_INTERPOL_FIELD 00049 USE MODI_PACK_SAME_RANK 00050 ! 00051 ! 00052 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00053 USE PARKIND1 ,ONLY : JPRB 00054 ! 00055 USE MODI_ABOR1_SFX 00056 ! 00057 USE MODI_GET_SURF_MASK_n 00058 ! 00059 USE MODI_GET_TYPE_DIM_n 00060 ! 00061 IMPLICIT NONE 00062 ! 00063 !* 0.1 Declaration of arguments 00064 ! ------------------------ 00065 ! 00066 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program 00067 CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints 00068 CHARACTER(LEN=3), INTENT(IN) :: HAREA ! area where field is defined 00069 ! ! 'ALL' : everywhere 00070 ! ! 'NAT' : on nature 00071 ! ! 'TWN' : on town 00072 ! ! 'SEA' : on sea 00073 ! ! 'WAT' : on inland waters 00074 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! data file name 00075 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! data file type 00076 REAL, INTENT(IN) :: PUNIF ! prescribed uniform value for field 00077 REAL, DIMENSION(:),INTENT(OUT):: PFIELD ! physiographic field 00078 LOGICAL, OPTIONAL, INTENT(OUT) :: OPRESENT 00079 ! 00080 ! 00081 !* 0.2 Declaration of local variables 00082 ! ------------------------------ 00083 ! 00084 INTEGER :: ILU ! expected physical size of full surface array 00085 INTEGER :: ILUOUT ! output listing logical unit 00086 INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field 00087 INTEGER :: IDIM ! 00088 00089 ! 00090 CHARACTER(LEN=20) :: YFIELD 00091 CHARACTER(LEN=6) :: YMASK 00092 INTEGER :: INPTS ! number of points used for interpolation 00093 REAL, DIMENSION(NL) :: ZFIELD ! physiographic field on full grid 00094 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00095 !------------------------------------------------------------------------------- 00096 ! 00097 !* 1. Initializations 00098 ! --------------- 00099 ! 00100 IF (LHOOK) CALL DR_HOOK('PGD_FIELD',0,ZHOOK_HANDLE) 00101 ZFIELD(:) = XUNDEF 00102 IF (PRESENT(OPRESENT)) OPRESENT=.TRUE. 00103 !------------------------------------------------------------------------------- 00104 ! 00105 !* 2. Output listing logical unit 00106 ! --------------------------- 00107 ! 00108 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00109 ! 00110 !------------------------------------------------------------------------------- 00111 ! 00112 !* 3. Read from file 00113 ! -------------- 00114 ! 00115 IF (LEN_TRIM(HFILE)/=0) THEN 00116 ! 00117 !------------------------------------------------------------------------------- 00118 ! 00119 !* 4. Averages the field 00120 ! ------------------ 00121 ! 00122 ALLOCATE(NSIZE (NL)) 00123 ALLOCATE(XSUMVAL (NL)) 00124 ! 00125 NSIZE (:) = 0. 00126 XSUMVAL (:) = 0. 00127 INPTS = 3 00128 ! 00129 IF (CATYPE=='MAJ') THEN 00130 ALLOCATE(NVALNBR (NL)) 00131 ALLOCATE(NVALCOUNT(NL,JPVALMAX)) 00132 ALLOCATE(XVALLIST (NL,JPVALMAX)) 00133 NVALNBR = 0 00134 NVALCOUNT = 0 00135 XVALLIST = XUNDEF 00136 INPTS = 1 00137 END IF 00138 ! 00139 YFIELD = ' ' 00140 YFIELD = HFIELD(1:MIN(LEN(HFIELD),20)) 00141 ! 00142 CALL TREAT_FIELD(HPROGRAM,'SURF ',HFILETYPE,'A_MESH',HFILE, & 00143 YFIELD,ZFIELD,HAREA ) 00144 ! 00145 !------------------------------------------------------------------------------- 00146 ! 00147 !* 4. Mask for the interpolations 00148 ! --------------------------- 00149 ! 00150 SELECT CASE (HAREA) 00151 CASE ('LAN') 00152 WHERE ((XTOWN(:)+XNATURE(:))==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1 00153 CASE ('TWN') 00154 WHERE (XTOWN (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1 00155 CASE ('BLD') 00156 WHERE (XTOWN (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1 00157 CASE ('NAT') 00158 WHERE (XNATURE(:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1 00159 CASE ('SEA') 00160 WHERE (XSEA (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1 00161 CASE ('WAT') 00162 WHERE (XWATER (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1 00163 END SELECT 00164 ! 00165 !------------------------------------------------------------------------------- 00166 ! 00167 !* 5. Interpolation if some points are not initialized (no data for these points) 00168 ! ------------------------------------------------ 00169 ! 00170 IF(HFIELD.NE."water depth") THEN 00171 IF (PUNIF/=XUNDEF) THEN 00172 CALL INTERPOL_FIELD(HPROGRAM,ILUOUT,NSIZE,ZFIELD(:),HFIELD,PDEF=PUNIF,KNPTS=INPTS) 00173 ELSE 00174 CALL INTERPOL_FIELD(HPROGRAM,ILUOUT,NSIZE,ZFIELD(:),HFIELD) 00175 END IF 00176 END IF 00177 ! 00178 DEALLOCATE(NSIZE ) 00179 DEALLOCATE(XSUMVAL ) 00180 IF (CATYPE=='MAJ') THEN 00181 DEALLOCATE(NVALNBR ) 00182 DEALLOCATE(NVALCOUNT) 00183 DEALLOCATE(XVALLIST ) 00184 END IF 00185 ! 00186 !------------------------------------------------------------------------------- 00187 ! 00188 ELSEIF (PUNIF/=XUNDEF) THEN 00189 ! 00190 !* 3.1 Use of the presribed field 00191 ! -------------------------- 00192 ! 00193 ZFIELD(:) = PUNIF 00194 ! 00195 ELSE 00196 ! 00197 IF (PRESENT(OPRESENT)) THEN 00198 OPRESENT=.FALSE. 00199 IF (LHOOK) CALL DR_HOOK('PGD_FIELD',1,ZHOOK_HANDLE) 00200 RETURN 00201 ENDIF 00202 ! 00203 WRITE(ILUOUT,*) ' ' 00204 WRITE(ILUOUT,*) '***********************************************************' 00205 WRITE(ILUOUT,*) '* Error in PGD field preparation of field : ', HFIELD 00206 WRITE(ILUOUT,*) '* There is no prescribed value and no input file *' 00207 WRITE(ILUOUT,*) '***********************************************************' 00208 WRITE(ILUOUT,*) ' ' 00209 CALL ABOR1_SFX('PGD_FIELD: NO PRESCRIBED VALUE NOR INPUT FILE FOR '//HFIELD) 00210 ! 00211 END IF 00212 !------------------------------------------------------------------------------- 00213 ! 00214 !* 6. Mask for the field 00215 ! ------------------ 00216 ! 00217 SELECT CASE (HAREA) 00218 CASE ('LAN') 00219 YMASK = 'LAND ' 00220 CASE ('TWN') 00221 YMASK = 'TOWN ' 00222 CASE ('BLD') 00223 YMASK = 'TOWN ' 00224 CASE ('NAT') 00225 YMASK = 'NATURE' 00226 CASE ('SEA') 00227 YMASK = 'SEA ' 00228 CASE ('WAT') 00229 YMASK = 'WATER ' 00230 CASE DEFAULT 00231 PFIELD(:) = ZFIELD(:) 00232 IF (LHOOK) CALL DR_HOOK('PGD_FIELD',1,ZHOOK_HANDLE) 00233 RETURN 00234 END SELECT 00235 00236 CALL GET_TYPE_DIM_n(YMASK,IDIM) 00237 IF (IDIM/=SIZE(PFIELD)) THEN 00238 WRITE(ILUOUT,*)'Wrong dimension of MASK: ',IDIM,SIZE(PFIELD) 00239 CALL ABOR1_SFX('PGD_FIELD: WRONG DIMENSION OF MASK') 00240 ENDIF 00241 00242 ALLOCATE(IMASK(IDIM)) 00243 ILU=0 00244 CALL GET_SURF_MASK_n(YMASK,IDIM,IMASK,ILU,ILUOUT) 00245 CALL PACK_SAME_RANK(IMASK,ZFIELD(:),PFIELD(:)) 00246 DEALLOCATE(IMASK) 00247 IF (LHOOK) CALL DR_HOOK('PGD_FIELD',1,ZHOOK_HANDLE) 00248 00249 ! 00250 !------------------------------------------------------------------------------- 00251 ! 00252 END SUBROUTINE PGD_FIELD
1.8.0
