Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |