Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |