Home

Context Navigation

source: palm/trunk/SOURCE/gust_mod.f90 @ 2964

Last change on this file since 2964 was 2932, checked in by maronga, 7 years ago
renamed all Fortran NAMELISTS
File size: 16.1 KB

Line
1	!> @file gust_mod.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of PALM.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id$
27	! renamed gust_par to gust_parameters
28	!
29	!
30	! Initial interface definition
31	!
32	!
33	! Description:
34	! ------------
35	!> Gust model.
36	!>
37	!> @todo This is just a dummy module. The actual module ist not released yet.
38	!------------------------------------------------------------------------------!
39	MODULE gust_mod
40
41	USE indices, &
42	ONLY: nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt
43
44	USE kinds
45
46	IMPLICIT NONE
47
48	LOGICAL :: gust_module_enabled = .FALSE. !< switch, if the entire module is used at all
49
50	SAVE
51
52	PRIVATE
53
54	!
55	!-- Public functions
56	PUBLIC &
57	gust_parin, &
58	gust_check_parameters, &
59	gust_check_data_output_pr, &
60	gust_check_data_output, &
61	gust_init_arrays, &
62	gust_init, &
63	gust_define_netcdf_grid, &
64	gust_header, &
65	gust_actions, &
66	gust_swap_timelevel, &
67	gust_3d_data_averaging, &
68	gust_data_output_2d, &
69	gust_data_output_3d, &
70	gust_statistics, &
71	gust_rrd_global, &
72	gust_wrd_global, &
73	gust_rrd_local, &
74	gust_wrd_local
75	!
76	!-- Public parameters, constants and initial values
77	PUBLIC &
78	gust_module_enabled
79
80
81	INTERFACE gust_parin
82	MODULE PROCEDURE gust_parin
83	END INTERFACE gust_parin
84
85	INTERFACE gust_check_parameters
86	MODULE PROCEDURE gust_check_parameters
87	END INTERFACE gust_check_parameters
88
89	INTERFACE gust_check_data_output_pr
90	MODULE PROCEDURE gust_check_data_output_pr
91	END INTERFACE gust_check_data_output_pr
92
93	INTERFACE gust_check_data_output
94	MODULE PROCEDURE gust_check_data_output
95	END INTERFACE gust_check_data_output
96
97	INTERFACE gust_init_arrays
98	MODULE PROCEDURE gust_init_arrays
99	END INTERFACE gust_init_arrays
100
101	INTERFACE gust_init
102	MODULE PROCEDURE gust_init
103	END INTERFACE gust_init
104
105	INTERFACE gust_define_netcdf_grid
106	MODULE PROCEDURE gust_define_netcdf_grid
107	END INTERFACE gust_define_netcdf_grid
108
109	INTERFACE gust_header
110	MODULE PROCEDURE gust_header
111	END INTERFACE gust_header
112
113	INTERFACE gust_actions
114	MODULE PROCEDURE gust_actions
115	MODULE PROCEDURE gust_actions_ij
116	END INTERFACE gust_actions
117
118	INTERFACE gust_swap_timelevel
119	MODULE PROCEDURE gust_swap_timelevel
120	END INTERFACE gust_swap_timelevel
121
122	INTERFACE gust_3d_data_averaging
123	MODULE PROCEDURE gust_3d_data_averaging
124	END INTERFACE gust_3d_data_averaging
125
126	INTERFACE gust_data_output_2d
127	MODULE PROCEDURE gust_data_output_2d
128	END INTERFACE gust_data_output_2d
129
130	INTERFACE gust_data_output_3d
131	MODULE PROCEDURE gust_data_output_3d
132	END INTERFACE gust_data_output_3d
133
134	INTERFACE gust_statistics
135	MODULE PROCEDURE gust_statistics
136	END INTERFACE gust_statistics
137
138	INTERFACE gust_rrd_global
139	MODULE PROCEDURE gust_rrd_global
140	END INTERFACE gust_rrd_global
141
142	INTERFACE gust_wrd_global
143	MODULE PROCEDURE gust_wrd_global
144	END INTERFACE gust_wrd_global
145
146	INTERFACE gust_rrd_local
147	MODULE PROCEDURE gust_rrd_local
148	END INTERFACE gust_rrd_local
149
150	INTERFACE gust_wrd_local
151	MODULE PROCEDURE gust_wrd_local
152	END INTERFACE gust_wrd_local
153
154	CONTAINS
155
156
157	!------------------------------------------------------------------------------!
158	! Description:
159	! ------------
160	!> Parin for &gust_parameters for gust module
161	!------------------------------------------------------------------------------!
162	SUBROUTINE gust_parin
163
164
165	IMPLICIT NONE
166
167	CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file
168
169	NAMELIST /gust_parameters/ &
170	gust_module_enabled
171
172	line = ' '
173	!
174	!-- Try to find gust module package
175	REWIND ( 11 )
176	line = ' '
177	DO WHILE ( INDEX( line, '&gust_parameters' ) == 0 )
178	READ ( 11, '(A)', END=10 ) line
179	ENDDO
180	BACKSPACE ( 11 )
181	!
182	!-- Read user-defined namelist
183	READ ( 11, gust_parameters )
184	!
185	!-- Set flag that indicates that the gust module is switched on
186	gust_module_enabled = .TRUE.
187
188	10 CONTINUE
189
190
191	END SUBROUTINE gust_parin
192
193
194	!------------------------------------------------------------------------------!
195	! Description:
196	! ------------
197	!> Check parameters routine for gust module
198	!------------------------------------------------------------------------------!
199	SUBROUTINE gust_check_parameters
200
201
202	IMPLICIT NONE
203
204
205	END SUBROUTINE gust_check_parameters
206
207
208	!------------------------------------------------------------------------------!
209	! Description:
210	! ------------
211	!> Check data output of profiles for gust module
212	!------------------------------------------------------------------------------!
213	SUBROUTINE gust_check_data_output_pr( variable, var_count, unit, dopr_unit )
214
215
216	IMPLICIT NONE
217
218	CHARACTER (LEN=*) :: unit !<
219	CHARACTER (LEN=*) :: variable !<
220	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
221
222	INTEGER(iwp) :: var_count !<
223
224
225	END SUBROUTINE gust_check_data_output_pr
226
227	!------------------------------------------------------------------------------!
228	! Description:
229	! ------------
230	!> Check data output for gust module
231	!------------------------------------------------------------------------------!
232	SUBROUTINE gust_check_data_output( var, unit )
233
234
235	IMPLICIT NONE
236
237	CHARACTER (LEN=*) :: unit !<
238	CHARACTER (LEN=*) :: var !<
239
240
241	END SUBROUTINE gust_check_data_output
242
243
244	!------------------------------------------------------------------------------!
245	! Description:
246	! ------------
247	!> Allocate gust module arrays and define pointers
248	!------------------------------------------------------------------------------!
249	SUBROUTINE gust_init_arrays
250
251
252	IMPLICIT NONE
253
254
255	END SUBROUTINE gust_init_arrays
256
257
258	!------------------------------------------------------------------------------!
259	! Description:
260	! ------------
261	!> Initialization of the gust module
262	!------------------------------------------------------------------------------!
263	SUBROUTINE gust_init( dots_label, dots_unit, dots_num, dots_max )
264
265
266	IMPLICIT NONE
267
268	INTEGER(iwp) :: dots_num
269	INTEGER(iwp) :: dots_max
270	CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit
271	CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label
272
273
274	END SUBROUTINE gust_init
275
276
277	!------------------------------------------------------------------------------!
278	!
279	! Description:
280	! ------------
281	!> Subroutine defining appropriate grid for netcdf variables.
282	!> It is called out from subroutine netcdf.
283	!------------------------------------------------------------------------------!
284	SUBROUTINE gust_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
285
286
287	IMPLICIT NONE
288
289	CHARACTER (LEN=*), INTENT(IN) :: var !<
290	LOGICAL, INTENT(IN) :: found !<
291	CHARACTER (LEN=*), INTENT(IN) :: grid_x !<
292	CHARACTER (LEN=*), INTENT(IN) :: grid_y !<
293	CHARACTER (LEN=*), INTENT(IN) :: grid_z !<
294
295
296	END SUBROUTINE gust_define_netcdf_grid
297
298
299	!------------------------------------------------------------------------------!
300	! Description:
301	! ------------
302	!> Header output for gust module
303	!------------------------------------------------------------------------------!
304	SUBROUTINE gust_header ( io )
305
306
307	IMPLICIT NONE
308
309	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
310
311
312	END SUBROUTINE gust_header
313
314
315	!------------------------------------------------------------------------------!
316	! Description:
317	! ------------
318	!> Call for all grid points
319	!------------------------------------------------------------------------------!
320	SUBROUTINE gust_actions( location )
321
322
323	IMPLICIT NONE
324
325	CHARACTER (LEN=*) :: location !<
326
327
328	END SUBROUTINE gust_actions
329
330
331	!------------------------------------------------------------------------------!
332	! Description:
333	! ------------
334	!> Call for grid point i,j
335	!------------------------------------------------------------------------------!
336	SUBROUTINE gust_actions_ij( i, j, location )
337
338
339	IMPLICIT NONE
340
341	CHARACTER (LEN=*) :: location
342
343	INTEGER(iwp) :: i
344	INTEGER(iwp) :: j
345
346
347	END SUBROUTINE gust_actions_ij
348
349
350	!------------------------------------------------------------------------------!
351	! Description:
352	! ------------
353	!> Swapping of timelevels
354	!------------------------------------------------------------------------------!
355	SUBROUTINE gust_swap_timelevel ( mod_count )
356
357
358	IMPLICIT NONE
359
360	INTEGER, INTENT(IN) :: mod_count
361
362
363	END SUBROUTINE gust_swap_timelevel
364
365
366	!------------------------------------------------------------------------------!
367	!
368	! Description:
369	! ------------
370	!> Subroutine for averaging 3D data
371	!------------------------------------------------------------------------------!
372	SUBROUTINE gust_3d_data_averaging( mode, variable )
373
374
375	IMPLICIT NONE
376
377	CHARACTER (LEN=*) :: mode !<
378	CHARACTER (LEN=*) :: variable !<
379
380
381	END SUBROUTINE gust_3d_data_averaging
382
383	!------------------------------------------------------------------------------!
384	!
385	! Description:
386	! ------------
387	!> Subroutine defining 2D output variables
388	!------------------------------------------------------------------------------!
389	SUBROUTINE gust_data_output_2d( av, variable, found, grid, local_pf, &
390	two_d, nzb_do, nzt_do )
391
392
393	IMPLICIT NONE
394
395	CHARACTER (LEN=*) :: grid !<
396	CHARACTER (LEN=*) :: variable !<
397
398	INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data
399	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
400	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
401
402	LOGICAL :: found !<
403	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
404
405	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !<
406
407
408	END SUBROUTINE gust_data_output_2d
409
410
411	!------------------------------------------------------------------------------!
412	!
413	! Description:
414	! ------------
415	!> Subroutine defining 3D output variables
416	!------------------------------------------------------------------------------!
417	SUBROUTINE gust_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
418
419
420	IMPLICIT NONE
421
422	CHARACTER (LEN=*) :: variable !<
423
424	INTEGER(iwp) :: av !<
425	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
426	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
427
428	LOGICAL :: found !<
429
430	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
431
432
433	END SUBROUTINE gust_data_output_3d
434
435
436	!------------------------------------------------------------------------------!
437	! Description:
438	! ------------
439	!> This routine computes profile and timeseries data for the gust module.
440	!------------------------------------------------------------------------------!
441	SUBROUTINE gust_statistics( mode, sr, tn, dots_max )
442
443
444	IMPLICIT NONE
445
446	CHARACTER (LEN=*) :: mode !<
447
448	INTEGER(iwp) :: sr !<
449	INTEGER(iwp) :: tn !<
450	INTEGER(iwp) :: dots_max !<
451
452
453	END SUBROUTINE gust_statistics
454
455
456	!------------------------------------------------------------------------------!
457	! Description:
458	! ------------
459	!> This routine reads the respective restart data for the gust module.
460	!------------------------------------------------------------------------------!
461	SUBROUTINE gust_rrd_global( found )
462
463
464	USE control_parameters, &
465	ONLY: length, restart_string
466
467
468	IMPLICIT NONE
469
470	LOGICAL, INTENT(OUT) :: found
471
472
473	found = .TRUE.
474
475
476	SELECT CASE ( restart_string(1:length) )
477
478	CASE ( 'global_paramter' )
479	! READ ( 13 ) global_parameter
480
481	CASE DEFAULT
482
483	found = .FALSE.
484
485	END SELECT
486
487
488	END SUBROUTINE gust_rrd_global
489
490
491	!------------------------------------------------------------------------------!
492	! Description:
493	! ------------
494	!> This routine reads the respective restart data for the gust module.
495	!------------------------------------------------------------------------------!
496	SUBROUTINE gust_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
497	nxr_on_file, nynf, nync, nyn_on_file, nysf, &
498	nysc, nys_on_file, tmp_2d, tmp_3d, found )
499
500
501	USE control_parameters
502
503	USE indices
504
505	USE kinds
506
507	USE pegrid
508
509
510	IMPLICIT NONE
511
512	INTEGER(iwp) :: i !<
513	INTEGER(iwp) :: k !<
514	INTEGER(iwp) :: nxlc !<
515	INTEGER(iwp) :: nxlf !<
516	INTEGER(iwp) :: nxl_on_file !<
517	INTEGER(iwp) :: nxrc !<
518	INTEGER(iwp) :: nxrf !<
519	INTEGER(iwp) :: nxr_on_file !<
520	INTEGER(iwp) :: nync !<
521	INTEGER(iwp) :: nynf !<
522	INTEGER(iwp) :: nyn_on_file !<
523	INTEGER(iwp) :: nysc !<
524	INTEGER(iwp) :: nysf !<
525	INTEGER(iwp) :: nys_on_file !<
526
527	LOGICAL, INTENT(OUT) :: found
528
529	REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !<
530	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
531
532	!
533	!-- Here the reading of user-defined restart data follows:
534	!-- Sample for user-defined output
535
536
537	found = .TRUE.
538
539
540	SELECT CASE ( restart_string(1:length) )
541
542	CASE ( 'u2_av' )
543	! IF ( .NOT. ALLOCATED( u2_av ) ) THEN
544	! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
545	! ENDIF
546	! IF ( k == 1 ) READ ( 13 ) tmp_3d
547	! u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
548	! tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
549	!
550	CASE DEFAULT
551
552	found = .FALSE.
553
554	END SELECT
555
556
557	END SUBROUTINE gust_rrd_local
558
559
560	!------------------------------------------------------------------------------!
561	! Description:
562	! ------------
563	!> This routine writes the respective restart data for the gust module.
564	!------------------------------------------------------------------------------!
565	SUBROUTINE gust_wrd_global
566
567
568	IMPLICIT NONE
569
570	! needs preceeding allocation if array
571	! CALL wrd_write_string( 'global_parameter' )
572	! WRITE ( 14 ) global_parameter
573
574	! IF ( ALLOCATED( inflow_damping_factor ) ) THEN
575	! CALL wrd_write_string( 'inflow_damping_factor' )
576	! WRITE ( 14 ) inflow_damping_factor
577	! ENDIF
578
579
580	END SUBROUTINE gust_wrd_global
581
582
583	!------------------------------------------------------------------------------!
584	! Description:
585	! ------------
586	!> This routine writes the respective restart data for the gust module.
587	!------------------------------------------------------------------------------!
588	SUBROUTINE gust_wrd_local
589
590
591	IMPLICIT NONE
592
593
594	! needs preceeding allocation because sould be array
595	! IF ( ALLOCATED( u2_av ) ) THEN
596	! CALL wrd_write_string( 'u2_av' )
597	! WRITE ( 14 ) u2_av
598	! ENDIF
599
600
601	END SUBROUTINE gust_wrd_local
602
603
604
605	END MODULE gust_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |