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

Last change on this file since 222 was 220, checked in by raasch, 15 years ago

some small bugfixes in user_module, user_read_restart_data, read_3d_binary, flow_statistics and mrun

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