source: palm/trunk/SOURCE/user_interface.f90 @ 157

Last change on this file since 157 was 156, checked in by steinfeld, 16 years ago

Bugfix in user_read_restart_data

  • Property svn:keywords set to Id
File size: 34.8 KB
Line 
1 MODULE user
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! bugfix in user_read_restart_data
7! small bugfixes for sample code (comments):
8! - initialize ustvst with 0.0 as it is now computed only until nxr and nyn
9! - two ALLOCATE statements moved from user_read_restart_data back to user_init
10! - remove 'READ (13) u2_av' statement in user_read_restart_data
11! +routines user_read_restart_data, user_spectra
12!
13! Former revisions:
14! -----------------
15! $Id: user_interface.f90 156 2008-04-01 11:10:17Z letzel $
16!
17! 138 2007-11-28 10:03:58Z letzel
18! new subroutines user_init_plant_canopy, user_data_output_dvrp
19! +argument gls in user_init_grid
20!
21! 105 2007-08-08 07:12:55Z raasch
22! +dots_num_palm in module user, +module netcdf_control in user_init
23!
24! 95 2007-06-02 16:48:38Z raasch
25! user action for salinity added
26!
27! 89 2007-05-25 12:08:31Z raasch
28! Calculation and output of user-defined profiles: new routine
29! user_check_data_output_pr, +data_output_pr_user, max_pr_user in userpar,
30! routine user_statistics has got two more arguments
31! Bugfix: field_chr renamed field_char
32!
33! 60 2007-03-11 11:50:04Z raasch
34! New routine user_init_3d_model which allows the initial setting of all 3d
35! arrays under control of the user, new routine user_advec_particles,
36! routine user_statistics now has one argument (sr),
37! sample for generating time series quantities added
38! Bugfix in sample for reading user defined data from restart file (user_init)
39!
40! RCS Log replace by Id keyword, revision history cleaned up
41!
42! Revision 1.18  2006/06/02 15:25:00  raasch
43! +change of grid-defining arguments in routine user_define_netcdf_grid,
44! new argument "found" in user_data_output_2d and user_data_output_3d
45!
46! Revision 1.1  1998/03/24 15:29:04  raasch
47! Initial revision
48!
49!
50! Description:
51! ------------
52! Declaration of user-defined variables. This module may only be used
53! in the user-defined routines (contained in user_interface.f90).
54!------------------------------------------------------------------------------!
55
56    INTEGER ::  dots_num_palm, user_idummy
57    LOGICAL ::  user_defined_namelist_found = .FALSE.
58    REAL    ::  user_dummy
59
60!
61!-- Sample for user-defined output
62!    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  u2, u2_av
63!    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  ustvst
64
65    SAVE
66
67 END MODULE user
68
69
70 SUBROUTINE user_parin
71
72!------------------------------------------------------------------------------!
73!
74! Description:
75! ------------
76! Interface to read user-defined namelist-parameters.
77!------------------------------------------------------------------------------!
78
79    USE control_parameters
80    USE pegrid
81    USE statistics
82    USE user
83
84    IMPLICIT NONE
85
86    CHARACTER (LEN=80) ::  zeile
87
88    INTEGER ::  i, j
89
90
91    NAMELIST /userpar/  data_output_pr_user, data_output_user, region
92
93!
94!-- Position the namelist-file at the beginning (it was already opened in
95!-- parin), search for user-defined namelist-group ("userpar", but any other
96!-- name can be choosed) and position the file at this line.
97    REWIND ( 11 )
98
99    zeile = ' '
100    DO   WHILE ( INDEX( zeile, '&userpar' ) == 0 )
101       READ ( 11, '(A)', END=100 )  zeile
102    ENDDO
103    BACKSPACE ( 11 )
104
105!
106!-- Read user-defined namelist
107    READ ( 11, userpar )
108    user_defined_namelist_found = .TRUE.
109
110!
111!-- Determine the number of user-defined profiles and append them to the
112!-- standard data output (data_output_pr)
113    IF ( data_output_pr_user(1) /= ' ' )  THEN
114       i = 1
115       DO  WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
116          i = i + 1
117       ENDDO
118       j = 1
119       DO  WHILE ( data_output_pr_user(j) /= ' '  .AND.  j <= 100 )
120          data_output_pr(i) = data_output_pr_user(j)
121          max_pr_user       = max_pr_user + 1
122          i = i + 1
123          j = j + 1
124       ENDDO
125    ENDIF
126
127100 RETURN
128
129 END SUBROUTINE user_parin
130
131
132
133 SUBROUTINE user_header( io )
134
135!------------------------------------------------------------------------------!
136!
137! Description:
138! ------------
139! Print a header with user-defined informations.
140!------------------------------------------------------------------------------!
141
142    USE statistics
143    USE user
144
145    IMPLICIT NONE
146
147    INTEGER ::  i, io
148
149!
150!-- If no user-defined variables are read from the namelist-file, no
151!-- informations will be printed.
152    IF ( .NOT. user_defined_namelist_found )  THEN
153       WRITE ( io, 100 )
154       RETURN
155    ENDIF
156
157!
158!-- Printing the informations.
159    WRITE ( io, 110 )
160
161    IF ( statistic_regions /= 0 )  THEN
162       WRITE ( io, 200 )
163       DO  i = 0, statistic_regions
164          WRITE ( io, 201 )  i, region(i)
165       ENDDO
166    ENDIF
167
168
169
170!
171!-- Format-descriptors
172100 FORMAT (//' *** no user-defined variables found'/)
173110 FORMAT (//1X,78('#')                                      &
174            //' User-defined variables and actions:'/  &
175              ' -----------------------------------'//)
176200 FORMAT (' Output of profiles and time series for following regions:' /)
177201 FORMAT (4X,'Region ',I1,':   ',A)
178
179
180 END SUBROUTINE user_header
181
182
183
184 SUBROUTINE user_read_restart_data( nxlc, nxlf, nxl_on_file, nxrc, nxrf,  &
185                                    nxr_on_file, nync, nynf, nyn_on_file, &
186                                    nysc, nysf, nys_on_file, tmp_2d, tmp_3d )
187
188!------------------------------------------------------------------------------!
189!
190! Description:
191! ------------
192! Reading restart data from file(s)
193! Subdomain index limits on file are given by nxl_on_file, etc.
194! Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
195! subdomain on file (f) to the subdomain of the current PE (c). They have been
196! calculated in routine read_3d_binary.
197!------------------------------------------------------------------------------!
198
199    USE control_parameters
200    USE indices
201    USE pegrid
202    USE user
203
204    IMPLICIT NONE
205
206    CHARACTER (LEN=20) :: field_char
207
208    INTEGER ::  nxlc, nxlf, nxl_on_file, nxrc, nxrf, nxr_on_file, nync, nynf, &
209                nyn_on_file, nysc, nysf, nys_on_file
210
211    REAL, DIMENSION(nys_on_file-1:nyn_on_file+1,nxl_on_file-1:nxr_on_file+1) ::&
212          tmp_2d
213
214    REAL, DIMENSION(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
215                    nxl_on_file-1:nxr_on_file+1) ::        &
216          tmp_3d
217
218!
219!-- Here the reading of user-defined restart data follows:
220!-- Sample for user-defined output
221!
222!    IF ( initializing_actions == 'read_restart_data' )  THEN
223!       READ ( 13 )  field_char
224!       DO  WHILE ( TRIM( field_char ) /= '*** end user ***' )
225!
226!          SELECT CASE ( TRIM( field_char ) )
227!
228!             CASE ( 'u2_av' )
229!                IF ( .NOT. ALLOCATED( u2_av ) ) THEN
230!                   ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
231!                ENDIF
232!                READ ( 13 )  tmp_3d
233!                u2_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
234!                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
235!
236!             CASE DEFAULT
237!                PRINT*, '+++ user_init: unknown variable named "', &
238!                        TRIM( field_char ), '" found in'
239!                PRINT*, '               data from prior run on PE ', myid
240!                CALL local_stop
241!
242!          END SELECT
243!
244!          READ ( 13 )  field_char
245!
246!       ENDDO
247!    ENDIF
248
249 END SUBROUTINE user_read_restart_data
250
251
252
253 SUBROUTINE user_init
254
255!------------------------------------------------------------------------------!
256!
257! Description:
258! ------------
259! Execution of user-defined initializing actions
260!------------------------------------------------------------------------------!
261
262    USE control_parameters
263    USE indices
264    USE netcdf_control
265    USE pegrid
266    USE user
267
268    IMPLICIT NONE
269
270    CHARACTER (LEN=20) :: field_char
271!
272!-- Here the user-defined initializing actions follow:
273!-- Sample for user-defined output
274!    ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
275!    ALLOCATE( ustvst(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) );  ustvst = 0.0
276
277!-- Sample for user-defined time series
278!-- For each time series quantity you have to give a label and a unit,
279!-- which will be used for the NetCDF file. They must not contain more than
280!-- seven characters. The value of dots_num has to be increased by the
281!-- number of new time series quantities. Its old value has to be store in
282!-- dots_num_palm. See routine user_statistics on how to output calculate
283!-- and output these quantities.
284!    dots_label(dots_num+1) = 'abs_umx'
285!    dots_unit(dots_num+1)  = 'm/s'
286!    dots_label(dots_num+2) = 'abs_vmx'
287!    dots_unit(dots_num+2)  = 'm/s'
288!
289!    dots_num_palm = dots_num
290!    dots_num = dots_num + 2
291
292 END SUBROUTINE user_init
293
294
295
296 SUBROUTINE user_init_grid( gls, nzb_local )
297
298!------------------------------------------------------------------------------!
299!
300! Description:
301! ------------
302! Execution of user-defined grid initializing actions
303! First argument gls contains the number of ghost layers, which is > 1 if the
304! multigrid method for the pressure solver is used
305!------------------------------------------------------------------------------!
306
307    USE control_parameters
308    USE indices
309    USE user
310
311    IMPLICIT NONE
312
313    INTEGER ::  gls
314
315    INTEGER, DIMENSION(-gls:ny+gls,-gls:nx+gls) ::  nzb_local
316
317!
318!-- Here the user-defined grid initializing actions follow:
319
320!
321!-- Set the index array nzb_local for non-flat topography.
322!-- Here consistency checks concerning domain size and periodicity are necessary
323    SELECT CASE ( TRIM( topography ) )
324
325       CASE ( 'flat', 'single_building' )
326!
327!--       Not allowed here since these are the standard cases used in init_grid.
328
329       CASE ( 'user_defined_topography_1' )
330!
331!--       Here the user can define his own topography. After definition, please
332!--       remove the following three lines!
333          PRINT*, '+++ user_init_grid: topography "', &
334               topography, '" not available yet'
335          CALL local_stop
336
337       CASE DEFAULT
338!
339!--       The DEFAULT case is reached if the parameter topography contains a
340!--       wrong character string that is neither recognized in init_grid nor
341!--       here in user_init_grid.
342          PRINT*, '+++ (user_)init_grid: unknown topography "', &
343               topography, '"'
344          CALL local_stop
345
346    END SELECT
347
348
349 END SUBROUTINE user_init_grid
350
351
352
353 SUBROUTINE user_init_plant_canopy
354
355!------------------------------------------------------------------------------!
356!
357! Description:
358! ------------
359! Initialisation of the leaf area density array (for scalar grid points) and
360! the array of the canopy drag coefficient, if the user has not chosen any
361! of the default cases
362!------------------------------------------------------------------------------!
363
364    USE arrays_3d
365    USE control_parameters
366    USE indices
367    USE user
368
369    IMPLICIT NONE
370
371    INTEGER :: i, j 
372
373!
374!-- Here the user-defined grid initializing actions follow:
375
376!
377!-- Set the 3D-arrays lad_s and cdc for user defined canopies
378    SELECT CASE ( TRIM( canopy_mode ) )
379
380       CASE ( 'block' )
381!
382!--       Not allowed here since this is the standard case used in init_3d_model.
383
384       CASE ( 'user_defined_canopy_1' )
385!
386!--       Here the user can define his own topography.
387!--       The following lines contain an example in that the
388!--       plant canopy extends only over the second half of the
389!--       model domain along x
390!          DO  i = nxl-1, nxr+1
391!             IF ( i >= INT(nx+1/2) ) THEN
392!                DO  j = nys-1, nyn+1
393!                   lad_s(:,j,i) = lad(:)
394!                   cdc(:,j,i)   = drag_coefficient
395!                ENDDO
396!             ELSE
397!                lad_s(:,:,i) = 0.0
398!                cdc(:,:,i)   = 0.0
399!             ENDIF
400!          ENDDO
401!--       After definition, please
402!--       remove the following three lines!
403          PRINT*, '+++ user_init_plant_canopy: canopy_mode "', &
404               canopy_mode, '" not available yet'
405
406       CASE DEFAULT
407!
408!--       The DEFAULT case is reached if the parameter canopy_mode contains a
409!--       wrong character string that is neither recognized in init_3d_model nor
410!--       here in user_init_plant_canopy.
411          PRINT*, '+++ user_init_plant_canopy: unknown canopy_mode "', &
412               canopy_mode, '"'
413          CALL local_stop
414
415    END SELECT
416
417
418 END SUBROUTINE user_init_plant_canopy
419
420
421
422 SUBROUTINE user_init_3d_model
423
424!------------------------------------------------------------------------------!
425!
426! Description:
427! ------------
428! Allows the complete initialization of the 3d model.
429!
430! CAUTION: The user is responsible to set at least all those quantities which
431! ------   are normally set within init_3d_model!
432!------------------------------------------------------------------------------!
433
434    USE arrays_3d
435    USE control_parameters
436    USE indices
437    USE user
438
439    IMPLICIT NONE
440
441
442 END SUBROUTINE user_init_3d_model
443
444
445
446 MODULE user_actions_mod
447
448!------------------------------------------------------------------------------!
449!
450! Description:
451! ------------
452! Execution of user-defined actions before or after single timesteps
453!------------------------------------------------------------------------------!
454
455    PRIVATE
456    PUBLIC user_actions
457
458    INTERFACE user_actions
459       MODULE PROCEDURE user_actions
460       MODULE PROCEDURE user_actions_ij
461    END INTERFACE user_actions
462
463 CONTAINS
464
465
466!------------------------------------------------------------------------------!
467! Call for all grid points
468!------------------------------------------------------------------------------!
469    SUBROUTINE user_actions( location )
470
471       USE control_parameters
472       USE cpulog
473       USE indices
474       USE interfaces
475       USE pegrid
476       USE user
477       USE arrays_3d
478
479       IMPLICIT NONE
480
481       CHARACTER (LEN=*) ::  location
482
483       INTEGER ::  i, j, k
484
485       CALL cpu_log( log_point(24), 'user_actions', 'start' )
486
487!
488!--    Here the user-defined actions follow
489!--    No calls for single grid points are allowed at locations before and
490!--    after the timestep, since these calls are not within an i,j-loop
491       SELECT CASE ( location )
492
493          CASE ( 'before_timestep' )
494!
495!--          Enter actions to be done before every timestep here
496
497
498          CASE ( 'after_integration' )
499!
500!--          Enter actions to be done after every time integration (before
501!--          data output)
502!--          Sample for user-defined output:
503!             DO  i = nxl-1, nxr+1
504!                DO  j = nys-1, nyn+1
505!                   DO  k = nzb, nzt+1
506!                      u2(k,j,i) = u(k,j,i)**2
507!                   ENDDO
508!                ENDDO
509!             ENDDO
510!             DO  i = nxl-1, nxr
511!                DO  j = nys-1, nyn
512!                   DO  k = nzb, nzt+1
513!                      ustvst(k,j,i) =  &
514!                         ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * &
515!                         ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) )
516!                   ENDDO
517!                ENDDO
518!             ENDDO
519
520
521          CASE ( 'after_timestep' )
522!
523!--          Enter actions to be done after every timestep here
524
525
526          CASE ( 'u-tendency' )
527!
528!--          Enter actions to be done in the u-tendency term here
529
530
531          CASE ( 'v-tendency' )
532
533
534          CASE ( 'w-tendency' )
535
536
537          CASE ( 'pt-tendency' )
538
539
540          CASE ( 'sa-tendency' )
541
542
543          CASE ( 'e-tendency' )
544
545
546          CASE ( 'q-tendency' )
547
548
549          CASE DEFAULT
550             IF ( myid == 0 )  PRINT*, '+++ user_actions: unknown location "', &
551                                       location, '"'
552             CALL local_stop
553
554       END SELECT
555
556       CALL cpu_log( log_point(24), 'user_actions', 'stop' )
557
558    END SUBROUTINE user_actions
559
560
561!------------------------------------------------------------------------------!
562! Call for grid point i,j
563!------------------------------------------------------------------------------!
564    SUBROUTINE user_actions_ij( i, j, location )
565
566       USE control_parameters
567       USE pegrid
568       USE user
569
570       IMPLICIT NONE
571
572       CHARACTER (LEN=*) ::  location
573
574       INTEGER ::  i, idum, j
575
576
577!
578!--    Here the user-defined actions follow
579       SELECT CASE ( location )
580
581          CASE ( 'u-tendency' )
582!
583!--          Enter actions to be done in the u-tendency term here
584
585
586          CASE ( 'v-tendency' )
587
588
589          CASE ( 'w-tendency' )
590
591
592          CASE ( 'pt-tendency' )
593
594
595          CASE ( 'sa-tendency' )
596
597
598          CASE ( 'e-tendency' )
599
600
601          CASE ( 'q-tendency' )
602
603
604          CASE ( 'before_timestep', 'after_integration', 'after_timestep' )
605             IF ( myid == 0 )  THEN
606                PRINT*, '+++ user_actions: location "', location, '" is not ', &
607                             'allowed to be called with parameters "i" and "j"'
608             ENDIF
609             CALL local_stop
610
611
612          CASE DEFAULT
613             IF ( myid == 0 )  PRINT*, '+++ user_actions: unknown location "', &
614                                       location, '"'
615             CALL local_stop
616
617
618       END SELECT
619
620    END SUBROUTINE user_actions_ij
621
622 END MODULE user_actions_mod
623
624
625
626 SUBROUTINE user_spectra( mode, m, pr )
627
628!------------------------------------------------------------------------------!
629!
630! Description:
631! ------------
632! Calculation of user-defined spectra.
633! See section 3.5.4 on how to define, calculate, and output user defined
634! quantities.
635!------------------------------------------------------------------------------!
636
637    USE arrays_3d
638    USE indices
639    USE spectrum
640    USE statistics
641    USE user
642
643    IMPLICIT NONE
644
645    CHARACTER (LEN=*) ::  mode
646
647    INTEGER ::  i, j, k, m, pr
648
649
650!
651!-- Sample on how to calculate spectra of user-defined quantities.
652!-- Each quantity is identified by the corresponding user profile index
653!-- "pr_palm+#" where "#" is an integer starting from 1. These
654!-- user-profile-numbers must also be assigned to the respective strings
655!-- given by data_output_pr_user in routine user_check_data_output_pr.
656    IF ( mode == 'preprocess' )  THEN
657
658       SELECT CASE ( TRIM( data_output_sp(m) ) )
659         
660          CASE ( 'u', 'v', 'w', 'pt', 'q' )
661!--          Not allowed here since these are the standard quantities used in
662!--          preprocess_spectra.
663       
664!          CASE ( 'u*v*' )
665!             pr = pr_palm+1
666!             d(nzb+1:nzt,nys:nyn,nxl:nxr) = ustvst(nzb+1:nzt,nys:nyn,nxl:nxr)
667       
668          CASE DEFAULT
669             PRINT*, '+++ user_spectra/preprocess: Spectra of ', &
670                  TRIM( data_output_sp(m) ), ' can not be calculated'
671         
672       END SELECT
673
674    ELSEIF ( mode == 'data_output' )  THEN
675
676       SELECT CASE ( TRIM( data_output_sp(m) ) )
677
678          CASE ( 'u', 'v', 'w', 'pt', 'q' )
679!--          Not allowed here since these are the standard quantities used in
680!--          data_output_spectra.
681
682!          CASE ( 'u*v*' )
683!             pr = 6
684
685          CASE DEFAULT
686             PRINT*, '+++ user_spectra/data_output: Spectra of ', &
687                          TRIM( data_output_sp(m) ), ' are not defined'
688
689          END SELECT
690
691    ENDIF
692
693 END SUBROUTINE user_spectra
694
695
696 SUBROUTINE user_statistics( mode, sr, tn )
697
698!------------------------------------------------------------------------------!
699!
700! Description:
701! ------------
702! Calculation of user-defined statistics, i.e. horizontally averaged profiles
703! and time series.
704! This routine is called for every statistic region sr defined by the user,
705! but at least for the region "total domain" (sr=0).
706! See section 3.5.4 on how to define, calculate, and output user defined
707! quantities.
708!------------------------------------------------------------------------------!
709
710    USE arrays_3d
711    USE indices
712    USE statistics
713    USE user
714
715    IMPLICIT NONE
716
717    CHARACTER (LEN=*) ::  mode
718
719    INTEGER ::  i, j, k, sr, tn
720
721
722    IF ( mode == 'profiles' )  THEN
723
724!
725!--    Sample on how to calculate horizontally averaged profiles of user-
726!--    defined quantities. Each quantity is identified by the index
727!--    "pr_palm+#" where "#" is an integer starting from 1. These
728!--    user-profile-numbers must also be assigned to the respective strings
729!--    given by data_output_pr_user in routine user_check_data_output_pr.
730!       !$OMP DO
731!       DO  i = nxl, nxr
732!          DO  j = nys, nyn
733!             DO  k = nzb_s_inner(j,i)+1, nzt
734!!
735!!--             Sample on how to calculate the profile of the resolved-scale
736!!--             horizontal momentum flux u*v*
737!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +           &
738!                      ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) * &
739!                      ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) )   &
740!                                                 * rmask(j,i,sr)
741!!
742!!--             Further profiles can be defined and calculated by increasing
743!!--             the second index of array sums_l (replace ... appropriately)
744!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... &
745!                                         * rmask(j,i,sr)
746!             ENDDO
747!          ENDDO
748!       ENDDO
749
750    ELSEIF ( mode == 'time_series' )  THEN
751
752!
753!--    Sample on how to add values for the user-defined time series quantities.
754!--    These have to be defined before in routine user_init. This sample
755!--    creates two time series for the absolut values of the horizontal
756!--    velocities u and v.
757!       ts_value(dots_num_palm+1,sr) = ABS( u_max )
758!       ts_value(dots_num_palm+2,sr) = ABS( v_max )
759
760    ENDIF
761
762 END SUBROUTINE user_statistics
763
764
765
766 SUBROUTINE user_last_actions
767
768!------------------------------------------------------------------------------!
769!
770! Description:
771! ------------
772! Execution of user-defined actions at the end of a job.
773!------------------------------------------------------------------------------!
774
775    USE user
776
777    IMPLICIT NONE
778
779!
780!-- Here the user-defined actions at the end of a job follow.
781!-- Sample for user-defined output:
782!    IF ( ALLOCATED( u2_av ) )  THEN
783!       WRITE ( 14 )  'u2_av               ';  WRITE ( 14 )  u2_av
784!    ENDIF
785
786    WRITE ( 14 )  '*** end user ***    '
787
788 END SUBROUTINE user_last_actions
789
790
791
792 SUBROUTINE user_init_particles
793
794!------------------------------------------------------------------------------!
795!
796! Description:
797! ------------
798! Modification of initial particles by the user.
799!------------------------------------------------------------------------------!
800
801    USE particle_attributes
802    USE user
803
804    IMPLICIT NONE
805
806    INTEGER ::  n
807
808!
809!-- Here the user-defined actions follow
810!    DO  n = 1, number_of_initial_particles
811!    ENDDO
812
813 END SUBROUTINE user_init_particles
814
815
816
817 SUBROUTINE user_advec_particles
818
819!------------------------------------------------------------------------------!
820!
821! Description:
822! ------------
823! Modification of initial particles by the user.
824!------------------------------------------------------------------------------!
825
826    USE particle_attributes
827    USE user
828
829    IMPLICIT NONE
830
831    INTEGER ::  n
832
833!
834!-- Here the user-defined actions follow
835!    DO  n = 1, number_of_initial_particles
836!    ENDDO
837
838 END SUBROUTINE user_advec_particles
839
840
841
842 SUBROUTINE user_particle_attributes
843
844!------------------------------------------------------------------------------!
845!
846! Description:
847! ------------
848! Define the actual particle attributes (size, colour) by the user.
849!------------------------------------------------------------------------------!
850
851    USE particle_attributes
852    USE user
853
854    IMPLICIT NONE
855
856    INTEGER ::  n
857
858!
859!-- Here the user-defined actions follow
860!    DO  n = 1, number_of_initial_particles
861!    ENDDO
862
863 END SUBROUTINE user_particle_attributes
864
865
866
867 SUBROUTINE user_dvrp_coltab( mode, variable )
868
869!------------------------------------------------------------------------------!
870!
871! Description:
872! ------------
873! Definition of the colour table to be used by the dvrp software.
874!------------------------------------------------------------------------------!
875
876    USE dvrp_variables
877    USE pegrid
878    USE user
879
880    IMPLICIT NONE
881
882    CHARACTER (LEN=*) ::  mode
883    CHARACTER (LEN=*) ::  variable
884
885
886!
887!-- Here the user-defined actions follow
888    SELECT CASE ( mode )
889
890       CASE ( 'particles' )
891
892       CASE ( 'slicer' )
893
894       CASE DEFAULT
895          IF ( myid == 0 )  PRINT*, '+++ user_dvrp_coltab: unknown mode "', &
896                                    mode, '"'
897          CALL local_stop
898
899    END SELECT
900
901 END SUBROUTINE user_dvrp_coltab
902
903
904
905 SUBROUTINE user_check_data_output( variable, unit )
906
907!------------------------------------------------------------------------------!
908!
909! Description:
910! ------------
911! Set the unit of user defined output quantities. For those variables
912! not recognized by the user, the parameter unit is set to "illegal", which
913! tells the calling routine that the output variable is not defined and leads
914! to a program abort.
915!------------------------------------------------------------------------------!
916
917    USE user
918
919    IMPLICIT NONE
920
921    CHARACTER (LEN=*) ::  unit, variable
922
923
924    SELECT CASE ( TRIM( variable ) )
925
926!
927!--    Uncomment and extend the following lines, if necessary
928!       CASE ( 'u2' )
929!          unit = 'm2/s2'
930!
931!       CASE ( 'u*v*' )
932!          unit = 'm2/s2'
933!
934       CASE DEFAULT
935          unit = 'illegal'
936
937    END SELECT
938
939
940 END SUBROUTINE user_check_data_output
941
942
943
944 SUBROUTINE user_check_data_output_pr( variable, var_count, unit )
945
946!------------------------------------------------------------------------------!
947!
948! Description:
949! ------------
950! Set the unit of user defined profile output quantities. For those variables
951! not recognized by the user, the parameter unit is set to "illegal", which
952! tells the calling routine that the output variable is not defined and leads
953! to a program abort.
954!------------------------------------------------------------------------------!
955
956    USE arrays_3d
957    USE indices
958    USE netcdf_control
959    USE profil_parameter
960    USE statistics
961    USE user
962
963    IMPLICIT NONE
964
965    CHARACTER (LEN=*) ::  unit, variable
966
967    INTEGER ::  index, var_count
968
969
970    SELECT CASE ( TRIM( variable ) )
971
972!
973!--    Uncomment and extend the following lines, if necessary.
974!--    Add additional CASE statements depending on the number of quantities
975!--    for which profiles are to be calculated. The respective calculations
976!--    to be performed have to be added in routine user_statistics.
977!--    The quantities are (internally) identified by a user-profile-number
978!--    (see variable "index" below). The first user-profile must be assigned
979!--    the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
980!--    user-profile-numbers have also to be used in routine user_statistics!
981!       CASE ( 'u*v*' )                      ! quantity string as given in
982!                                            ! data_output_pr_user
983!          index = pr_palm + 1
984!          dopr_index(var_count)  = index    ! quantities' user-profile-number
985!          dopr_unit(var_count)   = 'm2/s2'  ! quantity unit
986!          hom(:,2,index,:)       = SPREAD( zu, 2, statistic_regions+1 )
987!                                            ! grid on which the quantity is
988!                                            ! defined (use zu or zw)
989
990       CASE DEFAULT
991          unit = 'illegal'
992
993    END SELECT
994
995
996 END SUBROUTINE user_check_data_output_pr
997
998
999
1000 SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
1001
1002!------------------------------------------------------------------------------!
1003!
1004! Description:
1005! ------------
1006! Set the grids on which user-defined output quantities are defined.
1007! Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and
1008! for grid_z "zu" and "zw".
1009!------------------------------------------------------------------------------!
1010
1011    USE user
1012
1013    IMPLICIT NONE
1014
1015    CHARACTER (LEN=*) ::  grid_x, grid_y, grid_z, variable
1016
1017    LOGICAL ::  found
1018
1019
1020    SELECT CASE ( TRIM( variable ) )
1021
1022!
1023!--    Uncomment and extend the following lines, if necessary
1024!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
1025!          grid_x = 'xu'
1026!          grid_y = 'y'
1027!          grid_z = 'zu'
1028
1029!       CASE ( 'u*v*', 'u*v*_xy', 'u*v*_xz', 'u*v*_yz' )
1030!          grid_x = 'x'
1031!          grid_y = 'y'
1032!          grid_z = 'zu'
1033
1034       CASE DEFAULT
1035          found  = .FALSE.
1036          grid_x = 'none'
1037          grid_y = 'none'
1038          grid_z = 'none'
1039
1040    END SELECT
1041
1042
1043 END SUBROUTINE user_define_netcdf_grid
1044
1045
1046
1047 SUBROUTINE user_data_output_dvrp( output_variable, local_pf )
1048
1049!------------------------------------------------------------------------------!
1050!
1051! Description:
1052! ------------
1053! Execution of user-defined dvrp output
1054!------------------------------------------------------------------------------!
1055
1056    USE control_parameters
1057    USE indices
1058    USE pegrid
1059    USE user
1060
1061    IMPLICIT NONE
1062
1063    CHARACTER (LEN=*) ::  output_variable
1064
1065    INTEGER ::  i, j, k
1066
1067    REAL, DIMENSION(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) ::  local_pf
1068
1069!
1070!-- Here the user-defined DVRP output follows:
1071
1072!
1073!-- Move original array to intermediate array
1074    SELECT CASE ( output_variable )
1075
1076!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz'  )
1077!!
1078!!--       Here the user can add user_defined output quantities.
1079!!--       Uncomment and extend the following lines, if necessary.
1080!          DO  i = nxl, nxr+1
1081!             DO  j = nys, nyn+1
1082!                DO  k = nzb, nz_do3d
1083!                   local_pf(i,j,k) = u2(k,j,i)
1084!                ENDDO
1085!             ENDDO
1086!          ENDDO
1087
1088
1089       CASE DEFAULT
1090!
1091!--       The DEFAULT case is reached if output_variable contains a
1092!--       wrong character string that is neither recognized in data_output_dvrp
1093!--       nor here in user_data_output_dvrp.
1094          IF ( myid == 0 )  THEN
1095             PRINT*,'+++ (user_)data_output_dvrp: no output possible for: ', &
1096                  output_variable
1097          ENDIF
1098
1099    END SELECT
1100
1101
1102 END SUBROUTINE user_data_output_dvrp
1103
1104
1105
1106 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf )
1107
1108!------------------------------------------------------------------------------!
1109!
1110! Description:
1111! ------------
1112! Resorts the user-defined output quantity with indices (k,j,i) to a
1113! temporary array with indices (i,j,k) and sets the grid on which it is defined.
1114! Allowed values for grid are "zu" and "zw".
1115!------------------------------------------------------------------------------!
1116
1117    USE indices
1118    USE user
1119
1120    IMPLICIT NONE
1121
1122    CHARACTER (LEN=*) ::  grid, variable
1123
1124    INTEGER ::  av, i, j, k
1125
1126    LOGICAL ::  found
1127
1128    REAL, DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) ::  local_pf
1129
1130
1131    found = .TRUE.
1132
1133    SELECT CASE ( TRIM( variable ) )
1134
1135!
1136!--    Uncomment and extend the following lines, if necessary.
1137!--    The arrays for storing the user defined quantities (here u2 and u2_av)
1138!--    have to be declared and defined by the user!
1139!--    Sample for user-defined output:
1140!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
1141!          IF ( av == 0 )  THEN
1142!             DO  i = nxl-1, nxr+1
1143!                DO  j = nys-1, nyn+1
1144!                   DO  k = nzb, nzt+1
1145!                      local_pf(i,j,k) = u2(k,j,i)
1146!                   ENDDO
1147!                ENDDO
1148!             ENDDO
1149!          ELSE
1150!             DO  i = nxl-1, nxr+1
1151!                DO  j = nys-1, nyn+1
1152!                   DO  k = nzb, nzt+1
1153!                      local_pf(i,j,k) = u2_av(k,j,i)
1154!                   ENDDO
1155!                ENDDO
1156!             ENDDO
1157!          ENDIF
1158!
1159!          grid = 'zu'
1160
1161       CASE DEFAULT
1162          found = .FALSE.
1163          grid  = 'none'
1164
1165    END SELECT
1166
1167
1168 END SUBROUTINE user_data_output_2d
1169
1170
1171
1172 SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nz_do )
1173
1174!------------------------------------------------------------------------------!
1175!
1176! Description:
1177! ------------
1178! Resorts the user-defined output quantity with indices (k,j,i) to a
1179! temporary array with indices (i,j,k).
1180!------------------------------------------------------------------------------!
1181
1182    USE array_kind
1183    USE indices
1184    USE user
1185
1186    IMPLICIT NONE
1187
1188    CHARACTER (LEN=*) ::  variable
1189
1190    INTEGER ::  av, i, j, k, nz_do
1191
1192    LOGICAL ::  found
1193
1194    REAL(spk), DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do) ::  local_pf
1195
1196
1197    found = .TRUE.
1198
1199    SELECT CASE ( TRIM( variable ) )
1200
1201!
1202!--    Uncomment and extend the following lines, if necessary.
1203!--    The arrays for storing the user defined quantities (here u2 and u2_av)
1204!--    have to be declared and defined by the user!
1205!--    Sample for user-defined output:
1206!       CASE ( 'u2' )
1207!          IF ( av == 0 )  THEN
1208!             DO  i = nxl-1, nxr+1
1209!                DO  j = nys-1, nyn+1
1210!                   DO  k = nzb, nz_do
1211!                      local_pf(i,j,k) = u2(k,j,i)
1212!                   ENDDO
1213!                ENDDO
1214!             ENDDO
1215!          ELSE
1216!             DO  i = nxl-1, nxr+1
1217!                DO  j = nys-1, nyn+1
1218!                   DO  k = nzb, nz_do
1219!                      local_pf(i,j,k) = u2_av(k,j,i)
1220!                   ENDDO
1221!                ENDDO
1222!             ENDDO
1223!          ENDIF
1224!
1225
1226       CASE DEFAULT
1227          found = .FALSE.
1228
1229    END SELECT
1230
1231
1232 END SUBROUTINE user_data_output_3d
1233
1234
1235
1236 SUBROUTINE user_3d_data_averaging( mode, variable )
1237
1238!------------------------------------------------------------------------------!
1239!
1240! Description:
1241! ------------
1242! Sum up and time-average user-defined output quantities as well as allocate
1243! the array necessary for storing the average.
1244!------------------------------------------------------------------------------!
1245
1246    USE control_parameters
1247    USE indices
1248    USE user
1249
1250    IMPLICIT NONE
1251
1252    CHARACTER (LEN=*) ::  mode, variable
1253
1254    INTEGER ::  i, j, k
1255
1256
1257    IF ( mode == 'allocate' )  THEN
1258
1259       SELECT CASE ( TRIM( variable ) )
1260
1261!
1262!--       Uncomment and extend the following lines, if necessary.
1263!--       The arrays for storing the user defined quantities (here u2_av) have
1264!--       to be declared and defined by the user!
1265!--       Sample for user-defined output:
1266!          CASE ( 'u2' )
1267!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
1268!                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
1269!             ENDIF
1270!             u2_av = 0.0
1271
1272          CASE DEFAULT
1273             CONTINUE
1274
1275       END SELECT
1276
1277    ELSEIF ( mode == 'sum' )  THEN
1278
1279       SELECT CASE ( TRIM( variable ) )
1280
1281!
1282!--       Uncomment and extend the following lines, if necessary.
1283!--       The arrays for storing the user defined quantities (here u2 and
1284!--       u2_av) have to be declared and defined by the user!
1285!--       Sample for user-defined output:
1286!          CASE ( 'u2' )
1287!             DO  i = nxl-1, nxr+1
1288!                DO  j = nys-1, nyn+1
1289!                   DO  k = nzb, nzt+1
1290!                      u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
1291!                   ENDDO
1292!                ENDDO
1293!             ENDDO
1294
1295          CASE DEFAULT
1296             CONTINUE
1297
1298       END SELECT
1299
1300    ELSEIF ( mode == 'average' )  THEN
1301
1302       SELECT CASE ( TRIM( variable ) )
1303
1304!
1305!--       Uncomment and extend the following lines, if necessary.
1306!--       The arrays for storing the user defined quantities (here u2_av) have
1307!--       to be declared and defined by the user!
1308!--       Sample for user-defined output:
1309!          CASE ( 'u2' )
1310!             DO  i = nxl-1, nxr+1
1311!                DO  j = nys-1, nyn+1
1312!                   DO  k = nzb, nzt+1
1313!                      u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )
1314!                   ENDDO
1315!                ENDDO
1316!             ENDDO
1317
1318       END SELECT
1319
1320    ENDIF
1321
1322
1323 END SUBROUTINE user_3d_data_averaging
Note: See TracBrowser for help on using the repository browser.