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

    r1310 r1320  
    2323! Current revisions:
    2424! -----------------
     25! kind-parameters added to all INTEGER and REAL declaration statements,
     26! kinds are defined in new module kinds,
     27! old module precision_kind is removed,
     28! revision history before 2012 removed,
     29! comment fields (!:) to be used for variable explanations added to
     30! all variable declaration statements
     31!
    2532!
    2633! Former revisions:
     
    3037! 1036 2012-10-22 13:43:42Z raasch
    3138! code put under GPL (PALM 3.9)
    32 !
    33 ! 702 2011-03-24 19:33:15Z suehring
    34 ! nys-1, nyn+1, nxl-1, nxr+1 changed to nysg, nyng, nxlg, nxrg.
    35 !
    36 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    37 ! Allocation with nbgp
    38 !
    39 ! 583 2010-10-11 09:28:42Z heinze
    40 ! Bugfix: replace 'user_spectra' with 'user_read_restart_data' in call of
    41 ! message
    42 !
    43 ! 274 2009-03-26 15:11:21Z heinze
    44 ! Output of messages replaced by message handling routine.
    4539!
    4640! 220 2008-12-18 07:00:36Z raasch
     
    5953
    6054    USE control_parameters
     55       
    6156    USE indices
     57   
     58    USE kinds
     59   
    6260    USE pegrid
     61   
    6362    USE user
    6463
    6564    IMPLICIT NONE
    6665
    67     CHARACTER (LEN=20) :: field_char
     66    CHARACTER (LEN=20) :: field_char   !:
    6867
    69     INTEGER ::  i, k, nxlc, nxlf, nxl_on_file, nxrc, nxrf, nxr_on_file, nync, &
    70                 nynf, nyn_on_file, nysc, nysf, nys_on_file, overlap_count
     68    INTEGER(iwp) ::  i               !:
     69    INTEGER(iwp) ::  k               !:
     70    INTEGER(iwp) ::  nxlc            !:
     71    INTEGER(iwp) ::  nxlf            !:
     72    INTEGER(iwp) ::  nxl_on_file     !:
     73    INTEGER(iwp) ::  nxrc            !:
     74    INTEGER(iwp) ::  nxrf            !:
     75    INTEGER(iwp) ::  nxr_on_file     !:
     76    INTEGER(iwp) ::  nync            !:
     77    INTEGER(iwp) ::  nynf            !:
     78    INTEGER(iwp) ::  nyn_on_file     !:
     79    INTEGER(iwp) ::  nysc            !:
     80    INTEGER(iwp) ::  nysf            !:
     81    INTEGER(iwp) ::  nys_on_file     !:
     82    INTEGER(iwp) ::  overlap_count   !:
    7183
    72     INTEGER, DIMENSION(numprocs_previous_run,1000) ::  nxlfa, nxrfa, nynfa, &
    73                                                        nysfa, offset_xa, &
    74                                                        offset_ya
     84    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa       !:
     85    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxrfa       !:
     86    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nynfa       !:
     87    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nysfa       !:
     88    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_xa   !:
     89    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya   !:
    7590
    76     REAL, DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: &
    77           tmp_2d
     91    REAL(wp),                                                                  &
     92       DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::&
     93          tmp_2d   !:
    7894
    79     REAL, DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: &
    80           tmp_3d
     95    REAL(wp),                                                                  &
     96       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::&
     97          tmp_3d   !:
    8198
    8299!
     
    107124!                   ENDIF
    108125!                   IF ( k == 1 )  READ ( 13 )  tmp_3d
    109 !                   u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
     126!                   u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =           &
    110127!                                          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    111128!
    112129!                CASE DEFAULT
    113 !                   WRITE( message_string, * ) 'unknown variable named "',  &
    114 !                                         TRIM( field_char ), '" found in', &
     130!                   WRITE( message_string, * ) 'unknown variable named "',       &
     131!                                         TRIM( field_char ), '" found in',      &
    115132!                                         '&data from prior run on PE ', myid
    116133!                   CALL message( 'user_read_restart_data', 'UI0012', 1, 2, 0, 6, 0 )
Note: See TracChangeset for help on using the changeset viewer.