Ignore:
Timestamp:
Mar 20, 2014 8:40:49 AM (10 years ago)
Author:
raasch
Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

File:
1 edited

Legend:

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

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! kind-parameters added to all INTEGER and REAL declaration statements,
     23! kinds are defined in new module kinds,
     24! revision history before 2012 removed,
     25! comment fields (!:) to be used for variable explanations added to
     26! all variable declaration statements
    2327!
    2428! Former revisions:
     
    4145
    4246    USE arrays_3d
     47
    4348    USE indices
     49
     50    USE kinds
     51
    4452    USE netcdf_control
     53
    4554    USE profil_parameter
     55
    4656    USE statistics
     57
    4758    USE user
    4859
    4960    IMPLICIT NONE
    5061
    51     CHARACTER (LEN=*) ::  unit, variable
     62    CHARACTER (LEN=*) ::  unit     !:
     63    CHARACTER (LEN=*) ::  variable !:
    5264
    53     INTEGER ::  index, var_count
    54 
     65    INTEGER(iwp) ::  user_pr_index !:
     66    INTEGER(iwp) ::  var_count     !:
    5567
    5668    SELECT CASE ( TRIM( variable ) )
     
    6274!--    to be performed have to be added in routine user_statistics.
    6375!--    The quantities are (internally) identified by a user-profile-number
    64 !--    (see variable "index" below). The first user-profile must be assigned
     76!--    (see variable "user_pr_index" below). The first user-profile must be assigned
    6577!--    the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
    6678!--    user-profile-numbers have also to be used in routine user_statistics!
    6779!       CASE ( 'u*v*' )                      ! quantity string as given in
    6880!                                            ! data_output_pr_user
    69 !          index = pr_palm + 1
    70 !          dopr_index(var_count)  = index    ! quantities' user-profile-number
     81!          user_pr_index = pr_palm + 1
     82!          dopr_index(var_count)  = user_pr_index    ! quantities' user-profile-number
    7183!          dopr_unit(var_count)   = 'm2/s2'  ! quantity unit
    72 !          hom(:,2,index,:)       = SPREAD( zu, 2, statistic_regions+1 )
     84!          hom(:,2,user_pr_index,:)       = SPREAD( zu, 2, statistic_regions+1 )
    7385!                                            ! grid on which the quantity is
    7486!                                            ! defined (use zu or zw)
Note: See TracChangeset for help on using the changeset viewer.