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

Last change on this file since 1036 was 1036, checked in by raasch, 11 years ago

code has been put under the GNU General Public License (v3)

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