Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |