Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |