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

Last change on this file since 170 was 159, checked in by raasch, 16 years ago

bugfix of max_pr_user problem

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