Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |