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

Last change on this file since 150 was 148, checked in by letzel, 16 years ago

Small bugfixes in the user_interface.

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