Home

Context Navigation

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

Last change on this file since 4335 was 4329, checked in by motisi, 4 years ago
Renamed wall_flags_0 to wall_flags_static_0
Property svn:keywords set to `Id`
File size: 37.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |