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

Last change on this file since 1320 was 1320, checked in by raasch, 7 years ago

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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