Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |