Ignore:
Timestamp:
Oct 7, 2015 11:56:08 PM (9 years ago)
Author:
knoop
Message:

Code annotations made doxygen readable

File:
1 edited

Legend:

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

    r1321 r1682  
    1  SUBROUTINE user_data_output_mask( av, variable, found, local_pf )
    2 
     1!> @file user_data_output_mask.f90
    32!--------------------------------------------------------------------------------!
    43! This file is part of PALM.
     
    2019! Current revisions:
    2120! ------------------
    22 !
     21! Code annotations made doxygen readable
    2322!
    2423! Former revisions:
     
    3837! Description:
    3938! ------------
    40 ! Resorts the user-defined output quantity with indices (k,j,i) to a
    41 ! temporary array with indices (i,j,k) for masked data output.
     39!> Resorts the user-defined output quantity with indices (k,j,i) to a
     40!> temporary array with indices (i,j,k) for masked data output.
    4241!------------------------------------------------------------------------------!
     42 SUBROUTINE user_data_output_mask( av, variable, found, local_pf )
     43 
    4344
    4445    USE control_parameters
     
    5253    IMPLICIT NONE
    5354
    54     CHARACTER (LEN=*) ::  variable   !:
     55    CHARACTER (LEN=*) ::  variable   !<
    5556
    56     INTEGER(iwp) ::  av   !:
    57     INTEGER(iwp) ::  i    !:
    58     INTEGER(iwp) ::  j    !:
    59     INTEGER(iwp) ::  k    !:
     57    INTEGER(iwp) ::  av   !<
     58    INTEGER(iwp) ::  i    !<
     59    INTEGER(iwp) ::  j    !<
     60    INTEGER(iwp) ::  k    !<
    6061
    61     LOGICAL ::  found     !:
     62    LOGICAL ::  found     !<
    6263
    6364    REAL(wp),                                                                  &
    6465       DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  &
    65           local_pf   !:
     66          local_pf   !<
    6667
    6768
Note: See TracChangeset for help on using the changeset viewer.