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

Last change on this file since 1671 was 1669, checked in by raasch, 9 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 13.4 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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: palm.f90 1669 2015-09-23 13:55:04Z raasch $
27!
28! 1668 2015-09-23 13:45:36Z raasch
29! warning replaced by abort in case of failed user interface check
30!
31! 1666 2015-09-23 07:31:10Z raasch
32! check for user's interface version added
33!
34! 1482 2014-10-18 12:34:45Z raasch
35! adjustments for using CUDA-aware OpenMPI
36!
37! 1468 2014-09-24 14:06:57Z maronga
38! Adapted for use on up to 6-digit processor cores
39!
40! 1402 2014-05-09 14:25:13Z raasch
41! location messages added
42!
43! 1374 2014-04-25 12:55:07Z raasch
44! bugfix: various modules added
45!
46! 1320 2014-03-20 08:40:49Z raasch
47! ONLY-attribute added to USE-statements,
48! kind-parameters added to all INTEGER and REAL declaration statements,
49! kinds are defined in new module kinds,
50! old module precision_kind is removed,
51! revision history before 2012 removed,
52! comment fields (!:) to be used for variable explanations added to
53! all variable declaration statements
54!
55! 1318 2014-03-17 13:35:16Z raasch
56! module interfaces removed
57!
58! 1241 2013-10-30 11:36:58Z heinze
59! initialization of nuding and large scale forcing from external file
60!
61! 1221 2013-09-10 08:59:13Z raasch
62! +wall_flags_00, rflags_invers, rflags_s_inner in copyin statement
63!
64! 1212 2013-08-15 08:46:27Z raasch
65! +tri in copyin statement
66!
67! 1179 2013-06-14 05:57:58Z raasch
68! ref_state added to copyin-list
69!
70! 1113 2013-03-10 02:48:14Z raasch
71! openACC statements modified
72!
73! 1111 2013-03-08 23:54:10Z raasch
74! openACC statements updated
75!
76! 1092 2013-02-02 11:24:22Z raasch
77! unused variables removed
78!
79! 1036 2012-10-22 13:43:42Z raasch
80! code put under GPL (PALM 3.9)
81!
82! 1015 2012-09-27 09:23:24Z raasch
83! Version number changed from 3.8 to 3.8a.
84! OpenACC statements added + code changes required for GPU optimization
85!
86! 849 2012-03-15 10:35:09Z raasch
87! write_particles renamed lpm_write_restart_file
88!
89! Revision 1.1  1997/07/24 11:23:35  raasch
90! Initial revision
91!
92!
93! Description:
94! ------------
95! Large-Eddy Simulation (LES) model for the convective boundary layer,
96! optimized for use on parallel machines (implementation realized using the
97! Message Passing Interface (MPI)). The model can also be run on vector machines
98! (less well optimized) and workstations. Versions for the different types of
99! machines are controlled via cpp-directives.
100! Model runs are only feasible using the ksh-script mrun.
101!------------------------------------------------------------------------------!
102
103    USE arrays_3d
104
105    USE control_parameters,                                                    &
106        ONLY:  coupling_char, coupling_mode, do2d_at_begin, do3d_at_begin,     &
107               io_blocks, io_group, large_scale_forcing, message_string,       &
108               nudging, simulated_time, simulated_time_chr,                    &
109               user_interface_current_revision,                                &
110               user_interface_required_revision, version, wall_heatflux,       &
111               write_binary
112
113    USE cpulog,                                                                &
114        ONLY:  cpu_log, log_point, cpu_statistics
115
116    USE grid_variables,                                                        &
117        ONLY:  fxm, fxp, fym, fyp, fwxm, fwxp, fwym, fwyp, wall_e_x, wall_e_y, &
118               wall_u, wall_v, wall_w_x, wall_w_y
119
120    USE indices,                                                               &
121        ONLY:  ngp_2dh, ngp_2dh_s_inner, nzb_diff_s_inner, nzb_diff_s_outer,   &
122               nzb_diff_u, nzb_diff_v, nzb_s_inner, nzb_s_outer, nzb_u_inner,  &
123               nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner,             &
124               nzb_w_outer, rflags_invers, rflags_s_inner, wall_flags_0,       &
125               wall_flags_00
126
127    USE kinds
128
129    USE ls_forcing_mod,                                                        &
130        ONLY:  init_ls_forcing
131
132    USE nudge_mod,                                                             &
133        ONLY:  init_nudge
134
135    USE particle_attributes,                                                   &
136        ONLY:  particle_advection
137
138    USE pegrid
139
140    USE statistics,                                                            &
141        ONLY:  hom, rmask, weight_pres, weight_substep
142
143#if defined( __openacc )
144    USE OPENACC
145#endif
146
147    IMPLICIT NONE
148
149!
150!-- Local variables
151    CHARACTER(LEN=9)  ::  time_to_string  !:
152    CHARACTER(LEN=10) ::  env_string      !: to store string of environment var
153    INTEGER(iwp)      ::  env_stat        !: to hold status of GET_ENV
154    INTEGER(iwp)      ::  i               !:
155    INTEGER(iwp)      ::  myid_openmpi    !: OpenMPI local rank for CUDA aware MPI
156#if defined( __openacc )
157    REAL(wp), DIMENSION(100) ::  acc_dum     !:
158#endif
159
160    version = 'PALM 4.0'
161    user_interface_required_revision = 'r1663'
162
163#if defined( __parallel )
164!
165!-- MPI initialisation. comm2d is preliminary set, because
166!-- it will be defined in init_pegrid but is used before in cpu_log.
167    CALL MPI_INIT( ierr )
168    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
169    CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
170    comm_palm = MPI_COMM_WORLD
171    comm2d    = MPI_COMM_WORLD
172
173!
174!-- Initialize PE topology in case of coupled runs
175    CALL init_coupling
176#endif
177
178#if defined( __openacc )
179!
180!-- Get the local MPI rank in case of CUDA aware OpenMPI. Important, if there
181!-- is more than one accelerator board on the node
182    CALL GET_ENVIRONMENT_VARIABLE('OMPI_COMM_WORLD_LOCAL_RANK',                &
183         VALUE=env_string, STATUS=env_stat )
184    READ( env_string, '(I1)' )  myid_openmpi
185    PRINT*, '### local_rank = ', myid_openmpi, '  status=',env_stat
186!
187!-- Get the number of accelerator boards per node and assign the MPI processes
188!-- to these boards
189    PRINT*, '*** ACC_DEVICE_NVIDIA = ', ACC_DEVICE_NVIDIA
190    num_acc_per_node  = ACC_GET_NUM_DEVICES( ACC_DEVICE_NVIDIA )
191    IF ( numprocs == 1  .AND.  num_acc_per_node > 0 )  num_acc_per_node = 1
192    PRINT*, '*** myid = ', myid_openmpi, ' num_acc_per_node = ', num_acc_per_node
193    acc_rank = MOD( myid_openmpi, num_acc_per_node )
194    CALL ACC_SET_DEVICE_NUM ( acc_rank, ACC_DEVICE_NVIDIA )
195!
196!-- Test output (to be removed later)
197    WRITE (*,'(A,I6,A,I3,A,I3,A,I3)') '*** Connect MPI-Task ', myid_openmpi,   &
198                                      ' to CPU ', acc_rank, ' Devices: ',      &
199                                      num_acc_per_node, ' connected to:',      &
200                                      ACC_GET_DEVICE_NUM( ACC_DEVICE_NVIDIA )
201#endif
202
203!
204!-- Ensure that OpenACC first attaches the GPU devices by copying a dummy data
205!-- region
206    !$acc data copyin( acc_dum )
207
208!
209!-- Initialize measuring of the CPU-time remaining to the run
210    CALL local_tremain_ini
211
212!
213!-- Start of total CPU time measuring.
214    CALL cpu_log( log_point(1), 'total', 'start' )
215    CALL cpu_log( log_point(2), 'initialisation', 'start' )
216
217!
218!-- Open a file for debug output
219    WRITE (myid_char,'(''_'',I6.6)')  myid
220    OPEN( 9, FILE='DEBUG'//TRIM( coupling_char )//myid_char, FORM='FORMATTED' )
221
222!
223!-- Initialize dvrp logging. Also, one PE maybe split from the global
224!-- communicator for doing the dvrp output. In that case, the number of
225!-- PEs available for PALM is reduced by one and communicator comm_palm
226!-- is changed respectively.
227#if defined( __parallel )
228    CALL MPI_COMM_RANK( comm_palm, myid, ierr )
229!
230!-- TEST OUTPUT (TO BE REMOVED)
231    WRITE(9,*) '*** coupling_mode = "', TRIM( coupling_mode ), '"'
232    CALL LOCAL_FLUSH( 9 )
233    IF ( TRIM( coupling_mode ) /= 'uncoupled' )  THEN
234       PRINT*, '*** PE', myid, ' Global target PE:', target_id, &
235               TRIM( coupling_mode )
236    ENDIF
237#endif
238
239    CALL init_dvrp_logging
240
241!
242!-- Read control parameters from NAMELIST files and read environment-variables
243    CALL parin
244
245!
246!-- Check for the user's interface version
247    IF ( user_interface_current_revision /= user_interface_required_revision )  &
248    THEN
249       message_string = 'current user-interface revision "' //                  &
250                        TRIM( user_interface_current_revision ) // '" does ' // &
251                        'not match the required revision ' //                   &
252                        TRIM( user_interface_required_revision )
253        CALL message( 'palm', 'PA0169', 1, 2, 0, 6, 0 )
254    ENDIF
255
256!
257!-- Determine processor topology and local array indices
258    CALL init_pegrid
259
260!
261!-- Generate grid parameters
262    CALL init_grid
263
264!
265!-- Initialize nudging if required
266    IF ( nudging )  THEN
267       CALL init_nudge
268    ENDIF
269
270!
271!-- Initialize reading of large scale forcing from external file - if required
272    IF ( large_scale_forcing )  THEN
273       CALL init_ls_forcing
274    ENDIF
275
276!
277!-- Check control parameters and deduce further quantities
278    CALL check_parameters
279
280!
281!-- Initialize all necessary variables
282    CALL init_3d_model
283
284!
285!-- Output of program header
286    IF ( myid == 0 )  CALL header
287
288    CALL cpu_log( log_point(2), 'initialisation', 'stop' )
289
290!
291!-- Set start time in format hh:mm:ss
292    simulated_time_chr = time_to_string( simulated_time )
293
294!
295!-- If required, output of initial arrays
296    IF ( do2d_at_begin )  THEN
297       CALL data_output_2d( 'xy', 0 )
298       CALL data_output_2d( 'xz', 0 )
299       CALL data_output_2d( 'yz', 0 )
300    ENDIF
301    IF ( do3d_at_begin )  THEN
302       CALL data_output_3d( 0 )
303    ENDIF
304
305!
306!-- Declare and initialize variables in the accelerator memory with their
307!-- host values
308    !$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 )          &
309    !$acc       copyin( tri, tric, dzu, ddzu, ddzw, dd2zu, l_grid, l_wall, ptdf_x, ptdf_y, pt_init, rdf, rdf_sc, ref_state, ug, u_init, vg, v_init, zu, zw )   &
310    !$acc       copyin( hom, qs, qsws, qswst, rif, rif_wall, shf, ts, tswst, us, usws, uswst, vsws, vswst, z0, z0h )      &
311    !$acc       copyin( fxm, fxp, fym, fyp, fwxm, fwxp, fwym, fwyp, nzb_diff_s_inner, nzb_diff_s_outer, nzb_diff_u )       &
312    !$acc       copyin( nzb_diff_v, nzb_s_inner, nzb_s_outer, nzb_u_inner )    &
313    !$acc       copyin( nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner )   &
314    !$acc       copyin( nzb_w_outer, rflags_invers, rflags_s_inner, rmask, wall_heatflux, wall_e_x, wall_e_y, wall_u, wall_v, wall_w_x, wall_w_y, wall_flags_0, wall_flags_00 )  &
315    !$acc       copyin( ngp_2dh, ngp_2dh_s_inner )  &
316    !$acc       copyin( weight_pres, weight_substep )
317!
318!-- Integration of the model equations using timestep-scheme
319    CALL time_integration
320
321!
322!-- If required, write binary data for restart runs
323    IF ( write_binary(1:4) == 'true' )  THEN
324
325       CALL cpu_log( log_point(22), 'write_3d_binary', 'start' )
326
327       CALL location_message( 'writing restart data', .FALSE. )
328
329       CALL check_open( 14 )
330
331       DO  i = 0, io_blocks-1
332          IF ( i == io_group )  THEN
333!
334!--          Write flow field data
335             CALL write_3d_binary
336          ENDIF
337#if defined( __parallel )
338          CALL MPI_BARRIER( comm2d, ierr )
339#endif
340       ENDDO
341
342       CALL location_message( 'finished', .TRUE. )
343
344       CALL cpu_log( log_point(22), 'write_3d_binary', 'stop' )
345
346!
347!--    If required, write particle data
348       IF ( particle_advection )  CALL lpm_write_restart_file
349    ENDIF
350
351!
352!-- If required, repeat output of header including the required CPU-time
353    IF ( myid == 0 )  CALL header
354!
355!-- If required, final user-defined actions, and
356!-- last actions on the open files and close files. Unit 14 was opened
357!-- in write_3d_binary but it is closed here, to allow writing on this
358!-- unit in routine user_last_actions.
359    CALL cpu_log( log_point(4), 'last actions', 'start' )
360    DO  i = 0, io_blocks-1
361       IF ( i == io_group )  THEN
362          CALL user_last_actions
363          IF ( write_binary(1:4) == 'true' )  CALL close_file( 14 )
364       ENDIF
365#if defined( __parallel )
366       CALL MPI_BARRIER( comm2d, ierr )
367#endif
368    ENDDO
369    CALL close_file( 0 )
370    CALL close_dvrp
371    CALL cpu_log( log_point(4), 'last actions', 'stop' )
372
373#if defined( __mpi2 )
374!
375!-- Test exchange via intercommunicator in case of a MPI-2 coupling
376    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
377       i = 12345 + myid
378       CALL MPI_SEND( i, 1, MPI_INTEGER, myid, 11, comm_inter, ierr )
379    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
380       CALL MPI_RECV( i, 1, MPI_INTEGER, myid, 11, comm_inter, status, ierr )
381       PRINT*, '### myid: ', myid, '   received from atmosphere:  i = ', i
382    ENDIF
383#endif
384
385!
386!-- Close the OpenACC dummy data region
387    !$acc end data
388    !$acc end data
389
390!
391!-- Take final CPU-time for CPU-time analysis
392    CALL cpu_log( log_point(1), 'total', 'stop' )
393    CALL cpu_statistics
394
395#if defined( __parallel )
396    CALL MPI_FINALIZE( ierr )
397#endif
398
399 END PROGRAM palm
Note: See TracBrowser for help on using the repository browser.