Context Navigation

obs_grid.F90 @ 2733

Last change on this file since 2733 was 2474, checked in by djlea, 13 years ago
Update to OBS and ASM documentation. Removal of cpp key options to OBS code. Also moved the diaobs call to after the timestep code in step.
Property svn:keywords set to `Id`
File size: 46.6 KB

Line
1	MODULE obs_grid
2	!!======================================================================
3	!! * MODULE obs_grid *
4	!! Observation diagnostics: Various tools for grid searching etc.
5	!!======================================================================
6	!!----------------------------------------------------------------------
7	!! obs_grid_search : Find i,j on the ORCA grid from lat,lon
8	!! obs_level_search : Find level from depth
9	!! obs_zlevel_search : Find depth level from observed depth
10	!! obs_tlevel_search : Find temperature level from observed temp
11	!! obs_rlevel_search : Find density level from observed density
12	!!----------------------------------------------------------------------
13	!! * Modules used
14	USE par_kind, ONLY : & ! Precision variables
15	& wp
16	USE par_oce, ONLY : & ! Ocean parameters
17	& jpk, &
18	& jpni, &
19	& jpnj, &
20	& jpnij
21	USE dom_oce ! Ocean space and time domain variables
22	USE obs_mpp, ONLY : & ! MPP support routines for observation diagnostics
23	& obs_mpp_find_obs_proc, &
24	& mpp_global_max, &
25	& obs_mpp_max_integer
26	USE phycst, ONLY : & ! Physical constants
27	& rad
28	USE obs_utils, ONLY : & ! Observation operator utility functions
29	& grt_cir_dis, &
30	& chkerr
31	USE in_out_manager ! Printing support
32	USE netcdf
33	USE obs_const, ONLY : &
34	& obfillflt ! Fillvalue
35
36	IMPLICIT NONE
37
38	!! * Routine accessibility
39	PUBLIC obs_grid_setup, & ! Setup grid searching
40	& obs_grid_search, & ! Find i, j on the ORCA grid from lat, lon
41	& obs_grid_deallocate, & ! Deallocate the look up table
42	& obs_level_search ! Find level from depth
43
44	PRIVATE linquad, & ! Determine whether a point lies within a cell
45	& maxdist, & ! Find the maximum distance between 2 pts in a cell
46	& obs_grd_bruteforce, & ! Find i, j on the ORCA grid from lat, lon
47	& obs_grd_lookup ! Find i, j on the ORCA grid from lat, lon quicker
48
49	!!* Module variables
50
51	!! Default values
52	REAL, PUBLIC :: grid_search_res = 0.5 ! Resolution of grid
53	INTEGER, PRIVATE :: gsearch_nlons_def ! Num of longitudes
54	INTEGER, PRIVATE :: gsearch_nlats_def ! Num of latitudes
55	REAL(wp), PRIVATE :: gsearch_lonmin_def ! Min longitude
56	REAL(wp), PRIVATE :: gsearch_latmin_def ! Min latitude
57	REAL(wp), PRIVATE :: gsearch_dlon_def ! Lon spacing
58	REAL(wp), PRIVATE :: gsearch_dlat_def ! Lat spacing
59	!! Variable versions
60	INTEGER, PRIVATE :: nlons ! Num of longitudes
61	INTEGER, PRIVATE :: nlats ! Num of latitudes
62	REAL(wp), PRIVATE :: lonmin ! Min longitude
63	REAL(wp), PRIVATE :: latmin ! Min latitude
64	REAL(wp), PRIVATE :: dlon ! Lon spacing
65	REAL(wp), PRIVATE :: dlat ! Lat spacing
66
67	INTEGER, PRIVATE :: maxxdiff, maxydiff ! Max diffs between model points
68	INTEGER, PRIVATE :: limxdiff, limydiff
69
70	! Data storage
71	REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
72	& lons, &
73	& lats
74	INTEGER, PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
75	& ixpos, &
76	& iypos, &
77	& iprocn
78
79	! Switches
80	LOGICAL, PUBLIC :: ln_grid_search_lookup ! Use lookup table to speed up grid search
81	LOGICAL, PUBLIC :: ln_grid_global ! Use global distribution of observations
82	CHARACTER(LEN=44), PUBLIC :: &
83	& grid_search_file ! file name head for grid search lookup
84
85	!!----------------------------------------------------------------------
86	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
87	!! $Id$
88	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
89	!!----------------------------------------------------------------------
90
91	CONTAINS
92
93	SUBROUTINE obs_grid_search( kobsin, plam, pphi, kobsi, kobsj, kproc, &
94	& cdgrid )
95	!!----------------------------------------------------------------------
96	!! * ROUTINE obs_grid_search *
97	!!
98	!! ** Purpose : Search local gridpoints to find the grid box containing
99	!! the observations calls either
100	!! obs_grd_bruteforce - the original brute force search
101	!! or
102	!! obs_grd_lookup - uses a lookup table to do a fast
103	!!search
104	!!History :
105	!! ! 2007-12 (D. Lea)
106	!!------------------------------------------------------------------------
107
108	!! * Arguments
109	INTEGER :: &
110	& kobsin ! Size of the observation arrays
111	REAL(KIND=wp), DIMENSION(kobsin), INTENT(IN) :: &
112	& plam, & ! Longitude of obsrvations
113	& pphi ! Latitude of observations
114	INTEGER, DIMENSION(kobsin), INTENT(OUT) :: &
115	& kobsi, & ! I-index of observations
116	& kobsj, & ! J-index of observations
117	& kproc ! Processor number of observations
118	CHARACTER(LEN=1) :: &
119	& cdgrid ! Grid to search
120
121	IF(kobsin > 0) THEN
122
123	IF ( ln_grid_search_lookup .AND. ( cdgrid == 'T' ) ) THEN
124	CALL obs_grd_lookup( kobsin, plam, pphi, &
125	& kobsi, kobsj, kproc )
126	ELSE
127	IF ( cdgrid == 'T' ) THEN
128	CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
129	& nldi, nlei,nldj, nlej, &
130	& nproc, jpnij, &
131	& glamt, gphit, tmask, &
132	& kobsin, plam, pphi, &
133	& kobsi, kobsj, kproc )
134	ELSEIF ( cdgrid == 'U' ) THEN
135	CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
136	& nldi, nlei,nldj, nlej, &
137	& nproc, jpnij, &
138	& glamu, gphiu, umask, &
139	& kobsin, plam, pphi, &
140	& kobsi, kobsj, kproc )
141	ELSEIF ( cdgrid == 'V' ) THEN
142	CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
143	& nldi, nlei,nldj, nlej, &
144	& nproc, jpnij, &
145	& glamv, gphiv, vmask, &
146	& kobsin, plam, pphi, &
147	& kobsi, kobsj, kproc )
148	ELSEIF ( cdgrid == 'F' ) THEN
149	CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
150	& nldi, nlei,nldj, nlej, &
151	& nproc, jpnij, &
152	& glamf, gphif, fmask, &
153	& kobsin, plam, pphi, &
154	& kobsi, kobsj, kproc )
155	ELSE
156	CALL ctl_stop( 'Grid not supported' )
157	ENDIF
158	ENDIF
159
160	ENDIF
161
162	END SUBROUTINE obs_grid_search
163
164	#include "obs_grd_bruteforce.h90"
165
166	SUBROUTINE obs_grd_lookup( kobs, plam, pphi, kobsi, kobsj, kproc )
167	!!----------------------------------------------------------------------
168	!! * ROUTINE obs_grid_lookup *
169	!!
170	!! ** Purpose : Search local gridpoints to find the grid box containing
171	!! the observations (much faster then obs_grd_bruteforce)
172	!!
173	!! ** Method : Call to linquad
174	!!
175	!! ** Action : Return kproc holding the observation and kiobsi,kobsj
176	!! valid on kproc=nproc processor only.
177	!!
178	!! History :
179	!! ! 2007-12 (D. Lea) new routine based on obs_grid_search
180	!!! updated with fixes from new version of obs_grid_search_bruteforce
181	!!! speeded up where points are not near a "difficult" region like an edge
182	!!----------------------------------------------------------------------
183
184	!! * Arguments
185	INTEGER :: kobs ! Size of the observation arrays
186	REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
187	& plam, & ! Longitude of obsrvations
188	& pphi ! Latitude of observations
189	INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
190	& kobsi, & ! I-index of observations
191	& kobsj, & ! J-index of observations
192	& kproc ! Processor number of observations
193
194	!! * Local declarations
195	REAL(KIND=wp), DIMENSION(:), ALLOCATABLE :: &
196	& zplam
197	REAL(wp) :: zlammax
198	REAL(wp) :: zlam
199	INTEGER :: ji
200	INTEGER :: jj
201	INTEGER :: jk
202	INTEGER :: jo
203	INTEGER :: isx
204	INTEGER :: isy
205	INTEGER :: jimin
206	INTEGER :: jimax
207	INTEGER :: jjmin
208	INTEGER :: jjmax
209	INTEGER :: jojimin
210	INTEGER :: jojimax
211	INTEGER :: jojjmin
212	INTEGER :: jojjmax
213	INTEGER :: ipx1
214	INTEGER :: ipy1
215	INTEGER :: ip
216	INTEGER :: jp
217	INTEGER :: ipx
218	INTEGER :: ipy
219	INTEGER :: ipmx
220	INTEGER :: jlon
221	INTEGER :: jlat
222	INTEGER :: joffset
223	INTEGER :: jostride
224	REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
225	& zlamg, &
226	& zphig, &
227	& zmskg, &
228	& zphitmax,&
229	& zphitmin,&
230	& zlamtmax,&
231	& zlamtmin
232	LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
233	& llinvalidcell
234	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
235	& zlamtm, &
236	& zphitm
237	LOGICAL :: llfourflag
238	INTEGER :: ifourflagcountt
239	INTEGER :: ifourflagcountf
240	INTEGER, DIMENSION(5) :: ifourflagcountr
241
242	!-----------------------------------------------------------------------
243	! Define grid for grid search
244	!-----------------------------------------------------------------------
245	IF (ln_grid_global) THEN
246	jlon = jpiglo
247	jlat = jpjglo
248	joffset = nproc
249	jostride = jpnij
250	ELSE
251	jlon = jpi
252	jlat = jpj
253	joffset = 0
254	jostride = 1
255	ENDIF
256	!-----------------------------------------------------------------------
257	! Set up data for grid search
258	!-----------------------------------------------------------------------
259	ALLOCATE( &
260	& zlamg(jlon,jlat), &
261	& zphig(jlon,jlat), &
262	& zmskg(jlon,jlat), &
263	& zphitmax(jlon-1,jlat-1), &
264	& zphitmin(jlon-1,jlat-1), &
265	& zlamtmax(jlon-1,jlat-1), &
266	& zlamtmin(jlon-1,jlat-1), &
267	& llinvalidcell(jlon-1,jlat-1), &
268	& zlamtm(4,jlon-1,jlat-1), &
269	& zphitm(4,jlon-1,jlat-1) &
270	& )
271	!-----------------------------------------------------------------------
272	! Copy data to local arrays
273	!-----------------------------------------------------------------------
274	IF (ln_grid_global) THEN
275	zlamg(:,:) = -1.e+10
276	zphig(:,:) = -1.e+10
277	zmskg(:,:) = -1.e+10
278	! Add various grids here.
279	DO jj = nldj, nlej
280	DO ji = nldi, nlei
281	zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
282	zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
283	zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
284	END DO
285	END DO
286	CALL mpp_global_max( zlamg )
287	CALL mpp_global_max( zphig )
288	CALL mpp_global_max( zmskg )
289	ELSE
290	! Add various grids here.
291	DO jj = 1, jlat
292	DO ji = 1, jlon
293	zlamg(ji,jj) = glamt(ji,jj)
294	zphig(ji,jj) = gphit(ji,jj)
295	zmskg(ji,jj) = tmask(ji,jj,1)
296	END DO
297	END DO
298	ENDIF
299	!-----------------------------------------------------------------------
300	! Copy longitudes
301	!-----------------------------------------------------------------------
302	ALLOCATE( &
303	& zplam(kobs) &
304	& )
305	DO jo = 1, kobs
306	zplam(jo) = plam(jo)
307	END DO
308	!-----------------------------------------------------------------------
309	! Set default values for output
310	!-----------------------------------------------------------------------
311	kproc(:) = -1
312	kobsi(:) = -1
313	kobsj(:) = -1
314	!-----------------------------------------------------------------------
315	! Copy grid positions to temporary arrays and renormalize to 0 to 360.
316	!-----------------------------------------------------------------------
317	DO jj = 1, jlat-1
318	DO ji = 1, jlon-1
319	zlamtm(1,ji,jj) = zlamg(ji ,jj )
320	zphitm(1,ji,jj) = zphig(ji ,jj )
321	zlamtm(2,ji,jj) = zlamg(ji+1,jj )
322	zphitm(2,ji,jj) = zphig(ji+1,jj )
323	zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
324	zphitm(3,ji,jj) = zphig(ji+1,jj+1)
325	zlamtm(4,ji,jj) = zlamg(ji ,jj+1)
326	zphitm(4,ji,jj) = zphig(ji ,jj+1)
327	END DO
328	END DO
329	WHERE ( zlamtm(:,:,:) < 0.0_wp )
330	zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
331	END WHERE
332	WHERE ( zlamtm(:,:,:) > 360.0_wp )
333	zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
334	END WHERE
335	!-----------------------------------------------------------------------
336	! Handle case of the wraparound; beware, not working with orca180
337	!-----------------------------------------------------------------------
338	DO jj = 1, jlat-1
339	DO ji = 1, jlon-1
340	zlammax = MAXVAL( zlamtm(:,ji,jj) )
341	WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) &
342	& zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
343	zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
344	zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
345	zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
346	zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
347	END DO
348	END DO
349	!-----------------------------------------------------------------------
350	! Search for boxes with only land points mark them invalid
351	!-----------------------------------------------------------------------
352	llinvalidcell(:,:) = .FALSE.
353	DO jj = 1, jlat-1
354	DO ji = 1, jlon-1
355	llinvalidcell(ji,jj) = &
356	& zmskg(ji ,jj ) == 0.0_wp .AND. &
357	& zmskg(ji+1,jj ) == 0.0_wp .AND. &
358	& zmskg(ji+1,jj+1) == 0.0_wp .AND. &
359	& zmskg(ji ,jj+1) == 0.0_wp
360	END DO
361	END DO
362
363	if(lwp) WRITE(numout,*) 'obs_grid_lookup do coordinate search using lookup table'
364
365	!-----------------------------------------------------------------------
366	! Do coordinate search using lookup table with local searches.
367	! - For land points kproc is set to number of the processor + 1000000
368	! and we continue the search.
369	! - For ocean points kproc is set to the number of the processor
370	! and we stop the search.
371	!-----------------------------------------------------------------------
372	ifourflagcountt = 0
373	ifourflagcountf = 0
374	ifourflagcountr(:) = 0
375
376	!------------------------------------------------------------------------
377	! Master loop for grid search
378	!------------------------------------------------------------------------
379
380	gpkobs: DO jo = 1+joffset, kobs, jostride
381	! Normal case
382	! specify 4 points which surround the lat lon of interest
383	! x i,j+1 x i+1, j+1
384	!
385	!
386	! * lon,lat
387	! x i,j x i+1,j
388
389	! bottom corner point
390	ipx1 = INT( ( zplam(jo) - lonmin ) / dlon + 1.0 )
391	ipy1 = INT( ( pphi (jo) - latmin ) / dlat + 1.0 )
392
393	ipx = ipx1 + 1
394	ipy = ipy1 + 1
395
396	! flag for searching around four points separately
397	! default to false
398	llfourflag = .FALSE.
399
400	! check for point fully outside of region
401	IF ( (ipx1 > nlons) .OR. (ipy1 > nlats) .OR. &
402	& (ipx < 1) .OR. (ipy < 1) ) THEN
403	CYCLE
404	ENDIF
405	! check wrap around
406	IF ( (ipx > nlons) .OR. (ipy > nlats) .OR. &
407	& (ipx1 < 1) .OR. (ipy1 < 1) ) THEN
408	llfourflag=.TRUE.
409	ifourflagcountr(1) = ifourflagcountr(1) + 1
410	ENDIF
411
412	IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found
413
414	jimin = 0
415	jimax = 0
416	jjmin = 0
417	jjmax = 0
418
419	IF (.NOT. llfourflag) THEN
420
421	! calculate points range
422	! define a square region encompassing the four corner points
423	! do I need the -1 points?
424
425	jojimin = MINVAL(ixpos(ipx1:ipx,ipy1:ipy)) - 1
426	jojimax = MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) + 1
427	jojjmin = MINVAL(iypos(ipx1:ipx,ipy1:ipy)) - 1
428	jojjmax = MAXVAL(iypos(ipx1:ipx,ipy1:ipy)) + 1
429
430	jimin = jojimin - 1
431	jimax = jojimax + 1
432	jjmin = jojjmin - 1
433	jjmax = jojjmax + 1
434
435	IF ( jojimin < 0 .OR. jojjmin < 0) THEN
436	llfourflag = .TRUE.
437	ifourflagcountr(2) = ifourflagcountr(2) + 1
438	ENDIF
439	IF ( jojimax - jojimin > maxxdiff) THEN
440	llfourflag = .TRUE.
441	ifourflagcountr(3) = ifourflagcountr(3) + 1
442	ENDIF
443	IF ( jojjmax - jojjmin > maxydiff) THEN
444	llfourflag = .TRUE.
445	ifourflagcountr(4) = ifourflagcountr(4) + 1
446	ENDIF
447
448	ENDIF
449
450	ipmx = 0
451	IF (llfourflag) ipmx = 1
452
453	IF (llfourflag) THEN
454	ifourflagcountt = ifourflagcountt + 1
455	ELSE
456	ifourflagcountf = ifourflagcountf + 1
457	ENDIF
458
459	gridpointsn : DO ip = 0, ipmx
460	DO jp = 0, ipmx
461
462	IF ( kproc(jo) /= -1 ) EXIT gridpointsn
463
464	ipx = ipx1 + ip
465	ipy = ipy1 + jp
466
467	IF (llfourflag) THEN
468
469	! deal with wrap around
470	IF ( ipx > nlons ) ipx = 1
471	IF ( ipy > nlats ) ipy = 1
472	IF ( ipx < 1 ) ipx = nlons
473	IF ( ipy < 1 ) ipy = nlats
474
475	! get i,j
476	isx = ixpos(ipx,ipy)
477	isy = iypos(ipx,ipy)
478
479	! estimate appropriate search region (use max/min values)
480	jimin = isx - maxxdiff - 1
481	jimax = isx + maxxdiff + 1
482	jjmin = isy - maxydiff - 1
483	jjmax = isy + maxydiff + 1
484
485	ENDIF
486
487	IF ( jimin < 1 ) jimin = 1
488	IF ( jimax > jlon-1 ) jimax = jlon-1
489	IF ( jjmin < 1 ) jjmin = 1
490	IF ( jjmax > jlat-1 ) jjmax = jlat-1
491
492	!---------------------------------------------------------------
493	! Ensure that all observation longtiudes are between 0 and 360
494	!---------------------------------------------------------------
495
496	IF ( zplam(jo) < 0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
497	IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
498
499	!---------------------------------------------------------------
500	! Find observations which are on within 1e-6 of a grid point
501	!---------------------------------------------------------------
502
503	gridloop: DO jj = jjmin, jjmax
504	DO ji = jimin, jimax
505	IF ( ABS( zphig(ji,jj) - pphi(jo) ) < 1e-6 ) THEN
506	zlam = zlamg(ji,jj)
507	IF ( zlam < 0.0_wp ) zlam = zlam + 360.0_wp
508	IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
509	IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
510	IF ( llinvalidcell(ji,jj) ) THEN
511	kproc(jo) = nproc + 1000000
512	kobsi(jo) = ji + 1
513	kobsj(jo) = jj + 1
514	CYCLE
515	ELSE
516	kproc(jo) = nproc
517	kobsi(jo) = ji + 1
518	kobsj(jo) = jj + 1
519	EXIT gridloop
520	ENDIF
521	ENDIF
522	ENDIF
523	END DO
524	END DO gridloop
525
526	!---------------------------------------------------------------
527	! Ensure that all observation longtiudes are between -180/180
528	!---------------------------------------------------------------
529
530	IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
531
532	IF ( kproc(jo) == -1 ) THEN
533
534	! Normal case
535	gridpoints : DO jj = jjmin, jjmax
536	DO ji = jimin, jimax
537
538
539	IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
540	& ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
541
542	IF ( ABS( pphi(jo) ) < 85 ) THEN
543	IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
544	& ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
545	ENDIF
546
547	IF ( linquad( zplam(jo), pphi(jo), &
548	& zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
549	IF ( llinvalidcell(ji,jj) ) THEN
550	kproc(jo) = nproc + 1000000
551	kobsi(jo) = ji + 1
552	kobsj(jo) = jj + 1
553	CYCLE
554	ELSE
555	kproc(jo) = nproc
556	kobsi(jo) = ji + 1
557	kobsj(jo) = jj + 1
558	EXIT gridpoints
559	ENDIF
560	ENDIF
561
562	END DO
563	END DO gridpoints
564	ENDIF
565
566	! In case of failure retry for obs. longtiude + 360.
567	IF ( kproc(jo) == -1 ) THEN
568	gridpoints_greenwich : DO jj = jjmin, jjmax
569	DO ji = jimin, jimax
570
571	IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
572	& ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
573
574	IF ( ABS( pphi(jo) ) < 85 ) THEN
575	IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
576	& ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
577	ENDIF
578
579	IF ( linquad( zplam(jo)+360.0_wp, pphi(jo), &
580	& zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
581	IF ( llinvalidcell(ji,jj) ) THEN
582	kproc(jo) = nproc + 1000000
583	kobsi(jo) = ji + 1
584	kobsj(jo) = jj + 1
585	CYCLE
586	ELSE
587	kproc(jo) = nproc
588	kobsi(jo) = ji + 1
589	kobsj(jo) = jj + 1
590	EXIT gridpoints_greenwich
591	ENDIF
592	ENDIF
593
594	END DO
595	END DO gridpoints_greenwich
596
597	ENDIF ! kproc
598
599	END DO
600	END DO gridpointsn
601	END DO gpkobs ! kobs
602
603	!----------------------------------------------------------------------
604	! Synchronize kproc on all processors
605	!----------------------------------------------------------------------
606	IF ( ln_grid_global ) THEN
607	CALL obs_mpp_max_integer( kproc, kobs )
608	CALL obs_mpp_max_integer( kobsi, kobs )
609	CALL obs_mpp_max_integer( kobsj, kobs )
610	ELSE
611	CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
612	ENDIF
613
614	WHERE( kproc(:) >= 1000000 )
615	kproc(:) = kproc(:) - 1000000
616	END WHERE
617
618	DEALLOCATE( &
619	& zlamg, &
620	& zphig, &
621	& zmskg, &
622	& zphitmax, &
623	& zphitmin, &
624	& zlamtmax, &
625	& zlamtmin, &
626	& llinvalidcell, &
627	& zlamtm, &
628	& zphitm, &
629	& zplam &
630	& )
631
632	END SUBROUTINE obs_grd_lookup
633
634
635	SUBROUTINE obs_grid_setup
636	!!----------------------------------------------------------------------
637	!! * ROUTINE obs_grid_setup *
638	!!
639	!! ** Purpose : Setup a lookup table to reduce the searching required
640	!! for converting lat lons to grid point location
641	!! produces or reads in a preexisting file for use in
642	!! obs_grid_search_lookup_local
643	!!
644	!! ** Method : calls obs_grid_search_bruteforce_local with a array
645	!! of lats and lons
646	!!
647	!! History :
648	!! ! 2007-12 (D. Lea) new routine
649	!!----------------------------------------------------------------------
650
651	!! * Local declarations
652	CHARACTER(LEN=15), PARAMETER :: &
653	& cpname = 'obs_grid_setup'
654	CHARACTER(LEN=40) :: cfname
655	INTEGER :: ji
656	INTEGER :: jj
657	INTEGER :: jk
658	INTEGER :: jo
659	INTEGER :: idfile, idny, idnx, idxpos, idypos
660	INTEGER :: idlat, idlon, fileexist
661	INTEGER, DIMENSION(2) :: incdim
662	CHARACTER(LEN=20) :: datestr=" ",timestr=" "
663	REAL(wp) :: tmpx1, tmpx2, tmpy1, tmpy2
664	REAL(wp) :: meanxdiff, meanydiff
665	REAL(wp) :: meanxdiff1, meanydiff1
666	REAL(wp) :: meanxdiff2, meanydiff2
667	INTEGER :: numx1, numx2, numy1, numy2, df
668	INTEGER :: jimin, jimax, jjmin, jjmax
669	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
670	& lonsi, &
671	& latsi
672	INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
673	& ixposi, &
674	& iyposi, &
675	& iproci
676	INTEGER, PARAMETER :: histsize=90
677	INTEGER, DIMENSION(histsize) :: &
678	& histx1, histx2, histy1, histy2
679	REAL, DIMENSION(histsize) :: &
680	& fhistx1, fhistx2, fhisty1, fhisty2
681	REAL(wp) :: histtol
682
683	IF (ln_grid_search_lookup) THEN
684
685	WRITE(numout,*) 'Calling obs_grid_setup'
686
687	IF(lwp) WRITE(numout,*)
688	IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res
689
690	gsearch_nlons_def = NINT( 360.0_wp / grid_search_res )
691	gsearch_nlats_def = NINT( 180.0_wp / grid_search_res )
692	gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res
693	gsearch_latmin_def = -90.0_wp + 0.5_wp * grid_search_res
694	gsearch_dlon_def = grid_search_res
695	gsearch_dlat_def = grid_search_res
696
697	IF (lwp) THEN
698	WRITE(numout,*)'Grid search gsearch_nlons_def = ',gsearch_nlons_def
699	WRITE(numout,*)'Grid search gsearch_nlats_def = ',gsearch_nlats_def
700	WRITE(numout,*)'Grid search gsearch_lonmin_def = ',gsearch_lonmin_def
701	WRITE(numout,*)'Grid search gsearch_latmin_def = ',gsearch_latmin_def
702	WRITE(numout,*)'Grid search gsearch_dlon_def = ',gsearch_dlon_def
703	WRITE(numout,*)'Grid search gsearch_dlat_def = ',gsearch_dlat_def
704	ENDIF
705
706	IF ( ln_grid_global ) THEN
707	WRITE(cfname, FMT="(A,'_',A)") &
708	& TRIM(grid_search_file), 'global.nc'
709	ELSE
710	WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
711	& TRIM(grid_search_file), nproc, jpni, jpnj
712	ENDIF
713
714	fileexist=nf90_open( TRIM( cfname ), nf90_nowrite, &
715	& idfile )
716
717	IF ( fileexist == nf90_noerr ) THEN
718
719	! read data
720	! initially assume size is as defined (to be fixed)
721
722	WRITE(numout,*) 'Reading: ',cfname
723
724	CALL chkerr( nf90_open( TRIM( cfname ), nf90_nowrite, idfile ), &
725	& cpname, __LINE__ )
726	CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxxdiff', maxxdiff ), &
727	& cpname, __LINE__ )
728	CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxydiff', maxydiff ), &
729	& cpname, __LINE__ )
730	CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlon', dlon ), &
731	& cpname, __LINE__ )
732	CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlat', dlat ), &
733	& cpname, __LINE__ )
734	CALL chkerr( nf90_get_att( idfile, nf90_global, 'lonmin', lonmin ), &
735	& cpname, __LINE__ )
736	CALL chkerr( nf90_get_att( idfile, nf90_global, 'latmin', latmin ), &
737	& cpname, __LINE__ )
738
739	CALL chkerr( nf90_inq_dimid(idfile, 'nx' , idnx), &
740	& cpname, __LINE__ )
741	CALL chkerr( nf90_inquire_dimension( idfile, idnx, len = nlons ), &
742	& cpname, __LINE__ )
743	CALL chkerr( nf90_inq_dimid(idfile, 'ny' , idny), &
744	& cpname, __LINE__ )
745	CALL chkerr( nf90_inquire_dimension( idfile, idny, len = nlats ), &
746	& cpname, __LINE__ )
747
748	ALLOCATE( &
749	& lons(nlons,nlats), &
750	& lats(nlons,nlats), &
751	& ixpos(nlons,nlats), &
752	& iypos(nlons,nlats), &
753	& iprocn(nlons,nlats) &
754	& )
755
756	CALL chkerr( nf90_inq_varid( idfile, 'XPOS', idxpos ), &
757	& cpname, __LINE__ )
758	CALL chkerr( nf90_get_var ( idfile, idxpos, ixpos), &
759	& cpname, __LINE__ )
760	CALL chkerr( nf90_inq_varid( idfile, 'YPOS', idypos ), &
761	& cpname, __LINE__ )
762	CALL chkerr( nf90_get_var ( idfile, idypos, iypos), &
763	& cpname, __LINE__ )
764
765	CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
766
767	! setup arrays
768
769	DO ji = 1, nlons
770	DO jj = 1, nlats
771	lons(ji,jj) = lonmin + (ji-1) * dlon
772	lats(ji,jj) = latmin + (jj-1) * dlat
773	END DO
774	END DO
775
776	! if we are not reading the file we need to create it
777	! create new obs grid search lookup file
778
779	ELSE
780
781	! call obs_grid_search
782
783	IF (lwp) THEN
784	WRITE(numout,*) 'creating: ',cfname
785	WRITE(numout,) 'calling obs_grid_search: ',nlonsnlats
786	ENDIF
787
788	! set parameters from default values
789	nlons = gsearch_nlons_def
790	nlats = gsearch_nlats_def
791	lonmin = gsearch_lonmin_def
792	latmin = gsearch_latmin_def
793	dlon = gsearch_dlon_def
794	dlat = gsearch_dlat_def
795
796	! setup arrays
797
798	ALLOCATE( &
799	& lonsi(nlons,nlats), &
800	& latsi(nlons,nlats), &
801	& ixposi(nlons,nlats), &
802	& iyposi(nlons,nlats), &
803	& iproci(nlons,nlats) &
804	& )
805
806	DO ji = 1, nlons
807	DO jj = 1, nlats
808	lonsi(ji,jj) = lonmin + (ji-1) * dlon
809	latsi(ji,jj) = latmin + (jj-1) * dlat
810	END DO
811	END DO
812
813	CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
814	& nldi, nlei,nldj, nlej, &
815	& nproc, jpnij, &
816	& glamt, gphit, tmask, &
817	& nlons*nlats, lonsi, latsi, &
818	& ixposi, iyposi, iproci )
819
820	! minimise file size by removing regions with no data from xypos file
821	! should be able to just use xpos (ypos will have the same areas of missing data)
822
823	jimin=1
824	jimax=nlons
825	jjmin=1
826	jjmax=nlats
827
828	minlon_xpos: DO ji= 1, nlons
829	IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
830	jimin=ji
831	EXIT minlon_xpos
832	ENDIF
833	END DO minlon_xpos
834
835	maxlon_xpos: DO ji= nlons, 1, -1
836	IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
837	jimax=ji
838	EXIT maxlon_xpos
839	ENDIF
840	END DO maxlon_xpos
841
842	minlat_xpos: DO jj= 1, nlats
843	IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN
844	jjmin=jj
845	EXIT minlat_xpos
846	ENDIF
847	END DO minlat_xpos
848
849	maxlat_xpos: DO jj= nlats, 1, -1
850	IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN
851	jjmax=jj
852	EXIT maxlat_xpos
853	ENDIF
854	END DO maxlat_xpos
855
856	lonmin = lonsi(jimin,jjmin)
857	latmin = latsi(jimin,jjmin)
858	nlons = jimax-jimin+1
859	nlats = jjmax-jjmin+1
860
861	! construct new arrays
862
863	ALLOCATE( &
864	& lons(nlons,nlats), &
865	& lats(nlons,nlats), &
866	& ixpos(nlons,nlats), &
867	& iypos(nlons,nlats), &
868	& iprocn(nlons,nlats) &
869	& )
870
871	lons(:,:) = lonsi(jimin:jimax,jjmin:jjmax)
872	lats(:,:) = latsi(jimin:jimax,jjmin:jjmax)
873	ixpos(:,:) = ixposi(jimin:jimax,jjmin:jjmax)
874	iypos(:,:) = iyposi(jimin:jimax,jjmin:jjmax)
875	iprocn(:,:) = iproci(jimin:jimax,jjmin:jjmax)
876
877	DEALLOCATE(lonsi,latsi,ixposi,iyposi,iproci)
878
879	! calculate (estimate) maxxdiff, maxydiff
880	! this is to help define the search area for obs_grid_search_lookup
881
882	maxxdiff = 1
883	maxydiff = 1
884
885	tmpx1 = 0
886	tmpx2 = 0
887	tmpy1 = 0
888	tmpy2 = 0
889
890	numx1 = 0
891	numx2 = 0
892	numy1 = 0
893	numy2 = 0
894
895	! calculate the mean absolute xdiff and ydiff
896	! also calculate a histogram
897	! note the reason why looking for xdiff and ydiff in both directions
898	! is to allow for rotated grids
899
900	DO ji = 1, nlons-1
901	DO jj = 1, nlats-1
902	IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
903	IF ( ixpos(ji+1,jj) > 0 ) THEN
904	df = ABS( ixpos(ji+1,jj) - ixpos(ji,jj) )
905	tmpx1 = tmpx1+df
906	numx1 = numx1+1
907	IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
908	ENDIF
909	IF ( ixpos(ji,jj+1) > 0 ) THEN
910	df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
911	tmpx2 = tmpx2 + df
912	numx2 = numx2 + 1
913	IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
914	ENDIF
915	IF (iypos(ji+1,jj) > 0) THEN
916	df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
917	tmpy1 = tmpy1 + df
918	numy1 = numy1 + 1
919	IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
920	ENDIF
921	IF ( iypos(ji,jj+1) > 0 ) THEN
922	df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
923	tmpy2 = tmpy2 + df
924	numy2 = numy2 + 1
925	IF ( df < histsize ) histy2(df+1) = histy2(df+1) + 1
926	ENDIF
927	ENDIF
928	END DO
929	END DO
930
931	IF (lwp) THEN
932	WRITE(numout,*) 'histograms'
933	WRITE(numout,*) '0 1 2 3 4 5 6 7 8 9 10 ...'
934	WRITE(numout,*) 'histx1'
935	WRITE(numout,*) histx1
936	WRITE(numout,*) 'histx2'
937	WRITE(numout,*) histx2
938	WRITE(numout,*) 'histy1'
939	WRITE(numout,*) histy1
940	WRITE(numout,*) 'histy2'
941	WRITE(numout,*) histy2
942	ENDIF
943
944	meanxdiff1 = tmpx1 / numx1
945	meanydiff1 = tmpy1 / numy1
946	meanxdiff2 = tmpx2 / numx2
947	meanydiff2 = tmpy2 / numy2
948
949	meanxdiff = MAXVAL((/ meanxdiff1, meanxdiff2 /))
950	meanydiff = MAXVAL((/ meanydiff1, meanydiff2 /))
951
952	IF (lwp) THEN
953	WRITE(numout,*) tmpx1, tmpx2, tmpy1, tmpy2
954	WRITE(numout,*) numx1, numx2, numy1, numy2
955	WRITE(numout,*) 'meanxdiff: ',meanxdiff, meanxdiff1, meanxdiff2
956	WRITE(numout,*) 'meanydiff: ',meanydiff, meanydiff1, meanydiff2
957	ENDIF
958
959	tmpx1 = 0
960	tmpx2 = 0
961	tmpy1 = 0
962	tmpy2 = 0
963
964	numx1 = 0
965	numx2 = 0
966	numy1 = 0
967	numy2 = 0
968
969	histx1(:) = 0
970	histx2(:) = 0
971	histy1(:) = 0
972	histy2(:) = 0
973
974	limxdiff = meanxdiff * 4! limit the difference to avoid picking up wraparound
975	limydiff = meanydiff * 4
976
977	DO ji = 1, nlons-1
978	DO jj = 1, nlats-1
979	IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
980
981	IF ( ixpos(ji+1,jj) > 0 ) THEN
982	df = ABS( ixpos(ji+1,jj)-ixpos(ji,jj) )
983	tmpx1 = df
984	IF ( df < limxdiff ) numx1 = numx1+1
985	IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
986	ENDIF
987	IF ( ixpos(ji,jj+1) > 0 ) THEN
988	df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
989	tmpx2 = df
990	IF ( df < limxdiff ) numx2 = numx2 + 1
991	IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
992	ENDIF
993	IF (iypos(ji+1,jj) > 0) THEN
994	df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
995	tmpy1 = df
996	IF ( df < limxdiff ) numy1 = numy1 + 1
997	IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
998	ENDIF
999	IF (iypos(ji,jj+1) > 0) THEN
1000	df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
1001	tmpy2 = df
1002	IF ( df < limxdiff ) numy2 = numy2+1
1003	IF ( df < histsize ) histy2(df+1) = histy2(df+1)+1
1004	ENDIF
1005
1006	IF ( maxxdiff < tmpx1 .AND. tmpx1 < limxdiff ) &
1007	& maxxdiff = tmpx1
1008	IF ( maxxdiff < tmpx2 .AND. tmpx2 < limxdiff ) &
1009	& maxxdiff = tmpx2
1010	IF ( maxydiff < tmpy1 .AND. tmpy1 < limydiff ) &
1011	& maxydiff = tmpy1
1012	IF ( maxydiff < tmpy2 .AND. tmpy2 < limydiff ) &
1013	& maxydiff = tmpy2
1014
1015	ENDIF
1016	END DO
1017	END DO
1018
1019	! cumulative histograms
1020
1021	DO ji = 1, histsize - 1
1022	histx1(ji+1) = histx1(ji+1) + histx1(ji)
1023	histx2(ji+1) = histx2(ji+1) + histx2(ji)
1024	histy1(ji+1) = histy1(ji+1) + histy1(ji)
1025	histy2(ji+1) = histy2(ji+1) + histy2(ji)
1026	END DO
1027
1028	fhistx1(:) = histx1(:) * 1.0 / numx1
1029	fhistx2(:) = histx2(:) * 1.0 / numx2
1030	fhisty1(:) = histy1(:) * 1.0 / numy1
1031	fhisty2(:) = histy2(:) * 1.0 / numy2
1032
1033	! output new histograms
1034
1035	IF (lwp) THEN
1036	WRITE(numout,*) 'cumulative histograms'
1037	WRITE(numout,*) '0 1 2 3 4 5 6 7 8 9 10 ...'
1038	WRITE(numout,*) 'fhistx1'
1039	WRITE(numout,*) fhistx1
1040	WRITE(numout,*) 'fhistx2'
1041	WRITE(numout,*) fhistx2
1042	WRITE(numout,*) 'fhisty1'
1043	WRITE(numout,*) fhisty1
1044	WRITE(numout,*) 'fhisty2'
1045	WRITE(numout,*) fhisty2
1046	ENDIF
1047
1048	! calculate maxxdiff and maxydiff based on cumulative histograms
1049	! where > 0.999 of points are
1050
1051	! maxval just converts 1x1 vector return from maxloc to a scalar
1052
1053	histtol = 0.999
1054	tmpx1 = MAXVAL( MAXLOC( fhistx1(:), mask = ( fhistx1(:) <= histtol ) ) )
1055	tmpx2 = MAXVAL( MAXLOC( fhistx2(:), mask = ( fhistx2(:) <= histtol ) ) )
1056	tmpy1 = MAXVAL( MAXLOC( fhisty1(:), mask = ( fhisty1(:) <= histtol ) ) )
1057	tmpy2 = MAXVAL( MAXLOC( fhisty2(:), mask = ( fhisty2(:) <= histtol ) ) )
1058
1059	maxxdiff = MAXVAL( (/ tmpx1, tmpx2 /) ) + 1
1060	maxydiff = MAXVAL( (/ tmpy1, tmpy2 /) ) + 1
1061
1062	! Write out data
1063
1064	IF ( ( .NOT. ln_grid_global ) .OR. &
1065	& ( ( ln_grid_global ) .AND. ( nproc==0 ) ) ) THEN
1066
1067	CALL chkerr( nf90_create (TRIM(cfname), nf90_clobber, idfile), &
1068	& cpname, __LINE__ )
1069	CALL chkerr( nf90_put_att( idfile, nf90_global, 'title', &
1070	& 'Mapping file from lon/lat to model grid point' ),&
1071	& cpname,__LINE__ )
1072	CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxxdiff', &
1073	& maxxdiff ), &
1074	& cpname,__LINE__ )
1075	CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxydiff', &
1076	& maxydiff ), &
1077	& cpname,__LINE__ )
1078	CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlon', dlon ),&
1079	& cpname,__LINE__ )
1080	CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlat', dlat ),&
1081	& cpname,__LINE__ )
1082	CALL chkerr( nf90_put_att( idfile, nf90_global, 'lonmin', &
1083	& lonmin ), &
1084	& cpname,__LINE__ )
1085	CALL chkerr( nf90_put_att( idfile, nf90_global, 'latmin', &
1086	& latmin ), &
1087	& cpname,__LINE__ )
1088
1089	CALL chkerr( nf90_def_dim(idfile, 'nx' , nlons, idnx), &
1090	& cpname,__LINE__ )
1091	CALL chkerr( nf90_def_dim(idfile, 'ny' , nlats, idny), &
1092	& cpname,__LINE__ )
1093
1094	incdim(1) = idnx
1095	incdim(2) = idny
1096
1097	CALL chkerr( nf90_def_var( idfile, 'LON', nf90_float, incdim, &
1098	& idlon ), &
1099	& cpname, __LINE__ )
1100	CALL chkerr( nf90_put_att( idfile, idlon, 'long_name', &
1101	& 'longitude' ), &
1102	& cpname, __LINE__ )
1103
1104	CALL chkerr( nf90_def_var( idfile, 'LAT', nf90_float, incdim, &
1105	& idlat ), &
1106	& cpname, __LINE__ )
1107	CALL chkerr( nf90_put_att( idfile, idlat, 'long_name', &
1108	& 'latitude' ), &
1109	& cpname, __LINE__ )
1110
1111	CALL chkerr( nf90_def_var( idfile, 'XPOS', nf90_int, incdim, &
1112	& idxpos ), &
1113	& cpname, __LINE__ )
1114	CALL chkerr( nf90_put_att( idfile, idxpos, 'long_name', &
1115	& 'x position' ), &
1116	& cpname, __LINE__ )
1117	CALL chkerr( nf90_put_att( idfile, idxpos, '_FillValue', -1 ), &
1118	& cpname, __LINE__ )
1119
1120	CALL chkerr( nf90_def_var( idfile, 'YPOS', nf90_int, incdim, &
1121	& idypos ), &
1122	& cpname, __LINE__ )
1123	CALL chkerr( nf90_put_att( idfile, idypos, 'long_name', &
1124	& 'y position' ), &
1125	& cpname, __LINE__ )
1126	CALL chkerr( nf90_put_att( idfile, idypos, '_FillValue', -1 ), &
1127	& cpname, __LINE__ )
1128
1129	CALL chkerr( nf90_enddef( idfile ), cpname, __LINE__ )
1130
1131	CALL chkerr( nf90_put_var( idfile, idlon, lons), &
1132	& cpname, __LINE__ )
1133	CALL chkerr( nf90_put_var( idfile, idlat, lats), &
1134	& cpname, __LINE__ )
1135	CALL chkerr( nf90_put_var( idfile, idxpos, ixpos), &
1136	& cpname, __LINE__ )
1137	CALL chkerr( nf90_put_var( idfile, idypos, iypos), &
1138	& cpname, __LINE__ )
1139
1140	CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
1141
1142	! should also output max i, max j spacing for use in
1143	! obs_grid_search_lookup
1144
1145	ENDIF
1146
1147	ENDIF
1148
1149	ENDIF
1150
1151	END SUBROUTINE obs_grid_setup
1152
1153	SUBROUTINE obs_grid_deallocate( )
1154	!!----------------------------------------------------------------------
1155	!! * ROUTINE obs_grid_setup *
1156	!!
1157	!! ** Purpose : Deallocate arrays setup by obs_grid_setup
1158	!!
1159	!! History :
1160	!! ! 2007-12 (D. Lea) new routine
1161	!!-----------------------------------------------------------------------
1162
1163	IF (ln_grid_search_lookup) THEN
1164	DEALLOCATE( lons, lats, ixpos, iypos, iprocn )
1165	ENDIF
1166
1167	END SUBROUTINE obs_grid_deallocate
1168
1169	#include "obs_level_search.h90"
1170
1171	#include "linquad.h90"
1172
1173	#include "maxdist.h90"
1174
1175	#include "find_obs_proc.h90"
1176
1177	END MODULE obs_grid
1178

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90 @ 2733

Download in other formats: