Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |