source: palm/tags/release-3.4a/SOURCE/user_interface.f90 @ 243

Last change on this file since 243 was 139, checked in by raasch, 16 years ago

New:
---

Plant canopy model of Watanabe (2004,BLM 112,307-341) added.
It can be switched on by the inipar parameter plant_canopy.
The inipar parameter canopy_mode can be used to prescribe a
plant canopy type. The default case is a homogeneous plant
canopy. Heterogeneous distributions of the leaf area
density and the canopy drag coefficient can be defined in the
new routine user_init_plant_canopy (user_interface).
The inipar parameters lad_surface, lad_vertical_gradient and
lad_vertical_gradient_level can be used in order to
prescribe the vertical profile of leaf area density. The
inipar parameter drag_coefficient determines the canopy
drag coefficient.
Finally, the inipar parameter pch_index determines the
index of the upper boundary of the plant canopy.

Allow new case bc_uv_t = 'dirichlet_0' for channel flow.

For unknown variables (CASE DEFAULT) call new subroutine user_data_output_dvrp

Pressure boundary conditions for vertical walls added to the multigrid solver.
They are applied using new wall flag arrays (wall_flags_..) which are defined
for each grid level. New argument gls added to routine user_init_grid
(user_interface).

Frequence of sorting particles can be controlled with new particles_par
parameter dt_sort_particles. Sorting is moved from the SGS timestep loop in
advec_particles after the end of this loop.

advec_particles, check_parameters, data_output_dvrp, header, init_3d_model, init_grid, init_particles, init_pegrid, modules, package_parin, parin, plant_canopy_model, read_var_list, read_3d_binary, user_interface, write_var_list, write_3d_binary

Changed:


Redefine initial nzb_local as the actual total size of topography (later the
extent of topography in nzb_local is reduced by 1dx at the E topography walls
and by 1dy at the N topography walls to form the basis for nzb_s_inner);
for consistency redefine 'single_building' case.

Vertical profiles now based on nzb_s_inner; they are divided by
ngp_2dh_s_inner (scalars, procucts of scalars) and ngp_2dh (staggered velocity
components and their products, procucts of scalars and velocity components),
respectively.

Allow two instead of one digit to specify isosurface and slicer variables.

Status of 3D-volume NetCDF data file only depends on switch netcdf_64bit_3d (check_open)

prognostic_equations include the respective wall_*flux in the parameter list of
calls of diffusion_s. Same as before, only the values of wall_heatflux(0:4)
can be assigned. At present, wall_humidityflux, wall_qflux, wall_salinityflux,
and wall_scalarflux are kept zero. diffusion_s uses the respective wall_*flux
instead of wall_heatflux. This update serves two purposes:

  • it avoids errors in calculations with humidity/scalar/salinity and prescribed

non-zero wall_heatflux,

  • it prepares PALM for a possible assignment of wall fluxes of

humidity/scalar/salinity in a future release.

buoyancy, check_open, data_output_dvrp, diffusion_s, diffusivities, flow_statistics, header, init_3d_model, init_dvrp, init_grid, modules, prognostic_equations

Errors:


Bugfix: summation of sums_l_l in diffusivities.

Several bugfixes in the ocean part: Initial density rho is calculated
(init_ocean). Error in initializing u_init and v_init removed
(check_parameters). Calculation of density flux now starts from
nzb+1 (production_e).

Bugfix: pleft/pright changed to pnorth/psouth in sendrecv of particle tail
numbers along y, small bugfixes in the SGS part (advec_particles)

Bugfix: model_string needed a default value (combine_plot_fields)

Bugfix: wavenumber calculation for even nx in routines maketri (poisfft)

Bugfix: assignment of fluxes at walls

Bugfix: absolute value of f must be used when calculating the Blackadar mixing length (init_1d_model)

advec_particles, check_parameters, combine_plot_fields, diffusion_s, diffusivities, init_ocean, init_1d_model, poisfft, production_e

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