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

Last change on this file since 1666 was 1666, checked in by raasch, 6 years ago

checking possible mismatch of current and required user interface revision

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