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/data_output_mask.f90

    r1319 r1320  
    4242! Bugfix: calculation of pr must depend on the particle weighting factor,
    4343! missing calculation of ql_vp added
    44 !
    45 ! 771 2011-10-27 10:56:21Z heinze
    46 ! +lpt
    47 !
    48 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    49 ! Calls of exchange_horiz are modified.
    50 !
    51 ! 564 2010-09-30 13:18:59Z helmke
    52 ! start number of mask output files changed to 201, netcdf message identifiers
    53 ! of masked output changed, palm message identifiers of masked output changed
    54 !
    55 ! 493 2010-03-01 08:30:24Z raasch
    56 ! netcdf_format_mask* and format_parallel_io replaced by netcdf_data_format
    57 !
    58 ! 475 2010-02-04 02:26:16Z raasch
    59 ! Bugfix in serial branch: arguments from array local_pf removed in N90_PUT_VAR
    6044!
    6145! 410 2009-12-04 17:05:40Z letzel
     
    6852
    6953#if defined( __netcdf )
    70     USE arrays_3d
    71     USE averaging
    72     USE cloud_parameters
    73     USE control_parameters
    74     USE cpulog
    75     USE grid_variables
    76     USE indices
     54    USE arrays_3d,                                                             &
     55        ONLY:  e, p, pt, q, ql, ql_c, ql_v, rho, sa, tend, u, v, vpt, w
     56   
     57    USE averaging,                                                             &
     58        ONLY:  e_av, lpt_av, p_av, pc_av, pr_av, pt_av, q_av, ql_av, ql_c_av,  &
     59               ql_v_av, ql_vp_av, qv_av, rho_av, s_av, sa_av, u_av, v_av,      &
     60               vpt_av, w_av
     61   
     62    USE cloud_parameters,                                                      &
     63        ONLY:  l_d_cp, pt_d_t
     64   
     65    USE control_parameters,                                                    &
     66        ONLY:  cloud_physics, domask, domask_no, domask_time_count, mask_i,    &
     67               mask_j, mask_k, mask_size, mask_size_l, mask_start_l,           &
     68               max_masks, message_string, mid, netcdf_data_format,             &
     69               netcdf_output, nz_do3d, simulated_time
     70   
     71    USE cpulog,                                                                &
     72        ONLY:  cpu_log, log_point
     73   
     74    USE indices,                                                               &
     75        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
     76       
     77    USE kinds
     78   
    7779    USE netcdf
     80   
    7881    USE netcdf_control
    79     USE particle_attributes
     82   
     83    USE particle_attributes,                                                   &
     84        ONLY:  particles, prt_count, prt_start_index
     85   
    8086    USE pegrid
    8187
    8288    IMPLICIT NONE
    8389
    84     INTEGER ::  av, ngp, i, if, j, k, n, psi, sender, &
    85                 ind(6)
    86     LOGICAL ::  found, resorted
    87     REAL    ::  mean_r, s_r3, s_r4
    88     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
     90    INTEGER(iwp) ::  av       !:
     91    INTEGER(iwp) ::  ngp      !:
     92    INTEGER(iwp) ::  i        !:
     93    INTEGER(iwp) ::  if       !:
     94    INTEGER(iwp) ::  j        !:
     95    INTEGER(iwp) ::  k        !:
     96    INTEGER(iwp) ::  n        !:
     97    INTEGER(iwp) ::  psi      !:
     98    INTEGER(iwp) ::  sender   !:
     99    INTEGER(iwp) ::  ind(6)   !:
     100   
     101    LOGICAL ::  found         !:
     102    LOGICAL ::  resorted      !:
     103   
     104    REAL(wp) ::  mean_r       !:
     105    REAL(wp) ::  s_r3         !:
     106    REAL(wp) ::  s_r4         !:
     107   
     108    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !:
    89109#if defined( __parallel )
    90     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  total_pf
    91 #endif
    92     REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
     110    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  total_pf    !:
     111#endif
     112    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !:
    93113
    94114!
Note: See TracChangeset for help on using the changeset viewer.