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

    r1321 r1682  
    1  SUBROUTINE user_read_restart_data( i, nxlfa, nxl_on_file, nxrfa, nxr_on_file, &
    2                                     nynfa, nyn_on_file, nysfa, nys_on_file,    &
    3                                     offset_xa, offset_ya, overlap_count,       &
    4                                     tmp_2d, tmp_3d )
    5 
     1!> @file user_read_restart_data.f90
    62!--------------------------------------------------------------------------------!
    73! This file is part of PALM.
     
    2319! Current revisions:
    2420! -----------------
    25 !
     21! Code annotations made doxygen readable
    2622!
    2723! Former revisions:
     
    4743! Description:
    4844! ------------
    49 ! Reading restart data from file(s)
    50 ! Subdomain index limits on file are given by nxl_on_file, etc.
    51 ! Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
    52 ! subdomain on file (f) to the subdomain of the current PE (c). They have been
    53 ! calculated in routine read_3d_binary.
     45!> Reading restart data from file(s)
     46!> Subdomain index limits on file are given by nxl_on_file, etc.
     47!> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
     48!> subdomain on file (f) to the subdomain of the current PE (c). They have been
     49!> calculated in routine read_3d_binary.
    5450!------------------------------------------------------------------------------!
     51 SUBROUTINE user_read_restart_data( i, nxlfa, nxl_on_file, nxrfa, nxr_on_file, &
     52                                    nynfa, nyn_on_file, nysfa, nys_on_file,    &
     53                                    offset_xa, offset_ya, overlap_count,       &
     54                                    tmp_2d, tmp_3d )
     55 
    5556
    5657    USE control_parameters
     
    6667    IMPLICIT NONE
    6768
    68     CHARACTER (LEN=20) :: field_char   !:
     69    CHARACTER (LEN=20) :: field_char   !<
    6970
    70     INTEGER(iwp) ::  i               !:
    71     INTEGER(iwp) ::  k               !:
    72     INTEGER(iwp) ::  nxlc            !:
    73     INTEGER(iwp) ::  nxlf            !:
    74     INTEGER(iwp) ::  nxl_on_file     !:
    75     INTEGER(iwp) ::  nxrc            !:
    76     INTEGER(iwp) ::  nxrf            !:
    77     INTEGER(iwp) ::  nxr_on_file     !:
    78     INTEGER(iwp) ::  nync            !:
    79     INTEGER(iwp) ::  nynf            !:
    80     INTEGER(iwp) ::  nyn_on_file     !:
    81     INTEGER(iwp) ::  nysc            !:
    82     INTEGER(iwp) ::  nysf            !:
    83     INTEGER(iwp) ::  nys_on_file     !:
    84     INTEGER(iwp) ::  overlap_count   !:
     71    INTEGER(iwp) ::  i               !<
     72    INTEGER(iwp) ::  k               !<
     73    INTEGER(iwp) ::  nxlc            !<
     74    INTEGER(iwp) ::  nxlf            !<
     75    INTEGER(iwp) ::  nxl_on_file     !<
     76    INTEGER(iwp) ::  nxrc            !<
     77    INTEGER(iwp) ::  nxrf            !<
     78    INTEGER(iwp) ::  nxr_on_file     !<
     79    INTEGER(iwp) ::  nync            !<
     80    INTEGER(iwp) ::  nynf            !<
     81    INTEGER(iwp) ::  nyn_on_file     !<
     82    INTEGER(iwp) ::  nysc            !<
     83    INTEGER(iwp) ::  nysf            !<
     84    INTEGER(iwp) ::  nys_on_file     !<
     85    INTEGER(iwp) ::  overlap_count   !<
    8586
    86     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa       !:
    87     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxrfa       !:
    88     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nynfa       !:
    89     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nysfa       !:
    90     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_xa   !:
    91     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya   !:
     87    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa       !<
     88    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxrfa       !<
     89    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nynfa       !<
     90    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nysfa       !<
     91    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_xa   !<
     92    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya   !<
    9293
    9394    REAL(wp),                                                                  &
    9495       DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::&
    95           tmp_2d   !:
     96          tmp_2d   !<
    9697
    9798    REAL(wp),                                                                  &
    9899       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::&
    99           tmp_3d   !:
     100          tmp_3d   !<
    100101
    101102!
Note: See TracChangeset for help on using the changeset viewer.