Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |