Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |