Ignore:
Timestamp:
May 22, 2007 3:46:47 PM (17 years ago)
Author:
raasch
Message:

Preliminary update for user defined profiles

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/user_interface.f90

    r86 r87  
    44! Actual revisions:
    55! -----------------
     6! Calculation and output of user-defined profiles: new routine
     7! user_check_data_output_pr, +data_output_pr_user, max_pr_user in userpar,
     8! routine user_statistics has got two more arguments
    69! Bugfix: field_chr renamed field_char
    710!
     
    5659
    5760    USE control_parameters
     61    USE pegrid
    5862    USE statistics
    5963    USE user
     
    6367    CHARACTER (LEN=80) ::  zeile
    6468
    65 
    66     NAMELIST /userpar/  data_output_user, region
     69    INTEGER ::  i, j
     70
     71
     72    NAMELIST /userpar/  data_output_pr_user, data_output_user, max_pr_user, &
     73                        region
    6774
    6875!
     
    8289    READ ( 11, userpar )
    8390    user_defined_namelist_found = .TRUE.
     91
     92!
     93!-- Determine the maximum number of user-profiles allowed to be calculated.
     94!-- This number may be (much) larger than num_user_profiles which only gives
     95!-- the number of user-defined profiles to be output.
     96    IF ( data_output_pr_user(1) /= ' '  .AND.  max_pr_user == 0 )  THEN
     97       max_pr_user = 100
     98    ENDIF
     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          num_user_profiles = num_user_profiles + 1
     112          i = i + 1
     113          j = j + 1
     114       ENDDO
     115    ENDIF
     116
     117    IF ( num_user_profiles > max_pr_user )  THEN
     118       IF ( myid == 0 )  THEN
     119          PRINT*, '+++ user_parin: number of user-defined profiles given by '
     120          PRINT*, '                data_output_pr_user (', num_user_profiles, &
     121                                   ') is larger than the allowed maximum'
     122          PRINT*, '                number of profiles: max_pr_user(', &
     123                                   max_pr_user, ')'
     124       ENDIF
     125       CALL local_stop
     126    ENDIF
    84127
    85128100 RETURN
     
    447490
    448491
    449  SUBROUTINE user_statistics( sr )
    450 
    451 !------------------------------------------------------------------------------!
    452 !
    453 ! Description:
    454 ! ------------
    455 ! Calculation of user-defined statistics
     492 SUBROUTINE user_statistics( mode, sr, tn )
     493
     494!------------------------------------------------------------------------------!
     495!
     496! Description:
     497! ------------
     498! Calculation of user-defined statistics, i.e. horizontally averaged profiles
     499! and time series.
    456500! This routine is called for every statistic region sr defined by the user,
    457501! but at least for the region "total domain" (sr=0).
    458 !------------------------------------------------------------------------------!
    459 
     502! See section 3.5.4 on how to define, calculate, and output user defined
     503! quantities.
     504!------------------------------------------------------------------------------!
     505
     506    USE arrays_3d
     507    USE indices
    460508    USE statistics
    461509    USE user
     
    463511    IMPLICIT NONE
    464512
    465     INTEGER ::  sr
    466 
    467 !
    468 !-- Sample on how to add values for the user-defined time series quantities.
    469 !-- These have to be defined before in routine user_init. This sample
    470 !-- creates two time series for the absolut values of the horizontal
    471 !-- velocities u and v.
    472 !    ts_value(dots_num_palm+1,sr) = ABS( u_max )
    473 !    ts_value(dots_num_palm+2,sr) = ABS( v_max )
     513    CHARACTER (LEN=*) ::  mode
     514
     515    INTEGER ::  i, j, k, sr, tn
     516
     517
     518    IF ( mode == 'profiles' )  THEN
     519
     520!
     521!--    Sample on how to calculate horizontally averaged profiles of user-
     522!--    defined quantities. Each quantity is identified by the index
     523!--    "pr_palm+#" where "#" is an integer starting from 1. These
     524!--    user-profile-numbers must also be assigned to the respective strings
     525!--    given by data_output_pr_user in routine user_check_data_output_pr.
     526!       !$OMP DO
     527!       DO  i = nxl, nxr
     528!          DO  j = nys, nyn
     529!             DO  k = nzb_s_outer(j,i)+1, nzt
     530!!
     531!!--             Sample on how to calculate the profile for vertical velocity
     532!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +       &
     533!                                                 w(k,j,i)               &
     534!                                                 * rmask(j,i,sr)
     535!!
     536!!--             Further profiles can be defined and calculated by increasing
     537!!--             the second index of array sums_l (replace ... appropriately)
     538!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... &
     539!                                         * rmask(j,i,sr)
     540!             ENDDO
     541!          ENDDO
     542!       ENDDO
     543
     544    ELSEIF ( mode == 'time_series' )  THEN
     545
     546!
     547!--    Sample on how to add values for the user-defined time series quantities.
     548!--    These have to be defined before in routine user_init. This sample
     549!--    creates two time series for the absolut values of the horizontal
     550!--    velocities u and v.
     551!       ts_value(dots_num_palm+1,sr) = ABS( u_max )
     552!       ts_value(dots_num_palm+2,sr) = ABS( v_max )
     553
     554    ENDIF
    474555
    475556 END SUBROUTINE user_statistics
     
    649730
    650731 END SUBROUTINE user_check_data_output
     732
     733
     734
     735 SUBROUTINE user_check_data_output_pr( variable, var_count, unit )
     736
     737!------------------------------------------------------------------------------!
     738!
     739! Description:
     740! ------------
     741! Set the unit of user defined profile output quantities. For those variables
     742! not recognized by the user, the parameter unit is set to "illegal", which
     743! tells the calling routine that the output variable is not defined and leads
     744! to a program abort.
     745!------------------------------------------------------------------------------!
     746
     747    USE arrays_3d
     748    USE indices
     749    USE netcdf_control
     750    USE profil_parameter
     751    USE statistics
     752    USE user
     753
     754    IMPLICIT NONE
     755
     756    CHARACTER (LEN=*) ::  unit, variable
     757
     758    INTEGER ::  index, var_count
     759
     760
     761    SELECT CASE ( TRIM( variable ) )
     762
     763!
     764!--    Uncomment and extend the following lines, if necessary.
     765!--    Add additional CASE statements depending on the number of quantities
     766!--    for which profiles are to be calculated. The respective calculations
     767!--    to be performed have to be added in routine user_statistics.
     768!--    The quantities are (internally) identified by a user-profile-number
     769!--    (see variable "index" below). The first user-profile must be assigned
     770!--    the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
     771!--    user-profile-numbers have also to be used in routine user_statistics!
     772!       CASE ( 'w_user' )                  ! quantity string as given in
     773!                                          ! data_output_pr_user
     774!          index = pr_palm + 1
     775!          dopr_index(var_count)  = index  ! the quantities' user-profile-number
     776!          dopr_unit(var_count)   = 'm/s'  ! quantity unit
     777!          hom(:,2,index,:)       = SPREAD( zw, 2, statistic_regions+1 )
     778!                                          ! grid on which the quantity is
     779!                                          ! defined (use zu or zw)
     780
     781       CASE DEFAULT
     782          unit = 'illegal'
     783
     784    END SELECT
     785
     786
     787 END SUBROUTINE user_check_data_output_pr
    651788
    652789
Note: See TracChangeset for help on using the changeset viewer.