Home

Context Navigation

source: palm/trunk/SOURCE/user_module.f90 @ 4347

Last change on this file since 4347 was 4346, checked in by motisi, 5 years ago
Introduction of wall_flags_total_0, which currently sets bits based on static topography information used in wall_flags_static_0
Property svn:keywords set to `Id`
File size: 37.6 KB

Line
1	!> @file user_module.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
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-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: user_module.f90 4346 2019-12-18 11:55:56Z suehring $
27	! Introduction of wall_flags_total_0, which currently sets bits based on static
28	! topography information used in wall_flags_static_0
29	!
30	! 4329 2019-12-10 15:46:36Z motisi
31	! Renamed wall_flags_0 to wall_flags_static_0
32	!
33	! 4287 2019-11-01 14:50:20Z raasch
34	! reading of namelist file and actions in case of namelist errors revised so that statement labels
35	! and goto statements are not required any more; this revision also removes a previous bug
36	! which appeared when the namelist has been commented out in the namelist file
37	!
38	! 4182 2019-08-22 15:20:23Z scharf
39	! Corrected "Former revisions" section
40	!
41	! 3986 2019-05-20 14:08:14Z Giersch
42	! Redundant integration of control parameters in user_rrd_global removed
43	!
44	! 3911 2019-04-17 12:26:19Z knoop
45	! Bugfix: added before_prognostic_equations case in user_actions
46	!
47	! 3768 2019-02-27 14:35:58Z raasch
48	! variables commented + statements added to avoid compiler warnings about unused variables
49	!
50	! 3767 2019-02-27 08:18:02Z raasch
51	! unused variable for file index removed from rrd-subroutines parameter list
52	!
53	! 3747 2019-02-16 15:15:23Z gronemeier
54	! Add routine user_init_arrays
55	!
56	! 3703 2019-01-29 16:43:53Z knoop
57	! An example for a user defined global variable has been added (Giersch)
58	!
59	! Revision 1.1 1998/03/24 15:29:04 raasch
60	! Initial revision
61	!
62	!
63	! Description:
64	! ------------
65	!> Declaration of user-defined variables. This module may only be used
66	!> in the user-defined routines (contained in user_interface.f90).
67	!------------------------------------------------------------------------------!
68	MODULE user
69
70
71	USE arrays_3d
72
73	USE control_parameters
74
75	USE cpulog
76
77	USE indices
78
79	USE kinds
80
81	USE pegrid
82
83	USE statistics
84
85	USE surface_mod
86
87	IMPLICIT NONE
88
89	INTEGER(iwp) :: dots_num_palm !<
90	INTEGER(iwp) :: dots_num_user = 0 !<
91	INTEGER(iwp) :: user_idummy !<
92
93	LOGICAL :: user_module_enabled = .FALSE. !<
94
95	REAL(wp) :: user_rdummy !<
96
97	!
98	!-- Sample for user-defined output
99	! REAL(wp) :: global_parameter !< user defined global parameter
100	!
101	! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: u2 !< user defined array
102	! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: u2_av !< user defined array
103	! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ustvst !< user defined array
104
105	SAVE
106
107	PRIVATE
108
109	!
110	!- Public functions
111	PUBLIC &
112	user_parin, &
113	user_check_parameters, &
114	user_check_data_output_ts, &
115	user_check_data_output_pr, &
116	user_check_data_output, &
117	user_define_netcdf_grid, &
118	user_init, &
119	user_init_arrays, &
120	user_header, &
121	user_actions, &
122	user_3d_data_averaging, &
123	user_data_output_2d, &
124	user_data_output_3d, &
125	user_statistics, &
126	user_rrd_global, &
127	user_rrd_local, &
128	user_wrd_global, &
129	user_wrd_local, &
130	user_last_actions
131
132	!
133	!- Public parameters, constants and initial values
134	PUBLIC &
135	user_module_enabled
136
137	INTERFACE user_parin
138	MODULE PROCEDURE user_parin
139	END INTERFACE user_parin
140
141	INTERFACE user_check_parameters
142	MODULE PROCEDURE user_check_parameters
143	END INTERFACE user_check_parameters
144
145	INTERFACE user_check_data_output_ts
146	MODULE PROCEDURE user_check_data_output_ts
147	END INTERFACE user_check_data_output_ts
148
149	INTERFACE user_check_data_output_pr
150	MODULE PROCEDURE user_check_data_output_pr
151	END INTERFACE user_check_data_output_pr
152
153	INTERFACE user_check_data_output
154	MODULE PROCEDURE user_check_data_output
155	END INTERFACE user_check_data_output
156
157	INTERFACE user_define_netcdf_grid
158	MODULE PROCEDURE user_define_netcdf_grid
159	END INTERFACE user_define_netcdf_grid
160
161	INTERFACE user_init
162	MODULE PROCEDURE user_init
163	END INTERFACE user_init
164
165	INTERFACE user_init_arrays
166	MODULE PROCEDURE user_init_arrays
167	END INTERFACE user_init_arrays
168
169	INTERFACE user_header
170	MODULE PROCEDURE user_header
171	END INTERFACE user_header
172
173	INTERFACE user_actions
174	MODULE PROCEDURE user_actions
175	MODULE PROCEDURE user_actions_ij
176	END INTERFACE user_actions
177
178	INTERFACE user_3d_data_averaging
179	MODULE PROCEDURE user_3d_data_averaging
180	END INTERFACE user_3d_data_averaging
181
182	INTERFACE user_data_output_2d
183	MODULE PROCEDURE user_data_output_2d
184	END INTERFACE user_data_output_2d
185
186	INTERFACE user_data_output_3d
187	MODULE PROCEDURE user_data_output_3d
188	END INTERFACE user_data_output_3d
189
190	INTERFACE user_statistics
191	MODULE PROCEDURE user_statistics
192	END INTERFACE user_statistics
193
194	INTERFACE user_rrd_global
195	MODULE PROCEDURE user_rrd_global
196	END INTERFACE user_rrd_global
197
198	INTERFACE user_rrd_local
199	MODULE PROCEDURE user_rrd_local
200	END INTERFACE user_rrd_local
201
202	INTERFACE user_wrd_global
203	MODULE PROCEDURE user_wrd_global
204	END INTERFACE user_wrd_global
205
206	INTERFACE user_wrd_local
207	MODULE PROCEDURE user_wrd_local
208	END INTERFACE user_wrd_local
209
210	INTERFACE user_last_actions
211	MODULE PROCEDURE user_last_actions
212	END INTERFACE user_last_actions
213
214
215	CONTAINS
216
217
218	!------------------------------------------------------------------------------!
219	! Description:
220	! ------------
221	!> Parin for &user_parameters for user module
222	!------------------------------------------------------------------------------!
223	SUBROUTINE user_parin
224
225	CHARACTER (LEN=80) :: line !< string containing the last line read from namelist file
226
227	INTEGER(iwp) :: i !<
228	INTEGER(iwp) :: io_status !< status after reading the namelist file
229	INTEGER(iwp) :: j !<
230
231
232	NAMELIST /user_parameters/ &
233	data_output_masks_user, &
234	data_output_pr_user, &
235	data_output_user, &
236	region
237
238	!
239	!-- Next statement is to avoid compiler warnings about unused variables. Please remove in case
240	!-- that you are using them.
241	IF ( dots_num_palm == 0 .OR. dots_num_user == 0 .OR. user_idummy == 0 .OR. &
242	user_rdummy == 0.0_wp ) CONTINUE
243
244	!
245	!-- Set revision number of this default interface version. It will be checked within
246	!-- the main program (palm). Please change the revision number in case that the
247	!-- current revision does not match with previous revisions (e.g. if routines
248	!-- have been added/deleted or if parameter lists in subroutines have been changed).
249	user_interface_current_revision = 'r3703'
250
251	!
252	!-- Position the namelist-file at the beginning (it was already opened in
253	!-- parin), and try to read (find) a namelist named "user_parameters".
254	REWIND ( 11 )
255	READ( 11, user_parameters, IOSTAT=io_status )
256
257	!
258	!-- Actions depending on the READ status
259	IF ( io_status == 0 ) THEN
260	!
261	!-- User namelist found and correctly read. Set default module switch to true. This activates
262	!-- calls of the user-interface subroutines.
263	user_module_enabled = .TRUE.
264
265	ELSEIF ( io_status > 0 ) THEN
266	!
267	!-- User namelist was found, but contained errors. Print an error message containing the line
268	!-- that caused the problem
269	BACKSPACE( 11 )
270	READ( 11 , '(A)') line
271	CALL parin_fail_message( 'user_parameters', line )
272
273	ENDIF
274
275	!
276	!-- Determine the number of user-defined profiles and append them to the
277	!-- standard data output (data_output_pr)
278	IF ( user_module_enabled ) THEN
279	IF ( data_output_pr_user(1) /= ' ' ) THEN
280	i = 1
281	DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 )
282	i = i + 1
283	ENDDO
284	j = 1
285	DO WHILE ( data_output_pr_user(j) /= ' ' .AND. j <= 100 )
286	data_output_pr(i) = data_output_pr_user(j)
287	max_pr_user_tmp = max_pr_user_tmp + 1
288	i = i + 1
289	j = j + 1
290	ENDDO
291	ENDIF
292	ENDIF
293
294
295	END SUBROUTINE user_parin
296
297
298	!------------------------------------------------------------------------------!
299	! Description:
300	! ------------
301	!> Check &userpar control parameters and deduce further quantities.
302	!------------------------------------------------------------------------------!
303	SUBROUTINE user_check_parameters
304
305
306	!-- Here the user may add code to check the validity of further &userpar
307	!-- control parameters or deduce further quantities.
308
309
310	END SUBROUTINE user_check_parameters
311
312
313	!------------------------------------------------------------------------------!
314	! Description:
315	! ------------
316	!> Set module-specific timeseries units and labels
317	!------------------------------------------------------------------------------!
318	SUBROUTINE user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
319
320
321	INTEGER(iwp), INTENT(IN) :: dots_max
322	INTEGER(iwp), INTENT(INOUT) :: dots_num
323	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
324	CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
325
326	!
327	!-- Next line is to avoid compiler warning about unused variables. Please remove.
328	IF ( dots_num == 0 .OR. dots_label(1)(1:1) == ' ' .OR. dots_unit(1)(1:1) == ' ' ) CONTINUE
329
330	!
331	!-- Sample for user-defined time series
332	!-- For each time series quantity you have to give a label and a unit,
333	!-- which will be used for the NetCDF file. They must not contain more than
334	!-- seven characters. The value of dots_num has to be increased by the
335	!-- number of new time series quantities. Its old value has to be store in
336	!-- dots_num_palm. See routine user_statistics on how to output calculate
337	!-- and output these quantities.
338
339	! dots_num_palm = dots_num
340
341	! dots_num = dots_num + 1
342	! dots_num_user = dots_num_user + 1
343	! dots_label(dots_num) = 'abs_umx'
344	! dots_unit(dots_num) = 'm/s'
345
346	! dots_num = dots_num + 1
347	! dots_num_user = dots_num_user + 1
348	! dots_label(dots_num) = 'abs_vmx'
349	! dots_unit(dots_num) = 'm/s'
350
351
352	END SUBROUTINE user_check_data_output_ts
353
354
355	!------------------------------------------------------------------------------!
356	! Description:
357	! ------------
358	!> Set the unit of user defined profile output quantities. For those variables
359	!> not recognized by the user, the parameter unit is set to "illegal", which
360	!> tells the calling routine that the output variable is not defined and leads
361	!> to a program abort.
362	!------------------------------------------------------------------------------!
363	SUBROUTINE user_check_data_output_pr( variable, var_count, unit, dopr_unit )
364
365
366	USE profil_parameter
367
368
369	CHARACTER (LEN=*) :: unit !<
370	CHARACTER (LEN=*) :: variable !<
371	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
372
373	! INTEGER(iwp) :: user_pr_index !<
374	INTEGER(iwp) :: var_count !<
375
376	!
377	!-- Next line is to avoid compiler warning about unused variables. Please remove.
378	IF ( unit(1:1) == ' ' .OR. dopr_unit(1:1) == ' ' .OR. var_count == 0 ) CONTINUE
379
380	SELECT CASE ( TRIM( variable ) )
381
382	!
383	!-- Uncomment and extend the following lines, if necessary.
384	!-- Add additional CASE statements depending on the number of quantities
385	!-- for which profiles are to be calculated. The respective calculations
386	!-- to be performed have to be added in routine user_statistics.
387	!-- The quantities are (internally) identified by a user-profile-number
388	!-- (see variable "user_pr_index" below). The first user-profile must be assigned
389	!-- the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
390	!-- user-profile-numbers have also to be used in routine user_statistics!
391	! CASE ( 'uv' ) ! quantity string as given in
392	! ! data_output_pr_user
393	! user_pr_index = pr_palm + 1
394	! dopr_index(var_count) = user_pr_index ! quantities' user-profile-number
395	! dopr_unit = 'm2/s2' ! quantity unit
396	! unit = dopr_unit
397	! hom(:,2,user_pr_index,:) = SPREAD( zu, 2, statistic_regions+1 )
398	! ! grid on which the quantity is
399	! ! defined (use zu or zw)
400
401	CASE DEFAULT
402	unit = 'illegal'
403
404	END SELECT
405
406
407	END SUBROUTINE user_check_data_output_pr
408
409
410	!------------------------------------------------------------------------------!
411	! Description:
412	! ------------
413	!> Set the unit of user defined output quantities. For those variables
414	!> not recognized by the user, the parameter unit is set to "illegal", which
415	!> tells the calling routine that the output variable is not defined and leads
416	!> to a program abort.
417	!------------------------------------------------------------------------------!
418	SUBROUTINE user_check_data_output( variable, unit )
419
420
421	CHARACTER (LEN=*) :: unit !<
422	CHARACTER (LEN=*) :: variable !<
423
424
425	SELECT CASE ( TRIM( variable ) )
426
427	!
428	!-- Uncomment and extend the following lines, if necessary
429	! CASE ( 'u2' )
430	! unit = 'm2/s2'
431	!
432	! CASE ( 'uv' )
433	! unit = 'm2/s2'
434	!
435	CASE DEFAULT
436	unit = 'illegal'
437
438	END SELECT
439
440
441	END SUBROUTINE user_check_data_output
442
443
444	!------------------------------------------------------------------------------!
445	! Description:
446	! ------------
447	!> Initialize user-defined arrays
448	!------------------------------------------------------------------------------!
449	SUBROUTINE user_init_arrays
450
451
452	! INTEGER(iwp) :: i !< loop index
453	! INTEGER(iwp) :: j !< loop index
454	! INTEGER(iwp) :: region !< index for loop over statistic regions
455
456	!
457	!-- Allocate user-defined arrays and set flags for statistic regions.
458	!-- Sample for user-defined output
459	! ALLOCATE( u2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
460	! ALLOCATE( ustvst(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
461
462	!
463	!-- Example for defining a statistic region:
464	! IF ( statistic_regions >= 1 ) THEN
465	! region = 1
466	!
467	! rmask(:,:,region) = 0.0_wp
468	! DO i = nxl, nxr
469	! IF ( i >= INT( 0.25 * nx ) .AND. i <= INT( 0.75 * nx ) ) THEN
470	! DO j = nys, nyn
471	! IF ( i >= INT( 0.25 * ny ) .AND. i <= INT( 0.75 * ny ) ) THEN
472	! rmask(j,i,region) = 1.0_wp
473	! ENDIF
474	! ENDDO
475	! ENDIF
476	! ENDDO
477	!
478	! ENDIF
479
480	END SUBROUTINE user_init_arrays
481
482
483	!------------------------------------------------------------------------------!
484	! Description:
485	! ------------
486	!> Execution of user-defined initializing actions
487	!------------------------------------------------------------------------------!
488	SUBROUTINE user_init
489
490
491	! CHARACTER (LEN=20) :: field_char !<
492	!
493	!-- Here the user-defined initializing actions follow:
494	!-- Sample for user-defined output
495	! ustvst = 0.0_wp
496
497
498	END SUBROUTINE user_init
499
500
501	!------------------------------------------------------------------------------!
502	! Description:
503	! ------------
504	!> Set the grids on which user-defined output quantities are defined.
505	!> Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and
506	!> for grid_z "zu" and "zw".
507	!------------------------------------------------------------------------------!
508	SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
509
510
511	CHARACTER (LEN=*) :: grid_x !<
512	CHARACTER (LEN=*) :: grid_y !<
513	CHARACTER (LEN=*) :: grid_z !<
514	CHARACTER (LEN=*) :: variable !<
515
516	LOGICAL :: found !<
517
518
519	SELECT CASE ( TRIM( variable ) )
520
521	!
522	!-- Uncomment and extend the following lines, if necessary
523	! CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
524	! found = .TRUE.
525	! grid_x = 'xu'
526	! grid_y = 'y'
527	! grid_z = 'zu'
528
529	! CASE ( 'uv', 'uv_xy', 'uv_xz', 'uv_yz' )
530	! found = .TRUE.
531	! grid_x = 'x'
532	! grid_y = 'y'
533	! grid_z = 'zu'
534
535	CASE DEFAULT
536	found = .FALSE.
537	grid_x = 'none'
538	grid_y = 'none'
539	grid_z = 'none'
540
541	END SELECT
542
543
544	END SUBROUTINE user_define_netcdf_grid
545
546
547
548
549	!------------------------------------------------------------------------------!
550	! Description:
551	! ------------
552	!> Print a header with user-defined information.
553	!------------------------------------------------------------------------------!
554	SUBROUTINE user_header( io )
555
556
557	INTEGER(iwp) :: i !<
558	INTEGER(iwp) :: io !<
559
560	!
561	!-- If no user-defined variables are read from the namelist-file, no
562	!-- information will be printed.
563	IF ( .NOT. user_module_enabled ) THEN
564	WRITE ( io, 100 )
565	RETURN
566	ENDIF
567
568	!
569	!-- Printing the information.
570	WRITE ( io, 110 )
571
572	IF ( statistic_regions /= 0 ) THEN
573	WRITE ( io, 200 )
574	DO i = 0, statistic_regions
575	WRITE ( io, 201 ) i, region(i)
576	ENDDO
577	ENDIF
578
579	!
580	!-- Format-descriptors
581	100 FORMAT (//' *** no user-defined variables found'/)
582	110 FORMAT (//1X,78('#') &
583	//' User-defined variables and actions:'/ &
584	' -----------------------------------'//)
585	200 FORMAT (' Output of profiles and time series for following regions:' /)
586	201 FORMAT (4X,'Region ',I1,': ',A)
587
588
589	END SUBROUTINE user_header
590
591
592	!------------------------------------------------------------------------------!
593	! Description:
594	! ------------
595	!> Call for all grid points
596	!------------------------------------------------------------------------------!
597	SUBROUTINE user_actions( location )
598
599
600	CHARACTER (LEN=*) :: location !<
601
602	! INTEGER(iwp) :: i !<
603	! INTEGER(iwp) :: j !<
604	! INTEGER(iwp) :: k !<
605
606	CALL cpu_log( log_point(24), 'user_actions', 'start' )
607
608	!
609	!-- Here the user-defined actions follow
610	!-- No calls for single grid points are allowed at locations before and
611	!-- after the timestep, since these calls are not within an i,j-loop
612	SELECT CASE ( location )
613
614	CASE ( 'before_timestep' )
615	!
616	!-- Enter actions to be done before every timestep here
617
618	CASE ( 'before_prognostic_equations' )
619	!
620	!-- Enter actions to be done before all prognostic equations here
621
622	CASE ( 'after_integration' )
623	!
624	!-- Enter actions to be done after every time integration (before
625	!-- data output)
626	!-- Sample for user-defined output:
627	! DO i = nxlg, nxrg
628	! DO j = nysg, nyng
629	! DO k = nzb, nzt
630	! u2(k,j,i) = u(k,j,i)**2
631	! ENDDO
632	! ENDDO
633	! ENDDO
634	! DO i = nxlg, nxr
635	! DO j = nysg, nyn
636	! DO k = nzb, nzt+1
637	! ustvst(k,j,i) = &
638	! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * &
639	! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) )
640	! ENDDO
641	! ENDDO
642	! ENDDO
643
644
645	CASE ( 'after_timestep' )
646	!
647	!-- Enter actions to be done after every timestep here
648
649
650	CASE ( 'u-tendency' )
651	!
652	!-- Enter actions to be done in the u-tendency term here
653
654
655	CASE ( 'v-tendency' )
656
657
658	CASE ( 'w-tendency' )
659
660
661	CASE ( 'pt-tendency' )
662
663
664	CASE ( 'sa-tendency' )
665
666
667	CASE ( 'e-tendency' )
668
669
670	CASE ( 'q-tendency' )
671
672
673	CASE ( 's-tendency' )
674
675
676	CASE DEFAULT
677	CONTINUE
678
679	END SELECT
680
681	CALL cpu_log( log_point(24), 'user_actions', 'stop' )
682
683	END SUBROUTINE user_actions
684
685
686	!------------------------------------------------------------------------------!
687	! Description:
688	! ------------
689	!> Call for grid point i,j
690	!------------------------------------------------------------------------------!
691	SUBROUTINE user_actions_ij( i, j, location )
692
693
694	CHARACTER (LEN=*) :: location
695
696	INTEGER(iwp) :: i
697	INTEGER(iwp) :: j
698
699	!
700	!-- Here the user-defined actions follow
701	SELECT CASE ( location )
702
703	CASE ( 'u-tendency' )
704
705	!
706	!-- Next line is to avoid compiler warning about unused variables. Please remove.
707	IF ( i == 0 .OR. j == 0 ) CONTINUE
708
709	!
710	!-- Enter actions to be done in the u-tendency term here
711
712
713	CASE ( 'v-tendency' )
714
715
716	CASE ( 'w-tendency' )
717
718
719	CASE ( 'pt-tendency' )
720
721
722	CASE ( 'sa-tendency' )
723
724
725	CASE ( 'e-tendency' )
726
727
728	CASE ( 'q-tendency' )
729
730
731	CASE ( 's-tendency' )
732
733
734	CASE DEFAULT
735	CONTINUE
736
737	END SELECT
738
739	END SUBROUTINE user_actions_ij
740
741
742	!------------------------------------------------------------------------------!
743	! Description:
744	! ------------
745	!> Sum up and time-average user-defined output quantities as well as allocate
746	!> the array necessary for storing the average.
747	!------------------------------------------------------------------------------!
748	SUBROUTINE user_3d_data_averaging( mode, variable )
749
750
751	CHARACTER (LEN=*) :: mode !<
752	CHARACTER (LEN=*) :: variable !<
753
754	! INTEGER(iwp) :: i !<
755	! INTEGER(iwp) :: j !<
756	! INTEGER(iwp) :: k !<
757
758	IF ( mode == 'allocate' ) THEN
759
760	SELECT CASE ( TRIM( variable ) )
761
762	!
763	!-- Uncomment and extend the following lines, if necessary.
764	!-- The arrays for storing the user defined quantities (here u2_av) have
765	!-- to be declared and defined by the user!
766	!-- Sample for user-defined output:
767	! CASE ( 'u2' )
768	! IF ( .NOT. ALLOCATED( u2_av ) ) THEN
769	! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
770	! ENDIF
771	! u2_av = 0.0_wp
772
773	CASE DEFAULT
774	CONTINUE
775
776	END SELECT
777
778	ELSEIF ( mode == 'sum' ) THEN
779
780	SELECT CASE ( TRIM( variable ) )
781
782	!
783	!-- Uncomment and extend the following lines, if necessary.
784	!-- The arrays for storing the user defined quantities (here u2 and
785	!-- u2_av) have to be declared and defined by the user!
786	!-- Sample for user-defined output:
787	! CASE ( 'u2' )
788	! IF ( ALLOCATED( u2_av ) ) THEN
789	! DO i = nxlg, nxrg
790	! DO j = nysg, nyng
791	! DO k = nzb, nzt+1
792	! u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
793	! ENDDO
794	! ENDDO
795	! ENDDO
796	! ENDIF
797
798	CASE DEFAULT
799	CONTINUE
800
801	END SELECT
802
803	ELSEIF ( mode == 'average' ) THEN
804
805	SELECT CASE ( TRIM( variable ) )
806
807	!
808	!-- Uncomment and extend the following lines, if necessary.
809	!-- The arrays for storing the user defined quantities (here u2_av) have
810	!-- to be declared and defined by the user!
811	!-- Sample for user-defined output:
812	! CASE ( 'u2' )
813	! IF ( ALLOCATED( u2_av ) ) THEN
814	! DO i = nxlg, nxrg
815	! DO j = nysg, nyng
816	! DO k = nzb, nzt+1
817	! u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d, KIND=wp )
818	! ENDDO
819	! ENDDO
820	! ENDDO
821	! ENDIF
822
823	END SELECT
824
825	ENDIF
826
827
828	END SUBROUTINE user_3d_data_averaging
829
830
831	!------------------------------------------------------------------------------!
832	! Description:
833	! ------------
834	!> Resorts the user-defined output quantity with indices (k,j,i) to a
835	!> temporary array with indices (i,j,k) and sets the grid on which it is defined.
836	!> Allowed values for grid are "zu" and "zw".
837	!------------------------------------------------------------------------------!
838	SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do )
839
840
841	CHARACTER (LEN=*) :: grid !<
842	CHARACTER (LEN=*) :: variable !<
843
844	INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data
845	! INTEGER(iwp) :: i !< grid index along x-direction
846	! INTEGER(iwp) :: j !< grid index along y-direction
847	! INTEGER(iwp) :: k !< grid index along z-direction
848	! INTEGER(iwp) :: m !< running index surface elements
849	INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb)
850	INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1)
851
852	LOGICAL :: found !<
853	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
854
855	! REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute
856
857	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
858
859	!
860	!-- Next line is to avoid compiler warning about unused variables. Please remove.
861	IF ( av == 0 .OR. local_pf(nxl,nys,nzb_do) == 0.0_wp .OR. two_d ) CONTINUE
862
863
864	found = .TRUE.
865
866	SELECT CASE ( TRIM( variable ) )
867
868	!
869	!-- Uncomment and extend the following lines, if necessary.
870	!-- The arrays for storing the user defined quantities (here u2 and u2_av)
871	!-- have to be declared and defined by the user!
872	!-- Sample for user-defined output:
873	! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
874	! IF ( av == 0 ) THEN
875	! DO i = nxl, nxr
876	! DO j = nys, nyn
877	! DO k = nzb_do, nzt_do
878	! local_pf(i,j,k) = u2(k,j,i)
879	! ENDDO
880	! ENDDO
881	! ENDDO
882	! ELSE
883	! IF ( .NOT. ALLOCATED( u2_av ) ) THEN
884	! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
885	! u2_av = REAL( fill_value, KIND = wp )
886	! ENDIF
887	! DO i = nxl, nxr
888	! DO j = nys, nyn
889	! DO k = nzb_do, nzt_do
890	! local_pf(i,j,k) = u2_av(k,j,i)
891	! ENDDO
892	! ENDDO
893	! ENDDO
894	! ENDIF
895	!
896	! grid = 'zu'
897	!
898	!-- In case two-dimensional surface variables are output, the user
899	!-- has to access related surface-type. Uncomment and extend following lines
900	!-- appropriately (example output of vertical surface momentum flux of u-
901	!-- component). Please note, surface elements can be distributed over
902	!-- several data type, depending on their respective surface properties.
903	! CASE ( 'usws_xy' )
904	! IF ( av == 0 ) THEN
905	!
906	!-- Horizontal default-type surfaces
907	! DO m = 1, surf_def_h(0)%ns
908	! i = surf_def_h(0)%i(m)
909	! j = surf_def_h(0)%j(m)
910	! local_pf(i,j,1) = surf_def_h(0)%usws(m)
911	! ENDDO
912	!
913	!-- Horizontal natural-type surfaces
914	! DO m = 1, surf_lsm_h%ns
915	! i = surf_lsm_h%i(m)
916	! j = surf_lsm_h%j(m)
917	! local_pf(i,j,1) = surf_lsm_h%usws(m)
918	! ENDDO
919	!
920	!-- Horizontal urban-type surfaces
921	! DO m = 1, surf_usm_h%ns
922	! i = surf_usm_h%i(m)
923	! j = surf_usm_h%j(m)
924	! local_pf(i,j,1) = surf_usm_h%usws(m)
925	! ENDDO
926	! ENDIF
927	!
928	! grid = 'zu'
929	!--
930
931
932	CASE DEFAULT
933	found = .FALSE.
934	grid = 'none'
935
936	END SELECT
937
938
939	END SUBROUTINE user_data_output_2d
940
941
942	!------------------------------------------------------------------------------!
943	! Description:
944	! ------------
945	!> Resorts the user-defined output quantity with indices (k,j,i) to a
946	!> temporary array with indices (i,j,k).
947	!------------------------------------------------------------------------------!
948	SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
949
950
951	CHARACTER (LEN=*) :: variable !<
952
953	INTEGER(iwp) :: av !<
954	! INTEGER(iwp) :: i !<
955	! INTEGER(iwp) :: j !<
956	! INTEGER(iwp) :: k !<
957	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
958	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
959
960	LOGICAL :: found !<
961
962	! REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute
963
964	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
965
966	!
967	!-- Next line is to avoid compiler warning about unused variables. Please remove.
968	IF ( av == 0 .OR. local_pf(nxl,nys,nzb_do) == 0.0_wp ) CONTINUE
969
970
971	found = .TRUE.
972
973	SELECT CASE ( TRIM( variable ) )
974
975	!
976	!-- Uncomment and extend the following lines, if necessary.
977	!-- The arrays for storing the user defined quantities (here u2 and u2_av)
978	!-- have to be declared and defined by the user!
979	!-- Sample for user-defined output:
980	! CASE ( 'u2' )
981	! IF ( av == 0 ) THEN
982	! DO i = nxl, nxr
983	! DO j = nys, nyn
984	! DO k = nzb_do, nzt_do
985	! local_pf(i,j,k) = u2(k,j,i)
986	! ENDDO
987	! ENDDO
988	! ENDDO
989	! ELSE
990	! IF ( .NOT. ALLOCATED( u2_av ) ) THEN
991	! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
992	! u2_av = REAL( fill_value, KIND = wp )
993	! ENDIF
994	! DO i = nxl, nxr
995	! DO j = nys, nyn
996	! DO k = nzb_do, nzt_do
997	! local_pf(i,j,k) = u2_av(k,j,i)
998	! ENDDO
999	! ENDDO
1000	! ENDDO
1001	! ENDIF
1002	!
1003
1004	CASE DEFAULT
1005	found = .FALSE.
1006
1007	END SELECT
1008
1009
1010	END SUBROUTINE user_data_output_3d
1011
1012
1013	!------------------------------------------------------------------------------!
1014	! Description:
1015	! ------------
1016	!> Calculation of user-defined statistics, i.e. horizontally averaged profiles
1017	!> and time series.
1018	!> This routine is called for every statistic region sr defined by the user,
1019	!> but at least for the region "total domain" (sr=0).
1020	!> See section 3.5.4 on how to define, calculate, and output user defined
1021	!> quantities.
1022	!------------------------------------------------------------------------------!
1023	SUBROUTINE user_statistics( mode, sr, tn )
1024
1025
1026	CHARACTER (LEN=*) :: mode !<
1027	! INTEGER(iwp) :: i !<
1028	! INTEGER(iwp) :: j !<
1029	! INTEGER(iwp) :: k !<
1030	INTEGER(iwp) :: sr !<
1031	INTEGER(iwp) :: tn !<
1032
1033	! REAL(wp), DIMENSION(:), ALLOCATABLE :: ts_value_l !<
1034
1035	!
1036	!-- Next line is to avoid compiler warning about unused variables. Please remove.
1037	IF ( sr == 0 .OR. tn == 0 ) CONTINUE
1038
1039	IF ( mode == 'profiles' ) THEN
1040
1041	!
1042	!-- Sample on how to calculate horizontally averaged profiles of user-
1043	!-- defined quantities. Each quantity is identified by the index
1044	!-- "pr_palm+#" where "#" is an integer starting from 1. These
1045	!-- user-profile-numbers must also be assigned to the respective strings
1046	!-- given by data_output_pr_user in routine user_check_data_output_pr.
1047	! !$OMP DO
1048	! DO i = nxl, nxr
1049	! DO j = nys, nyn
1050	! DO k = nzb+1, nzt
1051	!!
1052	!!-- Sample on how to calculate the profile of the resolved-scale
1053	!!-- horizontal momentum flux uv
1054	! sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) + &
1055	! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *&
1056	! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) &
1057	! * rmask(j,i,sr) &
1058	! * MERGE( 1.0_wp, 0.0_wp, &
1059	! BTEST( wall_flags_total_0(k,j,i), 0 ) )
1060	!!
1061	!!-- Further profiles can be defined and calculated by increasing
1062	!!-- the second index of array sums_l (replace ... appropriately)
1063	! sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... &
1064	! * rmask(j,i,sr)
1065	! ENDDO
1066	! ENDDO
1067	! ENDDO
1068
1069	ELSEIF ( mode == 'time_series' ) THEN
1070
1071
1072	! ALLOCATE ( ts_value_l(dots_num_user) )
1073	!
1074	!-- Sample on how to add values for the user-defined time series quantities.
1075	!-- These have to be defined before in routine user_init. This sample
1076	!-- creates two time series for the absolut values of the horizontal
1077	!-- velocities u and v.
1078	! ts_value_l = 0.0_wp
1079	! ts_value_l(1) = ABS( u_max )
1080	! ts_value_l(2) = ABS( v_max )
1081	!
1082	!-- Collect / send values to PE0, because only PE0 outputs the time series.
1083	!-- CAUTION: Collection is done by taking the sum over all processors.
1084	!-- You may have to normalize this sum, depending on the quantity
1085	!-- that you like to calculate. For serial runs, nothing has to be
1086	!-- done.
1087	!-- HINT: If the time series value that you are calculating has the same
1088	!-- value on all PEs, you can omit the MPI_ALLREDUCE call and
1089	!-- assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly.
1090	!#if defined( __parallel )
1091	! IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1092	! CALL MPI_ALLREDUCE( ts_value_l(1), &
1093	! ts_value(dots_num_palm+1,sr), &
1094	! dots_num_user, MPI_REAL, MPI_MAX, comm2d, &
1095	! ierr )
1096	!#else
1097	! ts_value(dots_num_palm+1:dots_num_palm+dots_num_user,sr) = ts_value_l
1098	!#endif
1099
1100	ENDIF
1101
1102	END SUBROUTINE user_statistics
1103
1104
1105	!------------------------------------------------------------------------------!
1106	! Description:
1107	! ------------
1108	!> Reading global restart data that has been defined by the user.
1109	!------------------------------------------------------------------------------!
1110	SUBROUTINE user_rrd_global( found )
1111
1112
1113	LOGICAL, INTENT(OUT) :: found
1114
1115
1116	found = .TRUE.
1117
1118
1119	SELECT CASE ( restart_string(1:length) )
1120
1121	CASE ( 'global_paramter' )
1122	! READ ( 13 ) global_parameter
1123
1124	CASE DEFAULT
1125
1126	found = .FALSE.
1127
1128	END SELECT
1129
1130
1131	END SUBROUTINE user_rrd_global
1132
1133
1134	!------------------------------------------------------------------------------!
1135	! Description:
1136	! ------------
1137	!> Reading processor specific restart data from file(s) that has been defined
1138	!> by the user.
1139	!> Subdomain index limits on file are given by nxl_on_file, etc.
1140	!> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
1141	!> subdomain on file (f) to the subdomain of the current PE (c). They have been
1142	!> calculated in routine rrd_local.
1143	!------------------------------------------------------------------------------!
1144	SUBROUTINE user_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
1145	nxr_on_file, nynf, nync, nyn_on_file, nysf, &
1146	nysc, nys_on_file, tmp_3d, found )
1147
1148
1149	INTEGER(iwp) :: idum !<
1150	INTEGER(iwp) :: k !<
1151	INTEGER(iwp) :: nxlc !<
1152	INTEGER(iwp) :: nxlf !<
1153	INTEGER(iwp) :: nxl_on_file !<
1154	INTEGER(iwp) :: nxrc !<
1155	INTEGER(iwp) :: nxrf !<
1156	INTEGER(iwp) :: nxr_on_file !<
1157	INTEGER(iwp) :: nync !<
1158	INTEGER(iwp) :: nynf !<
1159	INTEGER(iwp) :: nyn_on_file !<
1160	INTEGER(iwp) :: nysc !<
1161	INTEGER(iwp) :: nysf !<
1162	INTEGER(iwp) :: nys_on_file !<
1163
1164	LOGICAL, INTENT(OUT) :: found
1165
1166	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
1167
1168	!
1169	!-- Next line is to avoid compiler warning about unused variables. Please remove.
1170	idum = k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf + &
1171	INT( tmp_3d(nzb,nys_on_file,nxl_on_file) )
1172
1173	!
1174	!-- Here the reading of user-defined restart data follows:
1175	!-- Sample for user-defined output
1176
1177	found = .TRUE.
1178
1179	SELECT CASE ( restart_string(1:length) )
1180
1181	CASE ( 'u2_av' )
1182	! IF ( .NOT. ALLOCATED( u2_av ) ) THEN
1183	! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1184	! ENDIF
1185	! IF ( k == 1 ) READ ( 13 ) tmp_3d
1186	! u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
1187	! tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
1188	!
1189	CASE DEFAULT
1190
1191	found = .FALSE.
1192
1193	END SELECT
1194
1195	END SUBROUTINE user_rrd_local
1196
1197
1198	!------------------------------------------------------------------------------!
1199	! Description:
1200	! ------------
1201	!> Writes global and user-defined restart data into binary file(s) for restart
1202	!> runs.
1203	!------------------------------------------------------------------------------!
1204	SUBROUTINE user_wrd_global
1205
1206	! CALL wrd_write_string( 'global_parameter' )
1207	! WRITE ( 14 ) global_parameter
1208
1209	END SUBROUTINE user_wrd_global
1210
1211
1212	!------------------------------------------------------------------------------!
1213	! Description:
1214	! ------------
1215	!> Writes processor specific and user-defined restart data into binary file(s)
1216	!> for restart runs.
1217	!------------------------------------------------------------------------------!
1218	SUBROUTINE user_wrd_local
1219
1220	!
1221	!-- Here the user-defined actions at the end of a job follow.
1222	!-- Sample for user-defined output:
1223	! IF ( ALLOCATED( u2_av ) ) THEN
1224	! CALL wrd_write_string( 'u2_av' )
1225	! WRITE ( 14 ) u2_av
1226	! ENDIF
1227
1228	END SUBROUTINE user_wrd_local
1229
1230
1231	!------------------------------------------------------------------------------!
1232	! Description:
1233	! ------------
1234	!> Execution of user-defined actions at the end of a job.
1235	!------------------------------------------------------------------------------!
1236	SUBROUTINE user_last_actions
1237
1238	!
1239	!-- Here the user-defined actions at the end of a job might follow.
1240
1241
1242	END SUBROUTINE user_last_actions
1243
1244	END MODULE user

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |