Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |