|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ################################## 00002 SUBROUTINE LATLONMASK_CONF_PROJ(KGRID_PAR,PGRID_PAR,OLATLONMASK) 00003 ! ################################## 00004 ! 00005 !!**** *LATLONMASK* builds the latiude and longitude mask including the grid 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 !! Two tests are performed: 00014 !! 00015 !! 1) test if the points of the mask are in the domain 00016 !! 00017 !! 2) fills the mask points corresponding to points scanning 00018 !! 00019 !! EXTERNAL 00020 !! -------- 00021 !! 00022 !! 00023 !! IMPLICIT ARGUMENTS 00024 !! ------------------ 00025 !! 00026 !! 00027 !! REFERENCE 00028 !! --------- 00029 !! 00030 !! AUTHOR 00031 !! ------ 00032 !! 00033 !! V. Masson Meteo-France 00034 !! 00035 !! MODIFICATION 00036 !! ------------ 00037 !! 00038 !! Original 19/07/95 00039 !---------------------------------------------------------------------------- 00040 ! 00041 !* 0. DECLARATION 00042 ! ----------- 00043 ! 00044 USE MODE_GRIDTYPE_CONF_PROJ 00045 ! 00046 ! 00047 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00048 USE PARKIND1 ,ONLY : JPRB 00049 ! 00050 IMPLICIT NONE 00051 ! 00052 !* 0.1 Declaration of arguments 00053 ! ------------------------ 00054 ! 00055 INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR 00056 REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid 00057 LOGICAL, DIMENSION(720,360), INTENT(OUT) :: OLATLONMASK ! mask where data are to be read 00058 ! 00059 !* 0.2 Declaration of local variables 00060 ! ------------------------------ 00061 ! 00062 INTEGER :: IIMAX ! x coordinates array dimension 00063 INTEGER :: IJMAX ! y coordinates array dimension 00064 INTEGER :: JI, JJ ! loop counters 00065 INTEGER :: JLON,JLAT! loop counters 00066 REAL :: ZXMIN ! minimum of X for domain 00067 REAL :: ZXMAX ! maximum of X for domain 00068 REAL :: ZYMIN ! minimum of Y for domain 00069 REAL :: ZYMAX ! maximum of Y for domain 00070 REAL, DIMENSION(:), ALLOCATABLE :: ZDX ! X grid mesh size 00071 REAL, DIMENSION(:), ALLOCATABLE :: ZDY ! Y grid mesh size 00072 REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X conformal coordinate of center of grid mesh 00073 REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y conformal coordinate of center of grid mesh 00074 REAL, DIMENSION(:), ALLOCATABLE :: ZXCORNER ! X conformal coordinate of corner of grid mesh 00075 REAL, DIMENSION(:), ALLOCATABLE :: ZYCORNER ! Y conformal coordinate of corner of grid mesh 00076 REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! corner points longitudes 00077 REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! corner points latitudes 00078 REAL, DIMENSION(:,:), ALLOCATABLE :: ZLON2D ! corner points longitudes 00079 REAL, DIMENSION(:,:), ALLOCATABLE :: ZLAT2D ! corner points latitudes 00080 REAL, DIMENSION(720,360) :: ZX_MASK ! mask points X value 00081 REAL, DIMENSION(720,360) :: ZY_MASK ! mask points Y value 00082 INTEGER, DIMENSION(720,360) :: ICOUNT1 ! counter 00083 INTEGER, DIMENSION(720,360) :: ICOUNT2 ! counter 00084 REAL, DIMENSION(720) :: ZLON_MASK! mask points longitudes 00085 REAL, DIMENSION(720) :: ZLAT_MASK! mask points latitudes 00086 REAL :: ZLAT0 ! reference latitude 00087 REAL :: ZLON0 ! reference longitude 00088 REAL :: ZRPK ! projection parameter 00089 ! ! K=1 : stereographic north pole 00090 ! ! 0<K<1 : Lambert, north hemisphere 00091 ! ! K=0 : Mercator 00092 ! !-1<K<0 : Lambert, south hemisphere 00093 ! ! K=-1: stereographic south pole 00094 REAL :: ZBETA ! angle between grid and reference longitude 00095 REAL :: ZLATOR ! latitude of point of coordinates X=0, Y=0 00096 REAL :: ZLONOR ! longitude of point of coordinates X=0, Y=0 00097 ! 00098 INTEGER :: IVERB=1 ! verbosity level 00099 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00100 !---------------------------------------------------------------------------- 00101 ! 00102 IF (LHOOK) CALL DR_HOOK('LATLONMASK_CONF_PROJ',0,ZHOOK_HANDLE) 00103 CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,KIMAX=IIMAX,KJMAX=IJMAX) 00104 ! 00105 ! 00106 ALLOCATE(ZX (IIMAX*IJMAX)) 00107 ALLOCATE(ZY (IIMAX*IJMAX)) 00108 ALLOCATE(ZDX (IIMAX*IJMAX)) 00109 ALLOCATE(ZDY (IIMAX*IJMAX)) 00110 ALLOCATE(ZXCORNER ((IIMAX+1)*(IJMAX+1))) 00111 ALLOCATE(ZYCORNER ((IIMAX+1)*(IJMAX+1))) 00112 ALLOCATE(ZLON ((IIMAX+1)*(IJMAX+1))) 00113 ALLOCATE(ZLAT ((IIMAX+1)*(IJMAX+1))) 00114 ! 00115 !------------------------------------------------------------------------------- 00116 ! 00117 OLATLONMASK(:,:) = .FALSE. 00118 ! 00119 !------------------------------------------------------------------------------- 00120 ! 00121 !* 1. Limits of the domain conformal plane coordinates 00122 ! ------------------------------------------------ 00123 ! 00124 CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY) 00125 ! 00126 ZXMIN = MINVAL(ZX) - 3.* MAXVAL(ZDX)/2. 00127 ZXMAX = MAXVAL(ZX) + 3.* MAXVAL(ZDX)/2. 00128 ! 00129 ZYMIN = MINVAL(ZY) - 3.* MAXVAL(ZDY)/2. 00130 ZYMAX = MAXVAL(ZY) + 3.* MAXVAL(ZDY)/2. 00131 ! 00132 DO JJ=1,IJMAX 00133 DO JI=1,IIMAX 00134 ZXCORNER(JI+(JJ-1)*(IIMAX+1)) = ZX(JI+(JJ-1)*IIMAX) - 0.5*ZDX(JI+(JJ-1)*IIMAX) 00135 ZYCORNER(JI+(JJ-1)*(IIMAX+1)) = ZY(JI+(JJ-1)*IIMAX) - 0.5*ZDY(JI+(JJ-1)*IIMAX) 00136 END DO 00137 ZXCORNER(IIMAX+1+(JJ-1)*(IIMAX+1)) = ZX(IIMAX+(JJ-1)*IIMAX) + 0.5*ZDX(IIMAX+(JJ-1)*IIMAX) 00138 ZYCORNER(IIMAX+1+(JJ-1)*(IIMAX+1)) = ZY(IIMAX+(JJ-1)*IIMAX) - 0.5*ZDX(IIMAX+(JJ-1)*IIMAX) 00139 END DO 00140 DO JI=1,IIMAX 00141 ZXCORNER(JI+IJMAX*(IIMAX+1)) = ZX(JI+(IJMAX-1)*IIMAX) - 0.5*ZDX(JI+(IJMAX-1)*IIMAX) 00142 ZYCORNER(JI+IJMAX*(IIMAX+1)) = ZY(JI+(IJMAX-1)*IIMAX) + 0.5*ZDY(JI+(IJMAX-1)*IIMAX) 00143 END DO 00144 ZXCORNER((IJMAX+1)*(IIMAX+1)) = ZX(IJMAX*IIMAX) + 0.5*ZDX(IJMAX*IIMAX) 00145 ZYCORNER((IJMAX+1)*(IIMAX+1)) = ZY(IJMAX*IIMAX) + 0.5*ZDY(IJMAX*IIMAX) 00146 ! 00147 DEALLOCATE(ZDX) 00148 DEALLOCATE(ZDY) 00149 DEALLOCATE(ZX) 00150 DEALLOCATE(ZY) 00151 ! 00152 !------------------------------------------------------------------------------- 00153 ! 00154 !* 2. Definition of the coordinates at center of the mask meshes 00155 ! ---------------------------------------------------------- 00156 ! 00157 ZLON_MASK(:)= (/ ( JLON /2. - 0.25 , JLON=1,720 ) /) 00158 ! 00159 !* 3. Longitude correction / LON0 00160 ! --------------------------- 00161 ! 00162 CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR, & 00163 PLAT0=ZLAT0,PLON0=ZLON0,PRPK=ZRPK, & 00164 PBETA=ZBETA,PLATOR=ZLATOR,PLONOR=ZLONOR ) 00165 ! 00166 ZLON_MASK(:)=ZLON_MASK(:)+NINT((ZLON0-ZLON_MASK(:))/360.)*360. 00167 ! 00168 !* 4. X and Y of the points of the mask 00169 ! --------------------------------- 00170 ! 00171 DO JLAT=1,SIZE(OLATLONMASK,2) 00172 ZLAT_MASK(:) = (JLAT-180)/2. - 0.25 00173 CALL XY_CONF_PROJ(ZLAT0,ZLON0,ZRPK,ZBETA,ZLATOR,ZLONOR, & 00174 ZX_MASK(:,JLAT),ZY_MASK(:,JLAT), & 00175 ZLAT_MASK(:),ZLON_MASK(:) ) 00176 END DO 00177 ! 00178 !* 5. Are the points in the domain? 00179 ! ---------------------------- 00180 ! 00181 WHERE ( ZX_MASK(:,:) >= ZXMIN .AND. ZX_MASK(:,:) <= ZXMAX & 00182 .AND. ZY_MASK(:,:) >= ZYMIN .AND. ZY_MASK(:,:) <= ZYMAX ) 00183 OLATLONMASK(:,:) = .TRUE. 00184 END WHERE 00185 ! 00186 !------------------------------------------------------------------------------- 00187 ! 00188 !* 6. Latitude and longitude of the points of the domain 00189 ! -------------------------------------------------- 00190 ! 00191 CALL LATLON_CONF_PROJ(ZLAT0,ZLON0,ZRPK,ZBETA,ZLATOR,ZLONOR, & 00192 ZXCORNER,ZYCORNER,ZLAT,ZLON ) 00193 ! 00194 !* 7. Longitudes between 0. and 360. 00195 ! ------------------------------ 00196 ! 00197 ZLON(:) = ZLON(:) + NINT((180.-ZLON(:))/360.)*360. 00198 ! 00199 !* 8. Loop on grid points 00200 ! -------------------- 00201 ! 00202 ICOUNT1(:,:) = 0 00203 ICOUNT2(:,:) = 0 00204 ! 00205 ALLOCATE(ZLAT2D(IIMAX+1,IJMAX+1)) 00206 ALLOCATE(ZLON2D(IIMAX+1,IJMAX+1)) 00207 ! 00208 DO JJ=1,IJMAX+1 00209 DO JI=1,IIMAX+1 00210 ZLAT2D(JI,JJ) = ZLAT(JI+(JJ-1)*(IIMAX+1)) 00211 ZLON2D(JI,JJ) = ZLON(JI+(JJ-1)*(IIMAX+1)) 00212 END DO 00213 END DO 00214 ! 00215 DO JJ=1,IJMAX+1 00216 DO JI=1,IIMAX+1 00217 ! 00218 !* 8.1 localisation of the point 00219 ! ------------------------- 00220 ! 00221 JLAT = MIN( 1 + INT( ( ZLAT2D(JI,JJ) + 90. ) * 2. ) ,360) 00222 JLON = MIN( 1 + INT( ( ZLON2D(JI,JJ) ) * 2. ) ,720) 00223 ! 00224 ICOUNT1(JLON,JLAT) = ICOUNT1(JLON,JLAT) + 1 00225 ! 00226 !* 8.2 Does point contain data? 00227 ! ------------------------ 00228 ! 00229 ! 00230 !* 8.3 point contains data 00231 ! ------------------- 00232 ! 00233 ICOUNT2(JLON,JLAT) = ICOUNT2(JLON,JLAT) + 1 00234 ! 00235 !* 8.4 Boundary effects 00236 ! ---------------- 00237 ! 00238 JLAT = MIN( 1 + INT( ( ZLAT2D(MIN(JI+1,IIMAX),JJ) + 90. ) * 2. ) ,360) 00239 JLON = MIN( 1 + INT( ( ZLON2D(MIN(JI+1,IIMAX),JJ) ) * 2. ) ,720) 00240 ICOUNT1(JLON,JLAT) = ICOUNT1(JLON,JLAT) + 1 00241 ICOUNT2(JLON,JLAT) = ICOUNT2(JLON,JLAT) + 1 00242 ! 00243 JLAT = MIN( 1 + INT( ( ZLAT2D(JI,MIN(JJ+1,IJMAX)) + 90. ) * 2. ) ,360) 00244 JLON = MIN( 1 + INT( ( ZLON2D(JI,MIN(JJ+1,IJMAX)) ) * 2. ) ,720) 00245 ICOUNT1(JLON,JLAT) = ICOUNT1(JLON,JLAT) + 1 00246 ICOUNT2(JLON,JLAT) = ICOUNT2(JLON,JLAT) + 1 00247 ! 00248 JLAT = MIN( 1 + INT( ( ZLAT2D(MAX(JI-1,1),JJ) + 90. ) * 2. ) ,360) 00249 JLON = MIN( 1 + INT( ( ZLON2D(MAX(JI-1,1),JJ) ) * 2. ) ,720) 00250 ICOUNT1(JLON,JLAT) = ICOUNT1(JLON,JLAT) + 1 00251 ICOUNT2(JLON,JLAT) = ICOUNT2(JLON,JLAT) + 1 00252 ! 00253 JLAT = MIN( 1 + INT( ( ZLAT2D(JI,MAX(JJ-1,1)) + 90. ) * 2. ) ,360) 00254 JLON = MIN( 1 + INT( ( ZLON2D(JI,MAX(JJ-1,1)) ) * 2. ) ,720) 00255 ICOUNT1(JLON,JLAT) = ICOUNT1(JLON,JLAT) + 1 00256 ICOUNT2(JLON,JLAT) = ICOUNT2(JLON,JLAT) + 1 00257 ! 00258 END DO 00259 END DO 00260 ! 00261 !* 9. Surface type check (if points are present in mask mesh) 00262 ! ------------------ 00263 ! 00264 WHERE (ICOUNT1(:,:) > 0 .AND. ICOUNT2(:,:) == 0) 00265 OLATLONMASK(:,:) = .FALSE. 00266 END WHERE 00267 ! 00268 WHERE (ICOUNT1(:,:) > 0 .AND. ICOUNT2(:,:) > 0) 00269 OLATLONMASK(:,:) = .TRUE. 00270 END WHERE 00271 ! 00272 ZLAT_MASK(1:360)= (/ ( (JLAT-180)/2. - 0.25 , JLAT=1,360 ) /) 00273 ! 00274 DO JLON=1,720 00275 DO JLAT=1,360 00276 IF ( (ICOUNT1(JLON,JLAT) > 0 .OR. OLATLONMASK(JLON,JLAT)) .AND. IVERB > 1) & 00277 WRITE(*,'(2(I3,1X),2(F6.2,1X),2(F8.0,1X),L1)') JLON,JLAT,ZLON_MASK(JLON),ZLAT_MASK(JLAT), & 00278 ZX_MASK(JLON,JLAT),ZY_MASK(JLON,JLAT),OLATLONMASK(JLON,JLAT) 00279 00280 END DO 00281 END DO 00282 ! 00283 !------------------------------------------------------------------------------- 00284 ! 00285 DEALLOCATE(ZLON ) 00286 DEALLOCATE(ZLAT ) 00287 DEALLOCATE(ZLON2D) 00288 DEALLOCATE(ZLAT2D) 00289 DEALLOCATE(ZXCORNER) 00290 DEALLOCATE(ZYCORNER) 00291 IF (LHOOK) CALL DR_HOOK('LATLONMASK_CONF_PROJ',1,ZHOOK_HANDLE) 00292 ! 00293 !------------------------------------------------------------------------------- 00294 ! 00295 END SUBROUTINE LATLONMASK_CONF_PROJ
1.8.0
