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

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

last commit documented

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