grids_one.f 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797
  1. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  2. !
  3. ! This module reads in and initializes two grids for remapping.
  4. ! NOTE: grid1 must be the master grid -- the grid that determines
  5. ! which cells participate (e.g. land mask) and the fractional
  6. ! area of grid2 cells that participate in the remapping.
  7. !
  8. !-----------------------------------------------------------------------
  9. !
  10. ! CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
  11. !
  12. ! Copyright (c) 1997, 1998 the Regents of the University of
  13. ! California.
  14. !
  15. ! This software and ancillary information (herein called software)
  16. ! called SCRIP is made available under the terms described here.
  17. ! The software has been approved for release with associated
  18. ! LA-CC Number 98-45.
  19. !
  20. ! Unless otherwise indicated, this software has been authored
  21. ! by an employee or employees of the University of California,
  22. ! operator of the Los Alamos National Laboratory under Contract
  23. ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S.
  24. ! Government has rights to use, reproduce, and distribute this
  25. ! software. The public may copy and use this software without
  26. ! charge, provided that this Notice and any statement of authorship
  27. ! are reproduced on all copies. Neither the Government nor the
  28. ! University makes any warranty, express or implied, or assumes
  29. ! any liability or responsibility for the use of this software.
  30. !
  31. ! If software is modified to produce derivative works, such modified
  32. ! software should be clearly marked, so as not to confuse it with
  33. ! the version available from Los Alamos National Laboratory.
  34. !
  35. !***********************************************************************
  36. module grids_one
  37. !-----------------------------------------------------------------------
  38. use kinds_mod ! defines data types
  39. use constants ! common constants
  40. use iounits ! I/O unit manager
  41. use netcdf_mod ! netCDF stuff
  42. implicit none
  43. !-----------------------------------------------------------------------
  44. !
  45. ! variables that describe each grid
  46. !
  47. !-----------------------------------------------------------------------
  48. integer (kind=int_kind), save ::
  49. & grid1_size, grid2_size, ! total points on each grid
  50. & grid1_rank, grid2_rank, ! rank of each grid
  51. & grid1_corners, grid2_corners ! number of corners
  52. ! for each grid cell
  53. integer (kind=int_kind), dimension(:), allocatable, save ::
  54. & grid1_dims, grid2_dims ! size of each grid dimension
  55. character(char_len), save ::
  56. & grid1_name, grid2_name ! name for each grid
  57. character (char_len), save ::
  58. & grid1_units, ! units for grid coords (degs/radians)
  59. & grid2_units ! units for grid coords
  60. real (kind=dbl_kind), parameter ::
  61. & deg2rad = pi/180. ! conversion for deg to rads
  62. !-----------------------------------------------------------------------
  63. !
  64. ! grid coordinates and masks
  65. !
  66. !-----------------------------------------------------------------------
  67. logical (kind=log_kind), dimension(:), allocatable, save ::
  68. & grid1_mask, ! flag which cells participate
  69. & grid2_mask ! flag which cells participate
  70. real (kind=dbl_kind), dimension(:), allocatable, save ::
  71. & grid1_center_lat, ! lat/lon coordinates for
  72. & grid1_center_lon, ! each grid center in radians
  73. & grid2_center_lat,
  74. & grid2_center_lon,
  75. & grid1_area, ! tot area of each grid1 cell
  76. & grid2_area, ! tot area of each grid2 cell
  77. & grid1_area_in, ! area of grid1 cell from file
  78. & grid2_area_in, ! area of grid2 cell from file
  79. & grid1_frac, ! fractional area of grid cells
  80. & grid2_frac ! participating in remapping
  81. real (kind=dbl_kind), dimension(:,:), allocatable, save ::
  82. & grid1_corner_lat, ! lat/lon coordinates for
  83. & grid1_corner_lon, ! each grid corner in radians
  84. & grid2_corner_lat,
  85. & grid2_corner_lon
  86. logical (kind=log_kind), save ::
  87. & luse_grid_centers ! use centers for bounding boxes
  88. &, luse_grid1_area ! use area from grid file
  89. &, luse_grid2_area ! use area from grid file
  90. real (kind=dbl_kind), dimension(:,:), allocatable, save ::
  91. & grid1_bound_box, ! lat/lon bounding box for use
  92. & grid2_bound_box ! in restricting grid searches
  93. !-----------------------------------------------------------------------
  94. !
  95. ! bins for restricting searches
  96. !
  97. !-----------------------------------------------------------------------
  98. character (char_len), save ::
  99. & restrict_type ! type of bins to use
  100. integer (kind=int_kind), save ::
  101. & num_srch_bins ! num of bins for restricted srch
  102. integer (kind=int_kind), dimension(:,:), allocatable, save ::
  103. & bin_addr1, ! min,max adds for grid1 cells in this lat bin
  104. & bin_addr2 ! min,max adds for grid2 cells in this lat bin
  105. real(kind=dbl_kind), dimension(:,:), allocatable, save ::
  106. & bin_lats ! min,max latitude for each search bin
  107. &, bin_lons ! min,max longitude for each search bin
  108. !***********************************************************************
  109. contains
  110. !***********************************************************************
  111. subroutine grid_init_one(grid_file)
  112. !-----------------------------------------------------------------------
  113. !
  114. ! this routine reads grid info from grid files and makes any
  115. ! necessary changes (e.g. for 0,2pi longitude range)
  116. !
  117. !-----------------------------------------------------------------------
  118. !-----------------------------------------------------------------------
  119. !
  120. ! input variables
  121. !
  122. !-----------------------------------------------------------------------
  123. character(char_len), intent(in) ::
  124. & grid_file ! grid data files
  125. !-----------------------------------------------------------------------
  126. !
  127. ! local variables
  128. !
  129. !-----------------------------------------------------------------------
  130. integer (kind=int_kind) ::
  131. & n ! loop counter
  132. &, nele ! element loop counter
  133. &, iunit ! unit number for opening files
  134. &, i,j ! logical 2d addresses
  135. &, ip1,jp1
  136. &, n_add, e_add, ne_add
  137. &, nx, ny
  138. integer (kind=int_kind) ::
  139. & ncstat, ! netCDF status variable
  140. & nc_grid_id, ! netCDF grid file id
  141. & nc_gridsize_id, ! netCDF grid size dim id
  142. & nc_gridcorn_id, ! netCDF grid corner dim id
  143. & nc_gridrank_id, ! netCDF grid rank dim id
  144. & nc_gridarea_id, ! netCDF grid rank dim id
  145. & nc_griddims_id, ! netCDF grid dimension size id
  146. & nc_grdmask_id, ! netCDF grid imask var id
  147. & nc_grdcrnrlat_id, ! netCDF grid corner lat var id
  148. & nc_grdcrnrlon_id, ! netCDF grid corner lon var id
  149. & nc_grdcntrlat_id, ! netCDF grid center lat var id
  150. & nc_grdcntrlon_id, ! netCDF grid center lon var id
  151. integer (kind=int_kind), dimension(:), allocatable ::
  152. & imask ! integer mask read from file
  153. real (kind=dbl_kind) ::
  154. & dlat,dlon ! lat/lon intervals for search bins
  155. real (kind=dbl_kind), dimension(4) ::
  156. & tmp_lats, tmp_lons ! temps for computing bounding boxes
  157. !-----------------------------------------------------------------------
  158. !
  159. ! open grid files and read grid size/name data
  160. !
  161. !-----------------------------------------------------------------------
  162. ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid_id)
  163. call netcdf_error_handler(ncstat)
  164. ncstat = nf_inq_dimid(nc_grid_id, 'grid_size', nc_gridsize_id)
  165. call netcdf_error_handler(ncstat)
  166. ncstat = nf_inq_dimlen(nc_grid_id, nc_gridsize_id, grid_size)
  167. call netcdf_error_handler(ncstat)
  168. ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
  169. call netcdf_error_handler(ncstat)
  170. ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
  171. call netcdf_error_handler(ncstat)
  172. allocate( grid1_dims(grid1_rank),
  173. & grid2_dims(grid2_rank))
  174. ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title',
  175. & grid1_name)
  176. call netcdf_error_handler(ncstat)
  177. ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title',
  178. & grid2_name)
  179. call netcdf_error_handler(ncstat)
  180. !-----------------------------------------------------------------------
  181. !
  182. ! allocate grid coordinates/masks and read data
  183. !
  184. !-----------------------------------------------------------------------
  185. allocate( grid1_mask (grid1_size),
  186. & grid2_mask (grid2_size),
  187. & grid1_center_lat(grid1_size),
  188. & grid1_center_lon(grid1_size),
  189. & grid2_center_lat(grid2_size),
  190. & grid2_center_lon(grid2_size),
  191. & grid1_area (grid1_size),
  192. & grid2_area (grid2_size),
  193. & grid1_frac (grid1_size),
  194. & grid2_frac (grid2_size),
  195. & grid1_corner_lat(grid1_corners, grid1_size),
  196. & grid1_corner_lon(grid1_corners, grid1_size),
  197. & grid2_corner_lat(grid2_corners, grid2_size),
  198. & grid2_corner_lon(grid2_corners, grid2_size),
  199. & grid1_bound_box (4 , grid1_size),
  200. & grid2_bound_box (4 , grid2_size))
  201. allocate(imask(grid1_size))
  202. ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
  203. call netcdf_error_handler(ncstat)
  204. ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
  205. call netcdf_error_handler(ncstat)
  206. ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat',
  207. & nc_grd1cntrlat_id)
  208. call netcdf_error_handler(ncstat)
  209. ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon',
  210. & nc_grd1cntrlon_id)
  211. call netcdf_error_handler(ncstat)
  212. ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat',
  213. & nc_grd1crnrlat_id)
  214. call netcdf_error_handler(ncstat)
  215. ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon',
  216. & nc_grd1crnrlon_id)
  217. call netcdf_error_handler(ncstat)
  218. ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
  219. call netcdf_error_handler(ncstat)
  220. ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
  221. call netcdf_error_handler(ncstat)
  222. ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id,
  223. & grid1_center_lat)
  224. call netcdf_error_handler(ncstat)
  225. ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id,
  226. & grid1_center_lon)
  227. call netcdf_error_handler(ncstat)
  228. ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id,
  229. & grid1_corner_lat)
  230. call netcdf_error_handler(ncstat)
  231. ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id,
  232. & grid1_corner_lon)
  233. call netcdf_error_handler(ncstat)
  234. if (luse_grid1_area) then
  235. allocate (grid1_area_in(grid1_size))
  236. ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
  237. call netcdf_error_handler(ncstat)
  238. ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id,
  239. & grid1_area_in)
  240. call netcdf_error_handler(ncstat)
  241. endif
  242. grid1_area = zero
  243. grid1_frac = zero
  244. !-----------------------------------------------------------------------
  245. !
  246. ! initialize logical mask and convert lat/lon units if required
  247. !
  248. !-----------------------------------------------------------------------
  249. where (imask == 1)
  250. grid1_mask = .true.
  251. elsewhere
  252. grid1_mask = .false.
  253. endwhere
  254. deallocate(imask)
  255. grid1_units = ' '
  256. ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units',
  257. & grid1_units)
  258. call netcdf_error_handler(ncstat)
  259. select case (grid1_units(1:7))
  260. case ('degrees')
  261. grid1_center_lat = grid1_center_lat*deg2rad
  262. grid1_center_lon = grid1_center_lon*deg2rad
  263. case ('radians')
  264. !*** no conversion necessary
  265. case default
  266. print *,'unknown units supplied for grid1 center lat/lon: '
  267. print *,'proceeding assuming radians'
  268. end select
  269. grid1_units = ' '
  270. ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units',
  271. & grid1_units)
  272. call netcdf_error_handler(ncstat)
  273. select case (grid1_units(1:7))
  274. case ('degrees')
  275. grid1_corner_lat = grid1_corner_lat*deg2rad
  276. grid1_corner_lon = grid1_corner_lon*deg2rad
  277. case ('radians')
  278. !*** no conversion necessary
  279. case default
  280. print *,'unknown units supplied for grid1 corner lat/lon: '
  281. print *,'proceeding assuming radians'
  282. end select
  283. ncstat = nf_close(nc_grid1_id)
  284. call netcdf_error_handler(ncstat)
  285. !-----------------------------------------------------------------------
  286. !
  287. ! read data for grid 2
  288. !
  289. !-----------------------------------------------------------------------
  290. allocate(imask(grid2_size))
  291. ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
  292. call netcdf_error_handler(ncstat)
  293. ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
  294. call netcdf_error_handler(ncstat)
  295. ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat',
  296. & nc_grd2cntrlat_id)
  297. call netcdf_error_handler(ncstat)
  298. ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon',
  299. & nc_grd2cntrlon_id)
  300. call netcdf_error_handler(ncstat)
  301. ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat',
  302. & nc_grd2crnrlat_id)
  303. call netcdf_error_handler(ncstat)
  304. ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon',
  305. & nc_grd2crnrlon_id)
  306. call netcdf_error_handler(ncstat)
  307. ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
  308. call netcdf_error_handler(ncstat)
  309. ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
  310. call netcdf_error_handler(ncstat)
  311. ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id,
  312. & grid2_center_lat)
  313. call netcdf_error_handler(ncstat)
  314. ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id,
  315. & grid2_center_lon)
  316. call netcdf_error_handler(ncstat)
  317. ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id,
  318. & grid2_corner_lat)
  319. call netcdf_error_handler(ncstat)
  320. ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id,
  321. & grid2_corner_lon)
  322. call netcdf_error_handler(ncstat)
  323. if (luse_grid2_area) then
  324. allocate (grid2_area_in(grid2_size))
  325. ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
  326. call netcdf_error_handler(ncstat)
  327. ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id,
  328. & grid2_area_in)
  329. call netcdf_error_handler(ncstat)
  330. endif
  331. grid2_area = zero
  332. grid2_frac = zero
  333. !-----------------------------------------------------------------------
  334. !
  335. ! initialize logical mask and convert lat/lon units if required
  336. !
  337. !-----------------------------------------------------------------------
  338. where (imask == 1)
  339. grid2_mask = .true.
  340. elsewhere
  341. grid2_mask = .false.
  342. endwhere
  343. deallocate(imask)
  344. grid2_units = ' '
  345. ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units',
  346. & grid2_units)
  347. call netcdf_error_handler(ncstat)
  348. select case (grid2_units(1:7))
  349. case ('degrees')
  350. grid2_center_lat = grid2_center_lat*deg2rad
  351. grid2_center_lon = grid2_center_lon*deg2rad
  352. case ('radians')
  353. !*** no conversion necessary
  354. case default
  355. print *,'unknown units supplied for grid2 center lat/lon: '
  356. print *,'proceeding assuming radians'
  357. end select
  358. grid2_units = ' '
  359. ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units',
  360. & grid2_units)
  361. call netcdf_error_handler(ncstat)
  362. select case (grid2_units(1:7))
  363. case ('degrees')
  364. grid2_corner_lat = grid2_corner_lat*deg2rad
  365. grid2_corner_lon = grid2_corner_lon*deg2rad
  366. case ('radians')
  367. !*** no conversion necessary
  368. case default
  369. print *,'no units supplied for grid2 corner lat/lon: '
  370. print *,'proceeding assuming radians'
  371. end select
  372. ncstat = nf_close(nc_grid2_id)
  373. call netcdf_error_handler(ncstat)
  374. !-----------------------------------------------------------------------
  375. !
  376. ! convert longitudes to 0,2pi interval
  377. !
  378. !-----------------------------------------------------------------------
  379. where (grid1_center_lon .gt. pi2) grid1_center_lon =
  380. & grid1_center_lon - pi2
  381. where (grid1_center_lon .lt. zero) grid1_center_lon =
  382. & grid1_center_lon + pi2
  383. where (grid2_center_lon .gt. pi2) grid2_center_lon =
  384. & grid2_center_lon - pi2
  385. where (grid2_center_lon .lt. zero) grid2_center_lon =
  386. & grid2_center_lon + pi2
  387. where (grid1_corner_lon .gt. pi2) grid1_corner_lon =
  388. & grid1_corner_lon - pi2
  389. where (grid1_corner_lon .lt. zero) grid1_corner_lon =
  390. & grid1_corner_lon + pi2
  391. where (grid2_corner_lon .gt. pi2) grid2_corner_lon =
  392. & grid2_corner_lon - pi2
  393. where (grid2_corner_lon .lt. zero) grid2_corner_lon =
  394. & grid2_corner_lon + pi2
  395. !-----------------------------------------------------------------------
  396. !
  397. ! make sure input latitude range is within the machine values
  398. ! for +/- pi/2
  399. !
  400. !-----------------------------------------------------------------------
  401. where (grid1_center_lat > pih) grid1_center_lat = pih
  402. where (grid1_corner_lat > pih) grid1_corner_lat = pih
  403. where (grid1_center_lat < -pih) grid1_center_lat = -pih
  404. where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
  405. where (grid2_center_lat > pih) grid2_center_lat = pih
  406. where (grid2_corner_lat > pih) grid2_corner_lat = pih
  407. where (grid2_center_lat < -pih) grid2_center_lat = -pih
  408. where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
  409. !-----------------------------------------------------------------------
  410. !
  411. ! compute bounding boxes for restricting future grid searches
  412. !
  413. !-----------------------------------------------------------------------
  414. if (.not. luse_grid_centers) then
  415. grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
  416. grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
  417. grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
  418. grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
  419. grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
  420. grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
  421. grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
  422. grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
  423. else
  424. nx = grid1_dims(1)
  425. ny = grid1_dims(2)
  426. do n=1,grid1_size
  427. !*** find N,S and NE points to this grid point
  428. j = (n - 1)/nx +1
  429. i = n - (j-1)*nx
  430. if (i < nx) then
  431. ip1 = i + 1
  432. else
  433. !*** assume cyclic
  434. ip1 = 1
  435. !*** but if it is not, correct
  436. e_add = (j - 1)*nx + ip1
  437. if (abs(grid1_center_lat(e_add) -
  438. & grid1_center_lat(n )) > pih) then
  439. ip1 = i
  440. endif
  441. endif
  442. if (j < ny) then
  443. jp1 = j+1
  444. else
  445. !*** assume cyclic
  446. jp1 = 1
  447. !*** but if it is not, correct
  448. n_add = (jp1 - 1)*nx + i
  449. if (abs(grid1_center_lat(n_add) -
  450. & grid1_center_lat(n )) > pih) then
  451. jp1 = j
  452. endif
  453. endif
  454. n_add = (jp1 - 1)*nx + i
  455. e_add = (j - 1)*nx + ip1
  456. ne_add = (jp1 - 1)*nx + ip1
  457. !*** find N,S and NE lat/lon coords and check bounding box
  458. tmp_lats(1) = grid1_center_lat(n)
  459. tmp_lats(2) = grid1_center_lat(e_add)
  460. tmp_lats(3) = grid1_center_lat(ne_add)
  461. tmp_lats(4) = grid1_center_lat(n_add)
  462. tmp_lons(1) = grid1_center_lon(n)
  463. tmp_lons(2) = grid1_center_lon(e_add)
  464. tmp_lons(3) = grid1_center_lon(ne_add)
  465. tmp_lons(4) = grid1_center_lon(n_add)
  466. grid1_bound_box(1,n) = minval(tmp_lats)
  467. grid1_bound_box(2,n) = maxval(tmp_lats)
  468. grid1_bound_box(3,n) = minval(tmp_lons)
  469. grid1_bound_box(4,n) = maxval(tmp_lons)
  470. end do
  471. nx = grid2_dims(1)
  472. ny = grid2_dims(2)
  473. do n=1,grid2_size
  474. !*** find N,S and NE points to this grid point
  475. j = (n - 1)/nx +1
  476. i = n - (j-1)*nx
  477. if (i < nx) then
  478. ip1 = i + 1
  479. else
  480. !*** assume cyclic
  481. ip1 = 1
  482. !*** but if it is not, correct
  483. e_add = (j - 1)*nx + ip1
  484. if (abs(grid2_center_lat(e_add) -
  485. & grid2_center_lat(n )) > pih) then
  486. ip1 = i
  487. endif
  488. endif
  489. if (j < ny) then
  490. jp1 = j+1
  491. else
  492. !*** assume cyclic
  493. jp1 = 1
  494. !*** but if it is not, correct
  495. n_add = (jp1 - 1)*nx + i
  496. if (abs(grid2_center_lat(n_add) -
  497. & grid2_center_lat(n )) > pih) then
  498. jp1 = j
  499. endif
  500. endif
  501. n_add = (jp1 - 1)*nx + i
  502. e_add = (j - 1)*nx + ip1
  503. ne_add = (jp1 - 1)*nx + ip1
  504. !*** find N,S and NE lat/lon coords and check bounding box
  505. tmp_lats(1) = grid2_center_lat(n)
  506. tmp_lats(2) = grid2_center_lat(e_add)
  507. tmp_lats(3) = grid2_center_lat(ne_add)
  508. tmp_lats(4) = grid2_center_lat(n_add)
  509. tmp_lons(1) = grid2_center_lon(n)
  510. tmp_lons(2) = grid2_center_lon(e_add)
  511. tmp_lons(3) = grid2_center_lon(ne_add)
  512. tmp_lons(4) = grid2_center_lon(n_add)
  513. grid2_bound_box(1,n) = minval(tmp_lats)
  514. grid2_bound_box(2,n) = maxval(tmp_lats)
  515. grid2_bound_box(3,n) = minval(tmp_lons)
  516. grid2_bound_box(4,n) = maxval(tmp_lons)
  517. end do
  518. endif
  519. where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
  520. grid1_bound_box(3,:) = zero
  521. grid1_bound_box(4,:) = pi2
  522. end where
  523. where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
  524. grid2_bound_box(3,:) = zero
  525. grid2_bound_box(4,:) = pi2
  526. end where
  527. !***
  528. !*** try to check for cells that overlap poles
  529. !***
  530. where (grid1_center_lat > grid1_bound_box(2,:))
  531. & grid1_bound_box(2,:) = pih
  532. where (grid1_center_lat < grid1_bound_box(1,:))
  533. & grid1_bound_box(1,:) = -pih
  534. where (grid2_center_lat > grid2_bound_box(2,:))
  535. & grid2_bound_box(2,:) = pih
  536. where (grid2_center_lat < grid2_bound_box(1,:))
  537. & grid2_bound_box(1,:) = -pih
  538. !-----------------------------------------------------------------------
  539. !
  540. ! set up and assign address ranges to search bins in order to
  541. ! further restrict later searches
  542. !
  543. !-----------------------------------------------------------------------
  544. select case (restrict_type)
  545. case ('latitude')
  546. write(stdout,*) 'Using latitude bins to restrict search.'
  547. allocate(bin_addr1(2,num_srch_bins))
  548. allocate(bin_addr2(2,num_srch_bins))
  549. allocate(bin_lats (2,num_srch_bins))
  550. allocate(bin_lons (2,num_srch_bins))
  551. dlat = pi/num_srch_bins
  552. do n=1,num_srch_bins
  553. bin_lats(1,n) = (n-1)*dlat - pih
  554. bin_lats(2,n) = n*dlat - pih
  555. bin_lons(1,n) = zero
  556. bin_lons(2,n) = pi2
  557. bin_addr1(1,n) = grid1_size + 1
  558. bin_addr1(2,n) = 0
  559. bin_addr2(1,n) = grid2_size + 1
  560. bin_addr2(2,n) = 0
  561. end do
  562. do nele=1,grid1_size
  563. do n=1,num_srch_bins
  564. if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
  565. & grid1_bound_box(2,nele) >= bin_lats(1,n)) then
  566. bin_addr1(1,n) = min(nele,bin_addr1(1,n))
  567. bin_addr1(2,n) = max(nele,bin_addr1(2,n))
  568. endif
  569. end do
  570. end do
  571. do nele=1,grid2_size
  572. do n=1,num_srch_bins
  573. if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
  574. & grid2_bound_box(2,nele) >= bin_lats(1,n)) then
  575. bin_addr2(1,n) = min(nele,bin_addr2(1,n))
  576. bin_addr2(2,n) = max(nele,bin_addr2(2,n))
  577. endif
  578. end do
  579. end do
  580. case ('latlon')
  581. write(stdout,*) 'Using lat/lon boxes to restrict search.'
  582. dlat = pi /num_srch_bins
  583. dlon = pi2/num_srch_bins
  584. allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
  585. allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
  586. allocate(bin_lats (2,num_srch_bins*num_srch_bins))
  587. allocate(bin_lons (2,num_srch_bins*num_srch_bins))
  588. n = 0
  589. do j=1,num_srch_bins
  590. do i=1,num_srch_bins
  591. n = n + 1
  592. bin_lats(1,n) = (j-1)*dlat - pih
  593. bin_lats(2,n) = j*dlat - pih
  594. bin_lons(1,n) = (i-1)*dlon
  595. bin_lons(2,n) = i*dlon
  596. bin_addr1(1,n) = grid1_size + 1
  597. bin_addr1(2,n) = 0
  598. bin_addr2(1,n) = grid2_size + 1
  599. bin_addr2(2,n) = 0
  600. end do
  601. end do
  602. num_srch_bins = num_srch_bins**2
  603. do nele=1,grid1_size
  604. do n=1,num_srch_bins
  605. if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
  606. & grid1_bound_box(2,nele) >= bin_lats(1,n) .and.
  607. & grid1_bound_box(3,nele) <= bin_lons(2,n) .and.
  608. & grid1_bound_box(4,nele) >= bin_lons(1,n)) then
  609. bin_addr1(1,n) = min(nele,bin_addr1(1,n))
  610. bin_addr1(2,n) = max(nele,bin_addr1(2,n))
  611. endif
  612. end do
  613. end do
  614. do nele=1,grid2_size
  615. do n=1,num_srch_bins
  616. if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
  617. & grid2_bound_box(2,nele) >= bin_lats(1,n) .and.
  618. & grid2_bound_box(3,nele) <= bin_lons(2,n) .and.
  619. & grid2_bound_box(4,nele) >= bin_lons(1,n)) then
  620. bin_addr2(1,n) = min(nele,bin_addr2(1,n))
  621. bin_addr2(2,n) = max(nele,bin_addr2(2,n))
  622. endif
  623. end do
  624. end do
  625. case default
  626. stop 'unknown search restriction method'
  627. end select
  628. !-----------------------------------------------------------------------
  629. end subroutine grid_init
  630. !***********************************************************************
  631. end module grids
  632. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!