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

    r1490 r1682  
    1  MODULE subsidence_mod
    2 
     1!> @file subsidence.f90
    32!--------------------------------------------------------------------------------!
    43! This file is part of PALM.
     
    2019! Current revisions:
    2120! -----------------
    22 !
     21! Code annotations made doxygen readable
    2322!
    2423! Former revisions:
     
    6261! Description:
    6362! ------------
    64 ! Impact of large-scale subsidence or ascent as tendency term for use
    65 ! in the prognostic equation of potential temperature. This enables the
    66 ! construction of a constant boundary layer height z_i with time.
     63!> Impact of large-scale subsidence or ascent as tendency term for use
     64!> in the prognostic equation of potential temperature. This enables the
     65!> construction of a constant boundary layer height z_i with time.
    6766!-----------------------------------------------------------------------------!
     67 MODULE subsidence_mod
     68 
    6869
    6970
     
    8485 CONTAINS
    8586
     87!------------------------------------------------------------------------------!
     88! Description:
     89! ------------
     90!> @todo Missing subroutine description.
     91!------------------------------------------------------------------------------!
    8692    SUBROUTINE init_w_subsidence
    8793
     
    100106       IMPLICIT NONE
    101107
    102        INTEGER(iwp) ::  i !:
    103        INTEGER(iwp) ::  k !:
    104 
    105        REAL(wp)     ::  gradient   !:
    106        REAL(wp)     ::  ws_surface !:
     108       INTEGER(iwp) ::  i !<
     109       INTEGER(iwp) ::  k !<
     110
     111       REAL(wp)     ::  gradient   !<
     112       REAL(wp)     ::  ws_surface !<
    107113
    108114       IF ( .NOT. ALLOCATED( w_subs ))  THEN
     
    156162
    157163
     164!------------------------------------------------------------------------------!
     165! Description:
     166! ------------
     167!> @todo Missing subroutine description.
     168!------------------------------------------------------------------------------!
    158169    SUBROUTINE subsidence( tendency, var, var_init, ls_index )
    159170
     
    176187       IMPLICIT NONE
    177188 
    178        INTEGER(iwp) ::  i !:
    179        INTEGER(iwp) ::  j !:
    180        INTEGER(iwp) ::  k !:
    181        INTEGER(iwp) ::  ls_index !:
    182 
    183        REAL(wp)     ::  tmp_tend !:
    184        REAL(wp)     ::  tmp_grad !:
     189       INTEGER(iwp) ::  i !<
     190       INTEGER(iwp) ::  j !<
     191       INTEGER(iwp) ::  k !<
     192       INTEGER(iwp) ::  ls_index !<
     193
     194       REAL(wp)     ::  tmp_tend !<
     195       REAL(wp)     ::  tmp_grad !<
    185196   
    186        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
    187        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
    188        REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
    189        REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
     197       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !<
     198       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !<
     199       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !<
     200       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !<
    190201
    191202       var_mod = var_init
     
    257268 END SUBROUTINE subsidence
    258269
     270!------------------------------------------------------------------------------!
     271! Description:
     272! ------------
     273!> @todo Missing subroutine description.
     274!------------------------------------------------------------------------------!
    259275 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index )
    260276
     
    276292       IMPLICIT NONE
    277293 
    278        INTEGER(iwp) ::  i !:
    279        INTEGER(iwp) ::  j !:
    280        INTEGER(iwp) ::  k !:
    281        INTEGER(iwp) ::  ls_index !:
    282 
    283        REAL(wp)     ::  tmp_tend !:
    284        REAL(wp)     ::  tmp_grad !:
     294       INTEGER(iwp) ::  i !<
     295       INTEGER(iwp) ::  j !<
     296       INTEGER(iwp) ::  k !<
     297       INTEGER(iwp) ::  ls_index !<
     298
     299       REAL(wp)     ::  tmp_tend !<
     300       REAL(wp)     ::  tmp_grad !<
    285301   
    286        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !:
    287        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !:
    288        REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !:
    289        REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !:
     302       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var      !<
     303       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  tendency !<
     304       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_init                     !<
     305       REAL(wp), DIMENSION(nzb:nzt+1) ::  var_mod                      !<
    290306
    291307       var_mod = var_init
Note: See TracChangeset for help on using the changeset viewer.