Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |