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

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

User-defined spectra.

Bugfix: extra '*' removed in user_statistics sample code (user_interface).

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