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

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

update of GPL copyright

  • Property svn:keywords set to Id
File size: 4.5 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!
26! Former revisions:
27! -----------------
28! $Id: user_read_restart_data.f90 1310 2014-03-14 08:01:56Z raasch $
29!
30! 1036 2012-10-22 13:43:42Z raasch
31! 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.
45!
46! 220 2008-12-18 07:00:36Z raasch
47! reading mechanism revised (subdomain/total domain size can vary arbitrarily
48! between current and previous run),
49! former file user_interface.f90 split into one file per subroutine
50!
51! Description:
52! ------------
53! Reading restart data from file(s)
54! Subdomain index limits on file are given by nxl_on_file, etc.
55! Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
56! subdomain on file (f) to the subdomain of the current PE (c). They have been
57! calculated in routine read_3d_binary.
58!------------------------------------------------------------------------------!
59
60    USE control_parameters
61    USE indices
62    USE pegrid
63    USE user
64
65    IMPLICIT NONE
66
67    CHARACTER (LEN=20) :: field_char
68
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
71
72    INTEGER, DIMENSION(numprocs_previous_run,1000) ::  nxlfa, nxrfa, nynfa, &
73                                                       nysfa, offset_xa, &
74                                                       offset_ya
75
76    REAL, DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: &
77          tmp_2d
78
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
81
82!
83!-- Here the reading of user-defined restart data follows:
84!-- Sample for user-defined output
85!
86!    IF ( initializing_actions == 'read_restart_data' )  THEN
87!       READ ( 13 )  field_char
88!       DO  WHILE ( TRIM( field_char ) /= '*** end user ***' )
89!
90!          DO  k = 1, overlap_count
91!
92!             nxlf = nxlfa(i,k)
93!             nxlc = nxlfa(i,k) + offset_xa(i,k)
94!             nxrf = nxrfa(i,k)
95!             nxrc = nxrfa(i,k) + offset_xa(i,k)
96!             nysf = nysfa(i,k)
97!             nysc = nysfa(i,k) + offset_ya(i,k)
98!             nynf = nynfa(i,k)
99!             nync = nynfa(i,k) + offset_ya(i,k)
100!
101!
102!             SELECT CASE ( TRIM( field_char ) )
103!
104!                CASE ( 'u2_av' )
105!                   IF ( .NOT. ALLOCATED( u2_av ) ) THEN
106!                      ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
107!                   ENDIF
108!                   IF ( k == 1 )  READ ( 13 )  tmp_3d
109!                   u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
110!                                          tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
111!
112!                CASE DEFAULT
113!                   WRITE( message_string, * ) 'unknown variable named "',  &
114!                                         TRIM( field_char ), '" found in', &
115!                                         '&data from prior run on PE ', myid
116!                   CALL message( 'user_read_restart_data', 'UI0012', 1, 2, 0, 6, 0 )
117!
118!             END SELECT
119!
120!          ENDDO
121!
122!          READ ( 13 )  field_char
123!
124!       ENDDO
125!    ENDIF
126
127 END SUBROUTINE user_read_restart_data
128
Note: See TracBrowser for help on using the repository browser.