source: palm/trunk/SOURCE/palm.f90 @ 1167

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

last commit documented

  • Property svn:keywords set to Id
File size: 10.2 KB
Line 
1 PROGRAM palm
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: palm.f90 1114 2013-03-10 03:25:57Z raasch $
27!
28! 1113 2013-03-10 02:48:14Z raasch
29! openACC statements modified
30!
31! 1111 2013-03-08 23:54:10Z raasch
32! openACC statements updated
33!
34! 1092 2013-02-02 11:24:22Z raasch
35! unused variables removed
36!
37! 1036 2012-10-22 13:43:42Z raasch
38! code put under GPL (PALM 3.9)
39!
40! 1015 2012-09-27 09:23:24Z raasch
41! Version number changed from 3.8 to 3.8a.
42! OpenACC statements added + code changes required for GPU optimization
43!
44! 849 2012-03-15 10:35:09Z raasch
45! write_particles renamed lpm_write_restart_file
46!
47! 759 2011-09-15 13:58:31Z raasch
48! Splitting of parallel I/O, cpu measurement for write_3d_binary and opening
49! of unit 14 moved to here
50!
51! 495 2010-03-02 00:40:15Z raasch
52! Particle data for restart runs are only written if write_binary=.T..
53!
54! 215 2008-11-18 09:54:31Z raasch
55! Initialization of coupled runs modified for MPI-1 and moved to external
56! subroutine init_coupling
57!
58! 197 2008-09-16 15:29:03Z raasch
59! Workaround for getting information about the coupling mode
60!
61! 108 2007-08-24 15:10:38Z letzel
62! Get coupling mode from environment variable, change location of debug output
63!
64! 75 2007-03-22 09:54:05Z raasch
65! __vtk directives removed, write_particles is called only in case of particle
66! advection switched on, open unit 9 for debug output,
67! setting of palm version moved from modules to here
68!
69! RCS Log replace by Id keyword, revision history cleaned up
70!
71! Revision 1.10  2006/08/04 14:53:12  raasch
72! Distibution of run description header removed, call of header moved behind
73! init_3d_model
74!
75! Revision 1.2  2001/01/25 07:15:06  raasch
76! Program name changed to PALM, module test_variables removed.
77! Initialization of dvrp logging as well as exit of dvrp moved to new
78! subroutines init_dvrp_logging and close_dvrp (file init_dvrp.f90)
79!
80! Revision 1.1  1997/07/24 11:23:35  raasch
81! Initial revision
82!
83!
84! Description:
85! ------------
86! Large-Eddy Simulation (LES) model for the convective boundary layer,
87! optimized for use on parallel machines (implementation realized using the
88! Message Passing Interface (MPI)). The model can also be run on vector machines
89! (less well optimized) and workstations. Versions for the different types of
90! machines are controlled via cpp-directives.
91! Model runs are only feasible using the ksh-script mrun.
92!------------------------------------------------------------------------------!
93
94
95    USE arrays_3d
96    USE constants
97    USE control_parameters
98    USE cpulog
99    USE dvrp_variables
100    USE grid_variables
101    USE indices
102    USE interfaces
103    USE model_1d
104    USE particle_attributes
105    USE pegrid
106    USE spectrum
107    USE statistics
108
109#if defined( __openacc )
110    USE OPENACC
111#endif
112
113    IMPLICIT NONE
114
115!
116!-- Local variables
117    CHARACTER (LEN=9) ::  time_to_string
118    INTEGER           ::  i
119#if defined( __openacc )
120    REAL, DIMENSION(100) ::  acc_dum
121#endif
122
123    version = 'PALM 3.9'
124
125#if defined( __parallel )
126!
127!-- MPI initialisation. comm2d is preliminary set, because
128!-- it will be defined in init_pegrid but is used before in cpu_log.
129    CALL MPI_INIT( ierr )
130    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
131    CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
132    comm_palm = MPI_COMM_WORLD
133    comm2d    = MPI_COMM_WORLD
134
135!
136!-- Initialize PE topology in case of coupled runs
137    CALL init_coupling
138#endif
139
140#if defined( __openacc )
141!
142!-- Get the number of accelerator boards per node and assign the MPI processes
143!-- to these boards
144    PRINT*, '*** ACC_DEVICE_NVIDIA = ', ACC_DEVICE_NVIDIA
145    num_acc_per_node  = ACC_GET_NUM_DEVICES( ACC_DEVICE_NVIDIA )
146    IF ( numprocs == 1  .AND.  num_acc_per_node > 0 )  num_acc_per_node = 1
147    PRINT*, '*** myid = ', myid, ' num_acc_per_node = ', num_acc_per_node
148    acc_rank = MOD( myid, num_acc_per_node )
149!    STOP '****'
150    CALL ACC_SET_DEVICE_NUM ( acc_rank, ACC_DEVICE_NVIDIA )
151!
152!-- Test output (to be removed later)
153    WRITE (*,'(A,I4,A,I3,A,I3,A,I3)') '*** Connect MPI-Task ', myid,' to CPU ',&
154                                      acc_rank, ' Devices: ', num_acc_per_node,&
155                                      ' connected to:',                        &
156                                      ACC_GET_DEVICE_NUM( ACC_DEVICE_NVIDIA )
157#endif
158
159!
160!-- Ensure that OpenACC first attaches the GPU devices by copying a dummy data
161!-- region
162    !$acc data copyin( acc_dum )
163
164!
165!-- Initialize measuring of the CPU-time remaining to the run
166    CALL local_tremain_ini
167
168!
169!-- Start of total CPU time measuring.
170    CALL cpu_log( log_point(1), 'total', 'start' )
171    CALL cpu_log( log_point(2), 'initialisation', 'start' )
172
173!
174!-- Open a file for debug output
175    WRITE (myid_char,'(''_'',I4.4)')  myid
176    OPEN( 9, FILE='DEBUG'//TRIM( coupling_char )//myid_char, FORM='FORMATTED' )
177
178!
179!-- Initialize dvrp logging. Also, one PE maybe split from the global
180!-- communicator for doing the dvrp output. In that case, the number of
181!-- PEs available for PALM is reduced by one and communicator comm_palm
182!-- is changed respectively.
183#if defined( __parallel )
184    CALL MPI_COMM_RANK( comm_palm, myid, ierr )
185!
186!-- TEST OUTPUT (TO BE REMOVED)
187    WRITE(9,*) '*** coupling_mode = "', TRIM( coupling_mode ), '"'
188    CALL LOCAL_FLUSH( 9 )
189    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
190       PRINT*, '*** PE', myid, ' Global target PE:', target_id, &
191               TRIM( coupling_mode )
192    ENDIF
193#endif
194
195    CALL init_dvrp_logging
196
197!
198!-- Read control parameters from NAMELIST files and read environment-variables
199    CALL parin
200
201!
202!-- Determine processor topology and local array indices
203    CALL init_pegrid
204
205!
206!-- Generate grid parameters
207    CALL init_grid
208
209!
210!-- Check control parameters and deduce further quantities
211    CALL check_parameters
212
213
214!
215!-- Initialize all necessary variables
216    CALL init_3d_model
217
218!
219!-- Output of program header
220    IF ( myid == 0 )  CALL header
221
222    CALL cpu_log( log_point(2), 'initialisation', 'stop' )
223
224!
225!-- Set start time in format hh:mm:ss
226    simulated_time_chr = time_to_string( simulated_time )
227
228!
229!-- If required, output of initial arrays
230    IF ( do2d_at_begin )  THEN
231       CALL data_output_2d( 'xy', 0 )
232       CALL data_output_2d( 'xz', 0 )
233       CALL data_output_2d( 'yz', 0 )
234    ENDIF
235    IF ( do3d_at_begin )  THEN
236       CALL data_output_3d( 0 )
237    ENDIF
238
239!
240!-- Declare and initialize variables in the accelerator memory with their
241!-- host values
242    !$acc  data copyin( d, diss, e, e_p, kh, km, p, pt, pt_p, q, ql, tend, te_m, tpt_m, tu_m, tv_m, tw_m, u, u_p, v, vpt, v_p, w, w_p )          &
243    !$acc       copyin( tric, dzu, ddzu, ddzw, dd2zu, l_grid, l_wall, ptdf_x, ptdf_y, pt_init, rdf, rdf_sc, ug, u_init, vg, v_init, zu, zw )   &
244    !$acc       copyin( hom, qs, qsws, qswst, rif, rif_wall, shf, ts, tswst, us, usws, uswst, vsws, vswst, z0, z0h )      &
245    !$acc       copyin( fxm, fxp, fym, fyp, fwxm, fwxp, fwym, fwyp, nzb_diff_s_inner, nzb_diff_s_outer, nzb_diff_u )       &
246    !$acc       copyin( nzb_diff_v, nzb_s_inner, nzb_s_outer, nzb_u_inner )    &
247    !$acc       copyin( nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner )   &
248    !$acc       copyin( nzb_w_outer, wall_heatflux, wall_e_x, wall_e_y, wall_u, wall_v, wall_w_x, wall_w_y, wall_flags_0 )  &
249    !$acc       copyin( weight_pres, weight_substep )
250!
251!-- Integration of the model equations using timestep-scheme
252    CALL time_integration
253
254!
255!-- If required, write binary data for restart runs
256    IF ( write_binary(1:4) == 'true' )  THEN
257
258       CALL cpu_log( log_point(22), 'write_3d_binary', 'start' )
259
260       CALL check_open( 14 )
261
262       DO  i = 0, io_blocks-1
263          IF ( i == io_group )  THEN
264!
265!--          Write flow field data
266             CALL write_3d_binary
267          ENDIF
268#if defined( __parallel )
269          CALL MPI_BARRIER( comm2d, ierr )
270#endif
271       ENDDO
272
273       CALL cpu_log( log_point(22), 'write_3d_binary', 'stop' )
274
275!
276!--    If required, write particle data
277       IF ( particle_advection )  CALL lpm_write_restart_file
278    ENDIF
279
280!
281!-- If required, repeat output of header including the required CPU-time
282    IF ( myid == 0 )  CALL header
283!
284!-- If required, final user-defined actions, and
285!-- last actions on the open files and close files. Unit 14 was opened
286!-- in write_3d_binary but it is closed here, to allow writing on this
287!-- unit in routine user_last_actions.
288    CALL cpu_log( log_point(4), 'last actions', 'start' )
289    DO  i = 0, io_blocks-1
290       IF ( i == io_group )  THEN
291          CALL user_last_actions
292          IF ( write_binary(1:4) == 'true' )  CALL close_file( 14 )
293       ENDIF
294#if defined( __parallel )
295       CALL MPI_BARRIER( comm2d, ierr )
296#endif
297    ENDDO
298    CALL close_file( 0 )
299    CALL close_dvrp
300    CALL cpu_log( log_point(4), 'last actions', 'stop' )
301
302#if defined( __mpi2 )
303!
304!-- Test exchange via intercommunicator in case of a MPI-2 coupling
305    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
306       i = 12345 + myid
307       CALL MPI_SEND( i, 1, MPI_INTEGER, myid, 11, comm_inter, ierr )
308    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
309       CALL MPI_RECV( i, 1, MPI_INTEGER, myid, 11, comm_inter, status, ierr )
310       PRINT*, '### myid: ', myid, '   received from atmosphere:  i = ', i
311    ENDIF
312#endif
313
314!
315!-- Close the OpenACC dummy data region
316    !$acc end data
317    !$acc end data
318
319!
320!-- Take final CPU-time for CPU-time analysis
321    CALL cpu_log( log_point(1), 'total', 'stop' )
322    CALL cpu_statistics
323
324#if defined( __parallel )
325    CALL MPI_FINALIZE( ierr )
326#endif
327
328 END PROGRAM palm
Note: See TracBrowser for help on using the repository browser.