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

Code annotations made doxygen readable

File:
1 edited

Legend:

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

    r1586 r1682  
    1  SUBROUTINE data_output_mask( av )
    2 
     1!> @file 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:
     
    7170! Description:
    7271! ------------
    73 ! Masked data output in netCDF format for current mask (current value of mid).
     72!> Masked data output in netCDF format for current mask (current value of mid).
    7473!------------------------------------------------------------------------------!
     74 SUBROUTINE data_output_mask( av )
     75
     76 
    7577
    7678#if defined( __netcdf )
     
    118120    IMPLICIT NONE
    119121
    120     INTEGER(iwp) ::  av       !:
    121     INTEGER(iwp) ::  ngp      !:
    122     INTEGER(iwp) ::  i        !:
    123     INTEGER(iwp) ::  if       !:
    124     INTEGER(iwp) ::  j        !:
    125     INTEGER(iwp) ::  k        !:
    126     INTEGER(iwp) ::  n        !:
    127     INTEGER(iwp) ::  psi      !:
    128     INTEGER(iwp) ::  sender   !:
    129     INTEGER(iwp) ::  ind(6)   !:
    130    
    131     LOGICAL ::  found         !:
    132     LOGICAL ::  resorted      !:
    133    
    134     REAL(wp) ::  mean_r       !:
    135     REAL(wp) ::  s_r2         !:
    136     REAL(wp) ::  s_r3         !:
    137    
    138     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !:
     122    INTEGER(iwp) ::  av       !<
     123    INTEGER(iwp) ::  ngp      !<
     124    INTEGER(iwp) ::  i        !<
     125    INTEGER(iwp) ::  if       !<
     126    INTEGER(iwp) ::  j        !<
     127    INTEGER(iwp) ::  k        !<
     128    INTEGER(iwp) ::  n        !<
     129    INTEGER(iwp) ::  psi      !<
     130    INTEGER(iwp) ::  sender   !<
     131    INTEGER(iwp) ::  ind(6)   !<
     132   
     133    LOGICAL ::  found         !<
     134    LOGICAL ::  resorted      !<
     135   
     136    REAL(wp) ::  mean_r       !<
     137    REAL(wp) ::  s_r2         !<
     138    REAL(wp) ::  s_r3         !<
     139   
     140    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !<
    139141#if defined( __parallel )
    140     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  total_pf    !:
     142    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  total_pf    !<
    141143#endif
    142     REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !:
     144    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !<
    143145
    144146!
Note: See TracChangeset for help on using the changeset viewer.