Context Navigation

wrf_lidar.F @ 2853

Last change on this file since 2853 was 588, checked in by lfita, 10 years ago
Adding certain modifications which I do not know why...
File size: 21.4 KB

Line
1	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2	! L. Fita, LMD. May 2014. Module to compute lidar retrievals (values on the vertical
3	! column) at each time-step. Based on wrf_ts.F
4	! This routine prints out the current value of variables at all specified
5	! time series locations that are within the current patch.
6	!
7	! Michael G. Duda -- 25 August 2005
8	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9	SUBROUTINE calc_lidar_locations( grid )
10
11	USE module_domain, ONLY : domain, get_ijk_from_grid, domain_clock_get
12	USE module_configure, ONLY : model_config_rec, grid_config_rec_type, model_to_grid_config_rec
13	USE module_dm, ONLY : wrf_dm_min_real
14	USE module_llxy
15	USE module_state_description
16
17	IMPLICIT NONE
18
19	! Arguments
20	TYPE (domain), INTENT(INOUT) :: grid
21
22	! Externals
23	LOGICAL, EXTERNAL :: wrf_dm_on_monitor
24	! L. Fita, LMD. May 2014
25	! Already defined as function by wrf_timeseries.F
26	INTEGER, EXTERNAL :: get_unused_unit
27
28	! Local variables
29	INTEGER :: nlidarloc_temp
30	INTEGER :: i, k, iunit
31	REAL :: lidar_rx, lidar_ry, lidar_xlat, lidar_xlong, lidar_hgt
32	REAL :: known_lat, known_lon
33	CHARACTER (LEN=132) :: message
34	TYPE (PROJ_INFO) :: lidar_proj
35	TYPE (grid_config_rec_type) :: config_flags
36
37	INTEGER :: ids, ide, jds, jde, kds, kde, &
38	ims, ime, jms, jme, kms, kme, &
39	ips, ipe, jps, jpe, kps, kpe, &
40	imsx, imex, jmsx, jmex, kmsx, kmex, &
41	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
42	imsy, imey, jmsy, jmey, kmsy, kmey, &
43	ipsy, ipey, jpsy, jpey, kpsy, kpey
44	CHARACTER (LEN=50) :: SimStartTime
45
46	IF ( grid%nlidarloc .LE. 0 ) RETURN
47
48	#if ((EM_CORE == 1) && (DA_CORE != 1))
49	IF ( grid%dfi_stage == DFI_FST ) THEN
50	#endif
51	CALL get_ijk_from_grid ( grid , &
52	ids, ide, jds, jde, kds, kde, &
53	ims, ime, jms, jme, kms, kme, &
54	ips, ipe, jps, jpe, kps, kpe, &
55	imsx, imex, jmsx, jmex, kmsx, kmex, &
56	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
57	imsy, imey, jmsy, jmey, kmsy, kmey, &
58	ipsy, ipey, jpsy, jpey, kpsy, kpey )
59
60	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
61
62	! Set up map transformation structure
63	CALL map_init(lidar_proj)
64
65	IF (ips <= 1 .AND. 1 <= ipe .AND. &
66	jps <= 1 .AND. 1 <= jpe) THEN
67	known_lat = grid%xlat(1,1)
68	known_lon = grid%xlong(1,1)
69	ELSE
70	known_lat = 9999.
71	known_lon = 9999.
72	END IF
73	known_lat = wrf_dm_min_real(known_lat)
74	known_lon = wrf_dm_min_real(known_lon)
75
76	! Mercator
77	IF (config_flags%map_proj == PROJ_MERC) THEN
78	CALL map_set(PROJ_MERC, lidar_proj, &
79	truelat1 = config_flags%truelat1, &
80	lat1 = known_lat, &
81	lon1 = known_lon, &
82	knowni = 1., &
83	knownj = 1., &
84	dx = config_flags%dx)
85
86	! Lambert conformal
87	ELSE IF (config_flags%map_proj == PROJ_LC) THEN
88	CALL map_set(PROJ_LC, lidar_proj, &
89	truelat1 = config_flags%truelat1, &
90	truelat2 = config_flags%truelat2, &
91	stdlon = config_flags%stand_lon, &
92	lat1 = known_lat, &
93	lon1 = known_lon, &
94	knowni = 1., &
95	knownj = 1., &
96	dx = config_flags%dx)
97
98	! Polar stereographic
99	ELSE IF (config_flags%map_proj == PROJ_PS) THEN
100	CALL map_set(PROJ_PS, lidar_proj, &
101	truelat1 = config_flags%truelat1, &
102	stdlon = config_flags%stand_lon, &
103	lat1 = known_lat, &
104	lon1 = known_lon, &
105	knowni = 1., &
106	knownj = 1., &
107	dx = config_flags%dx)
108
109	#if (EM_CORE == 1)
110	! Cassini (global ARW)
111	ELSE IF (config_flags%map_proj == PROJ_CASSINI) THEN
112	CALL map_set(PROJ_CASSINI, lidar_proj, &
113	latinc = grid%dy360.0/(2.0EARTH_RADIUS_M*PI), &
114	loninc = grid%dx360.0/(2.0EARTH_RADIUS_M*PI), &
115	lat1 = known_lat, &
116	lon1 = known_lon, &
117	lat0 = config_flags%pole_lat, &
118	lon0 = config_flags%pole_lon, &
119	knowni = 1., &
120	knownj = 1., &
121	stdlon = config_flags%stand_lon)
122	#endif
123
124	! Rotated latitude-longitude
125	ELSE IF (config_flags%map_proj == PROJ_ROTLL) THEN
126	CALL map_set(PROJ_ROTLL, lidar_proj, &
127	! I have no idea how this should work for NMM nested domains
128	ixdim = grid%e_we-1, &
129	jydim = grid%e_sn-1, &
130	phi = real(grid%e_sn-2)*grid%dy/2.0, &
131	lambda = real(grid%e_we-2)*grid%dx, &
132	lat1 = config_flags%cen_lat, &
133	lon1 = config_flags%cen_lon, &
134	latinc = grid%dy, &
135	loninc = grid%dx, &
136	stagger = HH)
137
138	END IF
139
140	! Determine lidar locations for domain
141	IF (.NOT. grid%have_calculated_lidarlocs) THEN
142	grid%have_calculated_lidarlocs = .TRUE.
143	WRITE(message, '(A43,I3)') 'Computing lidar locations for domain ', grid%id
144	CALL wrf_message(message)
145
146	nlidarloc_temp = 0
147	DO k=1,grid%nlidarloc
148
149	IF (config_flags%map_proj == 0) THEN ! For idealized cases, no map transformation needed
150	lidar_rx = grid%latlidarloc(k) ! NB: (x,y) = (lat,lon) rather than (x,y) = (lon,lat)
151	lidar_ry = grid%lonlidarloc(k)
152	ELSE
153	CALL latlon_to_ij(lidar_proj, grid%latlidarloc(k), grid%lonlidarloc(k), lidar_rx, lidar_ry)
154	END IF
155
156
157	nlidarloc_temp = nlidarloc_temp + 1
158	grid%ilidarloc(nlidarloc_temp) = NINT(lidar_rx)
159	grid%jlidarloc(nlidarloc_temp) = NINT(lidar_ry)
160	grid%id_lidarloc(nlidarloc_temp) = k
161
162	! Is point outside of domain (or on the edge of domain)?
163	IF (grid%ilidarloc(nlidarloc_temp) < ids .OR. grid%ilidarloc(nlidarloc_temp) > ide .OR. &
164	grid%jlidarloc(nlidarloc_temp) < jds .OR. grid%jlidarloc(nlidarloc_temp) > jde) THEN
165	nlidarloc_temp = nlidarloc_temp - 1
166
167	END IF
168
169	END DO
170
171	grid%next_lidar_time = 1
172
173	grid%nlidarloc_domain = nlidarloc_temp
174
175	DO k=1,grid%nlidarloc_domain
176
177	! If location is outside of patch, we need to get lat/lon of TS grid cell from another patch
178	IF (grid%ilidarloc(k) < ips .OR. grid%ilidarloc(k) > ipe .OR. &
179	grid%jlidarloc(k) < jps .OR. grid%jlidarloc(k) > jpe) THEN
180	lidar_xlat = 1.E30
181	lidar_xlong = 1.E30
182	lidar_hgt = 1.E30
183	ELSE
184	lidar_xlat = grid%xlat(grid%ilidarloc(k),grid%jlidarloc(k))
185	lidar_xlong = grid%xlong(grid%ilidarloc(k),grid%jlidarloc(k))
186	#if (EM_CORE == 1)
187	lidar_hgt = grid%ht(grid%ilidarloc(k),grid%jlidarloc(k))
188	#endif
189	END IF
190	#if DM_PARALLEL
191	lidar_xlat = wrf_dm_min_real(lidar_xlat)
192	lidar_xlong = wrf_dm_min_real(lidar_xlong)
193	lidar_hgt = wrf_dm_min_real(lidar_hgt)
194	#endif
195
196	IF ( wrf_dm_on_monitor() ) THEN
197
198	iunit = get_unused_unit()
199	IF ( iunit <= 0 ) THEN
200	CALL wrf_error_fatal('Error in calc_lidar_locations: could not find a free Fortran unit.')
201	END IF
202	CALL domain_clock_get(grid, simulationStartTimeStr = SimStartTime)
203
204	WRITE(grid%lidar_filename(k),'(A)') TRIM(grid%namelidarloc(grid%id_lidarloc(k)))//'.LIDAR.d00'
205	i = LEN_TRIM(grid%lidar_filename(k))
206	WRITE(grid%lidar_filename(k)(i-1:i),'(I2.2)') grid%id
207	OPEN(UNIT=iunit, FILE=TRIM(grid%lidar_filename(k)), FORM='FORMATTED', STATUS='REPLACE')
208	#if (EM_CORE == 1)
209	WRITE(UNIT=iunit, &
210	FMT='(A26,I2,I3,A6,A2,F7.3,A1,F8.3,A3,I4,A1,I4,A3,F7.3,A1,F8.3,A2,F6.1,A32,A19)') &
211	grid%desclidarloc(grid%id_lidarloc(k))//' ', grid%id, grid%id_lidarloc(k), &
212	' '//grid%namelidarloc(grid%id_lidarloc(k)), &
213	' (', grid%latlidarloc(grid%id_lidarloc(k)), ',', grid%lonlidarloc(grid%id_lidarloc(k)), ') (', &
214	grid%ilidarloc(k), ',', grid%jlidarloc(k), ') (', &
215	lidar_xlat, ',', lidar_xlong, ') ', &
216	lidar_hgt,' meters. simulation start time: ',TRIM(SimStartTime)
217	#else
218	WRITE(UNIT=iunit, &
219	FMT='(A26,I2,I3,A6,A2,F7.3,A1,F8.3,A3,I4,A1,I4,A3,F7.3,A1,F8.3,A2,F6.1,A32,A19)') &
220	grid%desclidarloc(grid%id_lidarloc(k))//' ', grid%id, grid%id_lidarloc(k), &
221	' '//grid%namelidarloc(grid%id_lidarloc(k)), &
222	' (', grid%latlidarloc(grid%id_lidarloc(k)), ',', grid%lonlidarloc(grid%id_lidarloc(k)), ') (', &
223	grid%ilidarloc(k), ',', grid%jlidarloc(k), ') (', &
224	lidar_xlat, ',', lidar_xlong, ') ', &
225	lidar_hgt,' meters. simulation start time: ',TRIM(SimStartTime)
226	#endif
227	CLOSE(UNIT=iunit)
228	END IF
229	END DO
230
231	END IF
232	#if ((EM_CORE == 1) && (DA_CORE != 1))
233	END IF
234	#endif
235
236	END SUBROUTINE calc_lidar_locations
237
238
239	SUBROUTINE calc_lidar( grid )
240
241	USE module_domain
242	USE module_model_constants
243
244	IMPLICIT NONE
245
246	! Arguments
247	TYPE (domain), INTENT(INOUT) :: grid
248
249	LOGICAL, EXTERNAL :: wrf_dm_on_monitor
250
251	! Local variables
252	INTEGER :: i, k, mm, n, ix, iy, rc
253	REAL :: xtime_minutes
254	REAL, ALLOCATABLE, DIMENSION(:) :: earth_u, earth_v, &
255	output_t, output_qv, output_qc, output_qr, output_qs, output_qh, output_qi, &
256	output_qg
257	REAL, ALLOCATABLE, DIMENSION(:) :: p8w
258
259	! Parameter lidar_model_level:
260	! TRUE to output T, Q, and wind at lowest model level
261	! FALSE to output T and Q at 2-m and wind at 10-m diagnostic levels:
262	LOGICAL, PARAMETER :: lidar_model_level = .FALSE.
263
264	IF ( grid%nlidarloc_domain .LE. 0 ) RETURN
265
266	#if ((EM_CORE == 1) && (DA_CORE != 1))
267	IF ( grid%dfi_opt /= DFI_NODFI .AND. grid%dfi_stage /= DFI_FST ) RETURN
268	#endif
269
270	n = grid%next_lidar_time
271
272	ALLOCATE(p8w(grid%sm32:grid%em32))
273	ALLOCATE(earth_u(grid%sm32:grid%em32))
274	ALLOCATE(earth_v(grid%sm32:grid%em32))
275	ALLOCATE(output_t(grid%sm32:grid%em32))
276	ALLOCATE(output_qv(grid%sm32:grid%em32))
277	ALLOCATE(output_qc(grid%sm32:grid%em32))
278	ALLOCATE(output_qr(grid%sm32:grid%em32))
279	ALLOCATE(output_qs(grid%sm32:grid%em32))
280	ALLOCATE(output_qh(grid%sm32:grid%em32))
281	ALLOCATE(output_qi(grid%sm32:grid%em32))
282	ALLOCATE(output_qg(grid%sm32:grid%em32))
283
284	DO i=1,grid%nlidarloc_domain
285
286	ix = grid%ilidarloc(i)
287	iy = grid%jlidarloc(i)
288
289	IF (grid%sp31 <= ix .AND. ix <= grid%ep31 .AND. &
290	grid%sp33 <= iy .AND. iy <= grid%ep33) THEN
291	DO k=grid%sm32, grid%em32-1
292	!
293	! Output from the lowest model computational level:
294	!
295	#if (EM_CORE == 1)
296	earth_u(k) = grid%u_2(ix,k,iy)grid%cosa(ix,iy)-grid%v_2(ix,k,iy)grid%sina(ix,iy)
297	earth_v(k) = grid%v_2(ix,k,iy)grid%cosa(ix,iy)+grid%u_2(ix,k,iy)grid%sina(ix,iy)
298	output_t(k) = grid%t_2(ix,k,iy) + 300.
299	#else
300	earth_u(k) = grid%u_2(ix,k,iy)grid%cosa(ix,iy)-grid%v_2(ix,k,iy)grid%sina(ix,iy)
301	earth_v(k) = grid%v_2(ix,k,iy)grid%cosa(ix,iy)+grid%u_2(ix,k,iy)grid%sina(ix,iy)
302	output_t(k) = grid%t(ix,k,iy) + 300.
303	#endif
304	output_qv(k) = grid%moist(ix,k,iy,P_QV)
305	output_qc(k) = grid%moist(ix,k,iy,P_QC)
306	output_qr(k) = grid%moist(ix,k,iy,P_QR)
307	output_qs(k) = grid%moist(ix,k,iy,P_QS)
308	output_qh(k) = grid%moist(ix,k,iy,P_QH)
309	output_qi(k) = grid%moist(ix,k,iy,P_QI)
310	output_qg(k) = grid%moist(ix,k,iy,P_QG)
311	END DO
312
313
314	CALL domain_clock_get( grid, minutesSinceSimulationStart=xtime_minutes )
315	grid%lidar_hour(n,i) = xtime_minutes / 60.
316	grid%lidar_z(n,:,i) = ( grid%ph_2(ix,:,iy) + grid%phb(ix,:,iy) ) / g
317	grid%lidar_p(n,:,i) = grid%p(ix,:,iy) + grid%pb(ix,:,iy) * 0.01
318	grid%lidar_u(n,:,i) = earth_u
319	grid%lidar_v(n,:,i) = earth_v
320	grid%lidar_w(n,:,i) = grid%w_2(ix,:,iy)
321	grid%lidar_t(n,:,i) = output_t
322	grid%lidar_qv(n,:,i) = output_qv
323	grid%lidar_qc(n,:,i) = output_qc
324	grid%lidar_qr(n,:,i) = output_qr
325	grid%lidar_qs(n,:,i) = output_qs
326	grid%lidar_qh(n,:,i) = output_qh
327	grid%lidar_qi(n,:,i) = output_qi
328	grid%lidar_qg(n,:,i) = output_qg
329	grid%lidar_dens(n,:,i) = 1./grid%alt(ix,:,iy)
330	grid%lidar_cldfra(n,:,i) = grid%cldfra(ix,:,iy)
331	grid%lidar_drydens(n,i) = grid%mu_2(ix,iy) + grid%mub(ix,iy) * 0.01
332	grid%lidar_psfc(n,i) = grid%psfc(ix,iy)
333	#if (EM_CORE == 1)
334	grid%lidar_rainc(n,i) = grid%rainc(ix,iy)
335	grid%lidar_rainnc(n,i) = grid%rainnc(ix,iy)
336	#endif
337	ELSE
338	grid%lidar_hour(n,i) = 1.E30
339	grid%lidar_u(n,:,i) = 1.E30
340	grid%lidar_v(n,:,i) = 1.E30
341	grid%lidar_w(n,:,i) = 1.E30
342	grid%lidar_t(n,:,i) = 1.E30
343	grid%lidar_qv(n,:,i) = 1.E30
344	grid%lidar_qc(n,:,i) = 1.E30
345	grid%lidar_qr(n,:,i) = 1.E30
346	grid%lidar_qs(n,:,i) = 1.E30
347	grid%lidar_qh(n,:,i) = 1.E30
348	grid%lidar_qi(n,:,i) = 1.E30
349	grid%lidar_qg(n,:,i) = 1.E30
350	grid%lidar_dens(n,:,i) = 1.E30
351	grid%lidar_cldfra(n,:,i) = 1.E30
352	grid%lidar_psfc(n,i) = 1.E30
353	#if (EM_CORE == 1)
354	grid%lidar_rainc(n,i) = 1.E30
355	grid%lidar_rainnc(n,i) = 1.E30
356	#endif
357
358	END IF
359	END DO
360
361	DEALLOCATE(p8w)
362
363	grid%next_lidar_time = grid%next_lidar_time + 1
364
365	IF ( grid%next_lidar_time > grid%lidar_buf_size ) CALL write_lidar(grid)
366
367	END SUBROUTINE calc_lidar
368
369
370	SUBROUTINE write_lidar( grid )
371
372	USE module_domain, ONLY : domain
373	USE module_dm, ONLY : wrf_dm_min_reals
374	USE module_state_description
375
376	IMPLICIT NONE
377
378	! Arguments
379	TYPE (domain), INTENT(INOUT) :: grid
380
381	LOGICAL, EXTERNAL :: wrf_dm_on_monitor
382	! L. Fita, LMD. May 2014
383	! Already defined as function by wrf_timeseries.F
384	INTEGER, EXTERNAL :: get_unused_unit
385
386	! Local variables
387	INTEGER :: i, n, k, ix, iy, iunit
388	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: lidar_buf
389
390	IF ( grid%nlidarloc_domain .LE. 0 ) RETURN
391
392	#if ((EM_CORE == 1) && (DA_CORE != 1))
393	IF ( grid%dfi_opt /= DFI_NODFI .AND. grid%dfi_stage /= DFI_FST ) RETURN
394	#endif
395
396	#ifdef DM_PARALLEL
397	ALLOCATE(lidar_buf(grid%lidar_buf_size,grid%sm32:grid%em32,grid%max_lidar_locs))
398
399	lidar_buf(:,1,:) = grid%lidar_hour(:,:)
400	CALL wrf_dm_min_reals(lidar_buf(:,1,:),grid%lidar_hour(:,:),grid%lidar_buf_size*grid%max_lidar_locs)
401
402	lidar_buf(:,:,:) = grid%lidar_z(:,:,:)
403	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_z(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
404
405	lidar_buf(:,:,:) = grid%lidar_p(:,:,:)
406	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_p(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
407
408	lidar_buf(:,:,:) = grid%lidar_u(:,:,:)
409	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_u(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
410
411	lidar_buf(:,:,:) = grid%lidar_v(:,:,:)
412	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_v(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
413
414	lidar_buf(:,:,:) = grid%lidar_w(:,:,:)
415	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_w(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
416
417	lidar_buf(:,:,:) = grid%lidar_t(:,:,:)
418	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_t(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
419
420	lidar_buf(:,:,:) = grid%lidar_qv(:,:,:)
421	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qv(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
422
423	lidar_buf(:,:,:) = grid%lidar_qc(:,:,:)
424	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qc(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
425
426	lidar_buf(:,:,:) = grid%lidar_qr(:,:,:)
427	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qr(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
428
429	lidar_buf(:,:,:) = grid%lidar_qs(:,:,:)
430	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qs(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
431
432	lidar_buf(:,:,:) = grid%lidar_qh(:,:,:)
433	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qh(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
434
435	lidar_buf(:,:,:) = grid%lidar_qi(:,:,:)
436	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qi(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
437
438	lidar_buf(:,:,:) = grid%lidar_qg(:,:,:)
439	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_qg(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
440
441	lidar_buf(:,:,:) = grid%lidar_dens(:,:,:)
442	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_dens(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
443
444	lidar_buf(:,:,:) = grid%lidar_cldfra(:,:,:)
445	CALL wrf_dm_min_reals(lidar_buf(:,:,:),grid%lidar_cldfra(:,:,:),grid%lidar_buf_size*grid%max_lidar_locs)
446
447	lidar_buf(:,1,:) = grid%lidar_drydens(:,:)
448	CALL wrf_dm_min_reals(lidar_buf(:,1,:),grid%lidar_drydens(:,:),grid%lidar_buf_size*grid%max_lidar_locs)
449
450	lidar_buf(:,1,:) = grid%lidar_psfc(:,:)
451	CALL wrf_dm_min_reals(lidar_buf(:,1,:),grid%lidar_psfc(:,:),grid%lidar_buf_size*grid%max_lidar_locs)
452
453	#if (EM_CORE == 1)
454	lidar_buf(:,1,:) = grid%lidar_rainc(:,:)
455	CALL wrf_dm_min_reals(lidar_buf(:,1,:),grid%lidar_rainc(:,:),grid%lidar_buf_size*grid%max_lidar_locs)
456
457	lidar_buf(:,1,:) = grid%lidar_rainnc(:,:)
458	CALL wrf_dm_min_reals(lidar_buf(:,1,:),grid%lidar_rainnc(:,:),grid%lidar_buf_size*grid%max_lidar_locs)
459	#endif
460
461	DEALLOCATE(lidar_buf)
462	#endif
463
464	IF ( wrf_dm_on_monitor() ) THEN
465
466	iunit = get_unused_unit()
467	IF ( iunit <= 0 ) THEN
468	CALL wrf_error_fatal('Error in write_lidar: could not find a free Fortran unit.')
469	END IF
470
471	DO i=1,grid%nlidarloc_domain
472
473	ix = grid%ilidarloc(i)
474	iy = grid%jlidarloc(i)
475
476	OPEN(UNIT=iunit, FILE=TRIM(grid%lidar_filename(i)), STATUS='unknown', POSITION='append', FORM='formatted')
477
478	DO n=1,grid%next_lidar_time - 1
479	#if (EM_CORE == 1)
480	WRITE(UNIT=iunit,FMT='(a8,1x,i2,f13.6,i5,i5,i5,1x,4(e13.5,1x))') &
481	'new_time',grid%id, grid%lidar_hour(n,i), &
482	grid%id_lidarloc(i), ix, iy, &
483	grid%lidar_psfc(n,i), &
484	grid%lidar_rainc(n,i), &
485	grid%lidar_rainnc(n,i), &
486	grid%lidar_drydens(n,i)
487	#else
488	WRITE(UNIT=iunit,FMT='(a8,1x,i2,f13.6,i5,i5,i5,1x,2(e13.5,1x))') &
489	'new_time',grid%id, grid%lidar_hour(n,i), &
490	grid%id_lidarloc(i), ix, iy, &
491	grid%lidar_psfc(n,i), &
492	grid%lidar_drydens(n,i)
493	#endif
494	WRITE(UNIT=iunit, FMT='(5x,a3,1x,15(a13,1x),a10)') 'k', 'z [m]', 'p [hPa]', &
495	'u [ms-1]', 'v [ms-1]', 'w [ms-1]', 't_pot [k]', 'qv [kgkg-1]', &
496	'qc [kgkg-1]', 'qr [kgkg-1]', 'qs [kgkg-1]', 'qh [kgkg-1]', 'qi [kgkg-1]', &
497	'qg [kgkg-1]', 'dens [kg m-3]', 'cldfra [1]', '__________'
498	DO k=grid%sm32,grid%em32-1
499	WRITE(UNIT=iunit,FMT='(5x,i3,1x,15(e13.5,1x))') k, &
500	grid%lidar_z(n,k,i), &
501	grid%lidar_p(n,k,i), &
502	grid%lidar_u(n,k,i), &
503	grid%lidar_v(n,k,i), &
504	grid%lidar_w(n,k,i), &
505	grid%lidar_t(n,k,i), &
506	grid%lidar_qv(n,k,i), &
507	grid%lidar_qc(n,k,i), &
508	grid%lidar_qr(n,k,i), &
509	grid%lidar_qs(n,k,i), &
510	grid%lidar_qh(n,k,i), &
511	grid%lidar_qi(n,k,i), &
512	grid%lidar_qg(n,k,i), &
513	grid%lidar_dens(n,k,i), &
514	grid%lidar_cldfra(n,k,i)
515	END DO
516	END DO
517
518	CLOSE(UNIT=iunit)
519
520	END DO
521
522	END IF
523
524	grid%next_lidar_time = 1
525
526	END SUBROUTINE write_lidar
527
528	! L. Fita, LMD. May 2014
529	! Already defined as function by wrf_timeseries.F
530	! No SUBROUTINE calc_p8w(grid, ix, iy, p8w, k_start, k_end)

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

Download in other formats:

Original Format