Home

Context Navigation

Back to doc/app/examples/dns

dns: user_module.f90

File user_module.f90, 40.7 KB (added by Giersch, 6 years ago)

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

Download in other formats:

Original Format