Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |