source: palm/tags/release-3.5/SOURCE/user_interface.f90 @ 1887

Last change on this file since 1887 was 198, checked in by raasch, 16 years ago

file headers updated for the next release 3.5

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