|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PGD_FRAC(HPROGRAM,OECOCLIMAP) 00003 ! ############################################################## 00004 ! 00005 !!**** *PGD_FRAC* monitor for averaging and interpolations of cover fractions 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 !! 00033 !! Modified 08/12/05, P. Le Moigne: user defined fields 00034 !---------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATION 00037 ! ----------- 00038 ! 00039 USE MODD_SURF_PAR, ONLY : XUNDEF 00040 USE MODD_PGD_GRID, ONLY : NL, CGRID 00041 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER 00042 USE MODD_SURF_ATM_n, ONLY : XNATURE, XSEA, XTOWN, XWATER, & 00043 XCOVER, LCOVER, & 00044 NSIZE_NATURE, NSIZE_SEA, & 00045 NSIZE_TOWN, NSIZE_WATER,NSIZE_FULL, & 00046 NDIM_NATURE, NDIM_SEA, & 00047 NDIM_TOWN,NDIM_WATER 00048 ! 00049 USE MODD_PGDWORK, ONLY : CATYPE 00050 ! 00051 USE MODI_GET_LUOUT 00052 USE MODI_OPEN_NAMELIST 00053 USE MODI_CLOSE_NAMELIST 00054 USE MODI_PGD_FIELD 00055 USE MODI_SUM_ON_ALL_PROCS 00056 ! 00057 USE MODE_POS_SURF 00058 ! 00059 ! 00060 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00061 USE PARKIND1 ,ONLY : JPRB 00062 ! 00063 USE MODI_ABOR1_SFX 00064 ! 00065 IMPLICIT NONE 00066 ! 00067 !* 0.1 Declaration of arguments 00068 ! ------------------------ 00069 ! 00070 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program 00071 LOGICAL, INTENT(OUT) :: OECOCLIMAP ! F if fractions prescribed by user 00072 ! ! T if fractions will be computed from ecoclimap 00073 ! 00074 !* 0.2 Declaration of local variables 00075 ! ------------------------------ 00076 ! 00077 INTEGER :: ILUOUT ! output listing logical unit 00078 INTEGER :: ILUNAM ! namelist file logical unit 00079 LOGICAL :: GFOUND ! true if namelist is found 00080 ! 00081 INTEGER :: JCOVER ! loop counter on covers 00082 ! 00083 REAL, DIMENSION(NL) :: ZSUM ! sum of 4 tiles fractions 00084 ! 00085 !* 0.3 Declaration of namelists 00086 ! ------------------------ 00087 ! 00088 LOGICAL :: LECOCLIMAP ! F if ecoclimap is not used 00089 REAL :: XUNIF_SEA ! value of sea fraction 00090 REAL :: XUNIF_WATER ! value of water fraction 00091 REAL :: XUNIF_NATURE! value of nature fraction 00092 REAL :: XUNIF_TOWN ! value of town fraction 00093 ! 00094 ! name of files containing data 00095 ! 00096 CHARACTER(LEN=28) :: CFNAM_SEA ! name of sea file 00097 CHARACTER(LEN=28) :: CFNAM_WATER ! name of water file 00098 CHARACTER(LEN=28) :: CFNAM_NATURE ! name of nature file 00099 CHARACTER(LEN=28) :: CFNAM_TOWN ! name of town file 00100 ! 00101 ! type of files containing data 00102 ! 00103 CHARACTER(LEN=6) :: CFTYP_SEA ! type of sea file 00104 CHARACTER(LEN=6) :: CFTYP_WATER ! type of water file 00105 CHARACTER(LEN=6) :: CFTYP_NATURE ! type of nature file 00106 CHARACTER(LEN=6) :: CFTYP_TOWN ! type of town file 00107 ! 00108 INTEGER :: ICOVER ! 0 if cover is not present, >1 if present somewhere 00109 ! ! (even on another processor) 00110 ! 00111 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00112 ! 00113 ! 00114 NAMELIST/NAM_FRAC/ LECOCLIMAP, & 00115 XUNIF_SEA, XUNIF_WATER, XUNIF_NATURE, XUNIF_TOWN, & 00116 CFNAM_SEA, CFNAM_WATER, CFNAM_NATURE, CFNAM_TOWN, & 00117 CFTYP_SEA, CFTYP_WATER, CFTYP_NATURE, CFTYP_TOWN 00118 !------------------------------------------------------------------------------- 00119 ! 00120 !* 1. Initializations 00121 ! --------------- 00122 ! 00123 IF (LHOOK) CALL DR_HOOK('PGD_FRAC',0,ZHOOK_HANDLE) 00124 XUNIF_SEA = XUNDEF 00125 XUNIF_WATER = XUNDEF 00126 XUNIF_NATURE = XUNDEF 00127 XUNIF_TOWN = XUNDEF 00128 LECOCLIMAP = .TRUE. 00129 CFNAM_SEA (:)= ' ' 00130 CFNAM_WATER (:)= ' ' 00131 CFNAM_NATURE(:)= ' ' 00132 CFNAM_TOWN (:)= ' ' 00133 CFTYP_SEA (:)= ' ' 00134 CFTYP_WATER (:)= ' ' 00135 CFTYP_NATURE(:)= ' ' 00136 CFTYP_TOWN (:)= ' ' 00137 ! 00138 OECOCLIMAP = .TRUE. 00139 ! 00140 !------------------------------------------------------------------------------- 00141 ! 00142 !* 2. Input file for cover types 00143 ! -------------------------- 00144 ! 00145 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00146 CALL OPEN_NAMELIST(HPROGRAM,ILUNAM) 00147 ! 00148 CALL POSNAM(ILUNAM,'NAM_FRAC',GFOUND,ILUOUT) 00149 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_FRAC) 00150 ! 00151 CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM) 00152 ! 00153 !------------------------------------------------------------------------------- 00154 ! 00155 IF ((LEN_TRIM(CFNAM_SEA)/=0 .OR. XUNIF_SEA/=XUNDEF) .AND. (LEN_TRIM(CFNAM_WATER)/=0 .OR. XUNIF_WATER/=XUNDEF) .AND. & 00156 (LEN_TRIM(CFNAM_NATURE)/=0 .OR. XUNIF_NATURE/=XUNDEF) .AND. (LEN_TRIM(CFNAM_TOWN)/=0 .OR. XUNIF_TOWN/=XUNDEF)) THEN 00157 ! 00158 ALLOCATE(XSEA (NL)) 00159 ALLOCATE(XWATER (NL)) 00160 ALLOCATE(XNATURE(NL)) 00161 ALLOCATE(XTOWN (NL)) 00162 ! 00163 !* 3. Uniform fractions are prescribed 00164 ! -------------------------------- 00165 ! 00166 IF (XUNIF_SEA/=XUNDEF .AND. XUNIF_WATER/=XUNDEF .AND. XUNIF_NATURE/=XUNDEF .AND. XUNIF_TOWN/=XUNDEF) THEN 00167 ! 00168 !* 3.1 Verification of the total input cover fractions 00169 ! ----------------------------------------------- 00170 ! 00171 IF (ABS(XUNIF_SEA+XUNIF_WATER+XUNIF_NATURE+XUNIF_TOWN-1.)>1.E-6) THEN 00172 WRITE(ILUOUT,*) ' ' 00173 WRITE(ILUOUT,*) '*********************************************************' 00174 WRITE(ILUOUT,*) '* Error in fractions preparation *' 00175 WRITE(ILUOUT,*) '* The prescribed fractions do not fit *' 00176 WRITE(ILUOUT,*) '* The sum of all 4 fractions must be equal to 1 exactly *' 00177 WRITE(ILUOUT,*) '*********************************************************' 00178 WRITE(ILUOUT,*) ' ' 00179 CALL ABOR1_SFX('PGD_FRAC: SUM OF ALL FRACTIONS MUST BE 1.') 00180 ! 00181 !* 3.2 Use of the presribed cover fractions 00182 ! ------------------------------------ 00183 ! 00184 ELSE 00185 ! 00186 XSEA = XUNIF_SEA 00187 XWATER = XUNIF_WATER 00188 XNATURE = XUNIF_NATURE 00189 XTOWN = XUNIF_TOWN 00190 00191 END IF 00192 ! 00193 !* 3.3 No data 00194 ! ------- 00195 ! 00196 ELSE 00197 00198 CATYPE = 'ARI' 00199 IF (XUNIF_SEA==XUNDEF) THEN 00200 CALL PGD_FIELD(HPROGRAM,'XSEA: sea fraction ','ALL', CFNAM_SEA , & 00201 CFTYP_SEA , XUNIF_SEA , XSEA(:) ) 00202 ELSE 00203 XSEA(:) = XUNIF_SEA 00204 ENDIF 00205 IF (XUNIF_WATER==XUNDEF) THEN 00206 CALL PGD_FIELD(HPROGRAM,'XWATER: water fraction ','ALL', CFNAM_WATER , & 00207 CFTYP_WATER , XUNIF_WATER , XWATER(:) ) 00208 ELSE 00209 XWATER(:) = XUNIF_WATER 00210 ENDIF 00211 IF (XUNIF_NATURE==XUNDEF) THEN 00212 CALL PGD_FIELD(HPROGRAM,'XNATURE: nature fraction','ALL', CFNAM_NATURE, & 00213 CFTYP_NATURE, XUNIF_NATURE, XNATURE(:)) 00214 ELSE 00215 XNATURE(:) = XUNIF_NATURE 00216 ENDIF 00217 IF (XUNIF_TOWN==XUNDEF) THEN 00218 CALL PGD_FIELD(HPROGRAM,'XTOWN: town fraction ','ALL', CFNAM_TOWN , & 00219 CFTYP_TOWN , XUNIF_TOWN , XTOWN(:) ) 00220 ELSE 00221 XTOWN(:) = XUNIF_TOWN 00222 ENDIF 00223 ENDIF 00224 00225 ELSE 00226 ! 00227 !* 4. No prescription of fractions 00228 ! ---------------------------- 00229 ! 00230 IF (LHOOK) CALL DR_HOOK('PGD_FRAC',1,ZHOOK_HANDLE) 00231 RETURN 00232 ! 00233 ENDIF 00234 !------------------------------------------------------------------------------- 00235 ! consistency check 00236 ! ------------------ 00237 ! 00238 ZSUM(:) = XSEA(:) + XNATURE(:) + XWATER(:) + XTOWN(:) 00239 00240 XSEA(:) = XSEA(:) / ZSUM(:) 00241 XNATURE(:) = XNATURE(:) / ZSUM(:) 00242 XWATER(:) = XWATER(:) / ZSUM(:) 00243 XTOWN(:) = XTOWN(:) / ZSUM(:) 00244 ! 00245 !------------------------------------------------------------------------------- 00246 00247 WRITE(ILUOUT,*) ' ' 00248 !------------------------------------------------------------------------------- 00249 ! 00250 OECOCLIMAP = LECOCLIMAP 00251 ! 00252 !* 5. List of cover present 00253 ! --------------------- 00254 ! 00255 IF (.NOT.LECOCLIMAP) THEN 00256 00257 ALLOCATE(XCOVER (NL,JPCOVER)) 00258 00259 XCOVER(:,:) =0. 00260 XCOVER(:,1) = XSEA(:) 00261 XCOVER(:,2) = XWATER(:) 00262 XCOVER(:,4) = XNATURE(:) 00263 XCOVER(:,254) = XTOWN(:) 00264 ! 00265 ALLOCATE(LCOVER(JPCOVER)) 00266 LCOVER = .FALSE. 00267 DO JCOVER=1,JPCOVER 00268 ICOVER = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XCOVER(:,JCOVER)/=0. ,'COV') 00269 IF (ICOVER>0) LCOVER(JCOVER)=.TRUE. 00270 END DO 00271 ! 00272 ! 00273 !------------------------------------------------------------------------------- 00274 ! 00275 !* 6. Land - sea fractions 00276 ! -------------------- 00277 ! 00278 NSIZE_NATURE = COUNT(XNATURE(:) > 0.0) 00279 NSIZE_WATER = COUNT(XWATER (:) > 0.0) 00280 NSIZE_SEA = COUNT(XSEA (:) > 0.0) 00281 NSIZE_TOWN = COUNT(XTOWN (:) > 0.0) 00282 NSIZE_FULL = NL 00283 ! 00284 NDIM_NATURE = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XNATURE(:) > 0.0, 'DIM') 00285 NDIM_WATER = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XWATER (:) > 0.0, 'DIM') 00286 NDIM_SEA = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XSEA (:) > 0.0, 'DIM') 00287 NDIM_TOWN = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XTOWN (:) > 0.0, 'DIM') 00288 ! 00289 ENDIF 00290 IF (LHOOK) CALL DR_HOOK('PGD_FRAC',1,ZHOOK_HANDLE) 00291 !------------------------------------------------------------------------------- 00292 ! 00293 END SUBROUTINE PGD_FRAC
1.8.0
