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

Last change on this file since 3911 was 110, checked in by raasch, 16 years ago

New:
---
Allows runs for a coupled atmosphere-ocean LES,
coupling frequency is controlled by new d3par-parameter dt_coupling,
the coupling mode (atmosphere_to_ocean or ocean_to_atmosphere) for the
respective processes is read from environment variable coupling_mode,
which is set by the mpiexec-command,
communication between the two models is done using the intercommunicator
comm_inter,
local files opened by the ocean model get the additional suffic "_O".
Assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean.

A momentum flux can be set as top boundary condition using the new
inipar parameter top_momentumflux_u|v.

Non-cyclic boundary conditions can be used along all horizontal directions.

Quantities w*p* and w"e can be output as vertical profiles.

Initial profiles are reset to constant profiles in case that initializing_actions /= 'set_constant_profiles'. (init_rankine)

Optionally calculate km and kh from initial TKE e_init.

Changed:


Remaining variables iran changed to iran_part (advec_particles, init_particles).

In case that the presure solver is not called for every Runge-Kutta substep
(call_psolver_at_all_substeps = .F.), it is called after the first substep
instead of the last. In that case, random perturbations are also added to the
velocity field after the first substep.

Initialization of km,kh = 0.00001 for ocean = .T. (for ocean = .F. it remains 0.01).

Allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of cloud_physics = .T.).

Errors:


Bugs from code parts for non-cyclic boundary conditions are removed: loops for
u and v are starting from index nxlu, nysv, respectively. The radiation boundary
condition is used for every Runge-Kutta substep. Velocity phase speeds for
the radiation boundary conditions are calculated for the first Runge-Kutta
substep only and reused for the further substeps. New arrays c_u, c_v, and c_w
are defined for this purpose. Several index errors are removed from the
radiation boundary condition code parts. Upper bounds for calculating
u_0 and v_0 (in production_e) are nxr+1 and nyn+1 because otherwise these
values are not available in case of non-cyclic boundary conditions.

+dots_num_palm in module user, +module netcdf_control in user_init (both in user_interface)

Bugfix: wrong sign removed from the buoyancy production term in the case use_reference = .T. (production_e)

Bugfix: Error message concerning output of particle concentration (pc) modified (check_parameters).

Bugfix: Rayleigh damping for ocean fixed.

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