Home

Context Navigation

user_module.f90 @ 4878

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

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

Context Navigation

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

Download in other formats: