Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |