source: palm/trunk/SOURCE/user_read_restart_data.f90 @ 1320

Last change on this file since 1320 was 1320, checked in by raasch, 10 years ago

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

  • Property svn:keywords set to Id
File size: 5.4 KB
Line 
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
6!--------------------------------------------------------------------------------!
7! This file is part of PALM.
8!
9! PALM is free software: you can redistribute it and/or modify it under the terms
10! of the GNU General Public License as published by the Free Software Foundation,
11! either version 3 of the License, or (at your option) any later version.
12!
13! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
14! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16!
17! You should have received a copy of the GNU General Public License along with
18! PALM. If not, see <http://www.gnu.org/licenses/>.
19!
20! Copyright 1997-2014 Leibniz Universitaet Hannover
21!--------------------------------------------------------------------------------!
22!
23! Current revisions:
24! -----------------
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!
32!
33! Former revisions:
34! -----------------
35! $Id: user_read_restart_data.f90 1320 2014-03-20 08:40:49Z raasch $
36!
37! 1036 2012-10-22 13:43:42Z raasch
38! code put under GPL (PALM 3.9)
39!
40! 220 2008-12-18 07:00:36Z raasch
41! reading mechanism revised (subdomain/total domain size can vary arbitrarily
42! between current and previous run),
43! former file user_interface.f90 split into one file per subroutine
44!
45! Description:
46! ------------
47! Reading restart data from file(s)
48! Subdomain index limits on file are given by nxl_on_file, etc.
49! Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
50! subdomain on file (f) to the subdomain of the current PE (c). They have been
51! calculated in routine read_3d_binary.
52!------------------------------------------------------------------------------!
53
54    USE control_parameters
55       
56    USE indices
57   
58    USE kinds
59   
60    USE pegrid
61   
62    USE user
63
64    IMPLICIT NONE
65
66    CHARACTER (LEN=20) :: field_char   !:
67
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   !:
83
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   !:
90
91    REAL(wp),                                                                  &
92       DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::&
93          tmp_2d   !:
94
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   !:
98
99!
100!-- Here the reading of user-defined restart data follows:
101!-- Sample for user-defined output
102!
103!    IF ( initializing_actions == 'read_restart_data' )  THEN
104!       READ ( 13 )  field_char
105!       DO  WHILE ( TRIM( field_char ) /= '*** end user ***' )
106!
107!          DO  k = 1, overlap_count
108!
109!             nxlf = nxlfa(i,k)
110!             nxlc = nxlfa(i,k) + offset_xa(i,k)
111!             nxrf = nxrfa(i,k)
112!             nxrc = nxrfa(i,k) + offset_xa(i,k)
113!             nysf = nysfa(i,k)
114!             nysc = nysfa(i,k) + offset_ya(i,k)
115!             nynf = nynfa(i,k)
116!             nync = nynfa(i,k) + offset_ya(i,k)
117!
118!
119!             SELECT CASE ( TRIM( field_char ) )
120!
121!                CASE ( 'u2_av' )
122!                   IF ( .NOT. ALLOCATED( u2_av ) ) THEN
123!                      ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
124!                   ENDIF
125!                   IF ( k == 1 )  READ ( 13 )  tmp_3d
126!                   u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =           &
127!                                          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
128!
129!                CASE DEFAULT
130!                   WRITE( message_string, * ) 'unknown variable named "',       &
131!                                         TRIM( field_char ), '" found in',      &
132!                                         '&data from prior run on PE ', myid
133!                   CALL message( 'user_read_restart_data', 'UI0012', 1, 2, 0, 6, 0 )
134!
135!             END SELECT
136!
137!          ENDDO
138!
139!          READ ( 13 )  field_char
140!
141!       ENDDO
142!    ENDIF
143
144 END SUBROUTINE user_read_restart_data
145
Note: See TracBrowser for help on using the repository browser.