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

Last change on this file since 760 was 703, checked in by suehring, 13 years ago

Last commit documented.

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