Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |