Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |