Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |