Home

Context Navigation

source: palm/trunk/SOURCE/tridia_solver.f90 @ 1532

Last change on this file since 1532 was 1407, checked in by raasch, 10 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 22.4 KB

Line
1	MODULE tridia_solver
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: tridia_solver.f90 1407 2014-05-16 14:06:08Z hoffmann $
27	!
28	! 1406 2014-05-16 13:47:01Z raasch
29	! bugfix for pgi 14.4: declare create moved after array declaration
30	!
31	! 1342 2014-03-26 17:04:47Z kanani
32	! REAL constants defined as wp-kind
33	!
34	! 1322 2014-03-20 16:38:49Z raasch
35	! REAL functions provided with KIND-attribute
36	!
37	! 1320 2014-03-20 08:40:49Z raasch
38	! ONLY-attribute added to USE-statements,
39	! kind-parameters added to all INTEGER and REAL declaration statements,
40	! kinds are defined in new module kinds,
41	! old module precision_kind is removed,
42	! revision history before 2012 removed,
43	! comment fields (!:) to be used for variable explanations added to
44	! all variable declaration statements
45	!
46	! 1257 2013-11-08 15:18:40Z raasch
47	! openacc loop and loop vector clauses removed, declare create moved after
48	! the FORTRAN declaration statement
49	!
50	! 1221 2013-09-10 08:59:13Z raasch
51	! dummy argument tri in 1d-routines replaced by tri_for_1d because of name
52	! conflict with arry tri in module arrays_3d
53	!
54	! 1216 2013-08-26 09:31:42Z raasch
55	! +tridia_substi_overlap for handling overlapping fft / transposition
56	!
57	! 1212 2013-08-15 08:46:27Z raasch
58	! Initial revision.
59	! Routines have been moved to seperate module from former file poisfft to here.
60	! The tridiagonal matrix coefficients of array tri are calculated only once at
61	! the beginning, i.e. routine split is called within tridia_init.
62	!
63	!
64	! Description:
65	! ------------
66	! solves the linear system of equations:
67	!
68	! -(4 pi^2(i^2/(dx^2nnx^2)+j^2/(dy^2nny^2))+
69	! 1/(dzu(k)dzw(k))+1/(dzu(k-1)dzw(k)))*p(i,j,k)+
70	! 1/(dzu(k)dzw(k))p(i,j,k+1)+1/(dzu(k-1)dzw(k))p(i,j,k-1)=d(i,j,k)
71	!
72	! by using the Thomas algorithm
73	!------------------------------------------------------------------------------!
74
75	USE indices, &
76	ONLY: nx, ny, nz
77
78	USE kinds
79
80	USE transpose_indices, &
81	ONLY: nxl_z, nyn_z, nxr_z, nys_z
82
83	IMPLICIT NONE
84
85	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddzuw !:
86
87	PRIVATE
88
89	INTERFACE tridia_substi
90	MODULE PROCEDURE tridia_substi
91	END INTERFACE tridia_substi
92
93	INTERFACE tridia_substi_overlap
94	MODULE PROCEDURE tridia_substi_overlap
95	END INTERFACE tridia_substi_overlap
96
97	PUBLIC tridia_substi, tridia_substi_overlap, tridia_init, tridia_1dd
98
99	CONTAINS
100
101
102	SUBROUTINE tridia_init
103
104	USE arrays_3d, &
105	ONLY: ddzu_pres, ddzw
106
107	USE kinds
108
109	IMPLICIT NONE
110
111	INTEGER(iwp) :: k !:
112
113	ALLOCATE( ddzuw(0:nz-1,3) )
114
115	DO k = 0, nz-1
116	ddzuw(k,1) = ddzu_pres(k+1) * ddzw(k+1)
117	ddzuw(k,2) = ddzu_pres(k+2) * ddzw(k+1)
118	ddzuw(k,3) = -1.0_wp * &
119	( ddzu_pres(k+2) * ddzw(k+1) + ddzu_pres(k+1) * ddzw(k+1) )
120	ENDDO
121	!
122	!-- Calculate constant coefficients of the tridiagonal matrix
123	#if ! defined ( __check )
124	CALL maketri
125	CALL split
126	#endif
127
128	END SUBROUTINE tridia_init
129
130
131	SUBROUTINE maketri
132
133	!------------------------------------------------------------------------------!
134	! Computes the i- and j-dependent component of the matrix
135	!------------------------------------------------------------------------------!
136
137	USE arrays_3d, &
138	ONLY: tric
139
140	USE constants, &
141	ONLY: pi
142
143	USE control_parameters, &
144	ONLY: ibc_p_b, ibc_p_t
145
146	USE grid_variables, &
147	ONLY: dx, dy
148
149
150	USE kinds
151
152	IMPLICIT NONE
153
154	INTEGER(iwp) :: i !:
155	INTEGER(iwp) :: j !:
156	INTEGER(iwp) :: k !:
157	INTEGER(iwp) :: nnxh !:
158	INTEGER(iwp) :: nnyh !:
159
160	REAL(wp) :: ll(nxl_z:nxr_z,nys_z:nyn_z) !:
161	!$acc declare create( ll )
162
163
164	nnxh = ( nx + 1 ) / 2
165	nnyh = ( ny + 1 ) / 2
166
167	!
168	!-- Provide the constant coefficients of the tridiagonal matrix for solution
169	!-- of the Poisson equation in Fourier space.
170	!-- The coefficients are computed following the method of
171	!-- Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
172	!-- Siano's original version by discretizing the Poisson equation,
173	!-- before it is Fourier-transformed.
174
175	!$acc kernels present( tric )
176	DO j = nys_z, nyn_z
177	DO i = nxl_z, nxr_z
178	IF ( j >= 0 .AND. j <= nnyh ) THEN
179	IF ( i >= 0 .AND. i <= nnxh ) THEN
180	ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) / &
181	REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
182	2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
183	REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
184	ELSE
185	ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) / &
186	REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
187	2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
188	REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
189	ENDIF
190	ELSE
191	IF ( i >= 0 .AND. i <= nnxh ) THEN
192	ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) / &
193	REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
194	2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) / &
195	REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
196	ELSE
197	ll(i,j) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) / &
198	REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + &
199	2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( ny+1-j ) ) / &
200	REAL( ny+1, KIND=wp ) ) ) / ( dy * dy )
201	ENDIF
202	ENDIF
203	ENDDO
204	ENDDO
205
206	DO k = 0, nz-1
207	DO j = nys_z, nyn_z
208	DO i = nxl_z, nxr_z
209	tric(i,j,k) = ddzuw(k,3) - ll(i,j)
210	ENDDO
211	ENDDO
212	ENDDO
213	!$acc end kernels
214
215	IF ( ibc_p_b == 1 ) THEN
216	!$acc kernels present( tric )
217	DO j = nys_z, nyn_z
218	DO i = nxl_z, nxr_z
219	tric(i,j,0) = tric(i,j,0) + ddzuw(0,1)
220	ENDDO
221	ENDDO
222	!$acc end kernels
223	ENDIF
224	IF ( ibc_p_t == 1 ) THEN
225	!$acc kernels present( tric )
226	DO j = nys_z, nyn_z
227	DO i = nxl_z, nxr_z
228	tric(i,j,nz-1) = tric(i,j,nz-1) + ddzuw(nz-1,2)
229	ENDDO
230	ENDDO
231	!$acc end kernels
232	ENDIF
233
234	END SUBROUTINE maketri
235
236
237	SUBROUTINE tridia_substi( ar )
238
239	!------------------------------------------------------------------------------!
240	! Substitution (Forward and Backward) (Thomas algorithm)
241	!------------------------------------------------------------------------------!
242
243	USE arrays_3d, &
244	ONLY: tri
245
246	USE control_parameters, &
247	ONLY: ibc_p_b, ibc_p_t
248
249	USE kinds
250
251	IMPLICIT NONE
252
253	INTEGER(iwp) :: i !:
254	INTEGER(iwp) :: j !:
255	INTEGER(iwp) :: k !:
256
257	REAL(wp) :: ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !:
258
259	REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) :: ar1 !:
260	!$acc declare create( ar1 )
261
262	!
263	!-- Forward substitution
264	DO k = 0, nz - 1
265	!$acc kernels present( ar, tri )
266	DO j = nys_z, nyn_z
267	DO i = nxl_z, nxr_z
268
269	IF ( k == 0 ) THEN
270	ar1(i,j,k) = ar(i,j,k+1)
271	ELSE
272	ar1(i,j,k) = ar(i,j,k+1) - tri(i,j,k,2) * ar1(i,j,k-1)
273	ENDIF
274
275	ENDDO
276	ENDDO
277	!$acc end kernels
278	ENDDO
279
280	!
281	!-- Backward substitution
282	!-- Note, the 1.0E-20 in the denominator is due to avoid divisions
283	!-- by zero appearing if the pressure bc is set to neumann at the top of
284	!-- the model domain.
285	DO k = nz-1, 0, -1
286	!$acc kernels present( ar, tri )
287	DO j = nys_z, nyn_z
288	DO i = nxl_z, nxr_z
289
290	IF ( k == nz-1 ) THEN
291	ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,j,k,1) + 1.0E-20_wp )
292	ELSE
293	ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) &
294	/ tri(i,j,k,1)
295	ENDIF
296	ENDDO
297	ENDDO
298	!$acc end kernels
299	ENDDO
300
301	!
302	!-- Indices i=0, j=0 correspond to horizontally averaged pressure.
303	!-- The respective values of ar should be zero at all k-levels if
304	!-- acceleration of horizontally averaged vertical velocity is zero.
305	IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN
306	IF ( nys_z == 0 .AND. nxl_z == 0 ) THEN
307	!$acc kernels loop present( ar )
308	DO k = 1, nz
309	ar(nxl_z,nys_z,k) = 0.0_wp
310	ENDDO
311	!$acc end kernels loop
312	ENDIF
313	ENDIF
314
315	END SUBROUTINE tridia_substi
316
317
318	SUBROUTINE tridia_substi_overlap( ar, jj )
319
320	!------------------------------------------------------------------------------!
321	! Substitution (Forward and Backward) (Thomas algorithm)
322	!------------------------------------------------------------------------------!
323
324	USE arrays_3d, &
325	ONLY: tri
326
327	USE control_parameters, &
328	ONLY: ibc_p_b, ibc_p_t
329
330	USE kinds
331
332	IMPLICIT NONE
333
334	INTEGER(iwp) :: i !:
335	INTEGER(iwp) :: j !:
336	INTEGER(iwp) :: jj !:
337	INTEGER(iwp) :: k !:
338
339	REAL(wp) :: ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !:
340
341	REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) :: ar1 !:
342	!$acc declare create( ar1 )
343
344	!
345	!-- Forward substitution
346	DO k = 0, nz - 1
347	!$acc kernels present( ar, tri )
348	!$acc loop
349	DO j = nys_z, nyn_z
350	DO i = nxl_z, nxr_z
351
352	IF ( k == 0 ) THEN
353	ar1(i,j,k) = ar(i,j,k+1)
354	ELSE
355	ar1(i,j,k) = ar(i,j,k+1) - tri(i,jj,k,2) * ar1(i,j,k-1)
356	ENDIF
357
358	ENDDO
359	ENDDO
360	!$acc end kernels
361	ENDDO
362
363	!
364	!-- Backward substitution
365	!-- Note, the 1.0E-20 in the denominator is due to avoid divisions
366	!-- by zero appearing if the pressure bc is set to neumann at the top of
367	!-- the model domain.
368	DO k = nz-1, 0, -1
369	!$acc kernels present( ar, tri )
370	!$acc loop
371	DO j = nys_z, nyn_z
372	DO i = nxl_z, nxr_z
373
374	IF ( k == nz-1 ) THEN
375	ar(i,j,k+1) = ar1(i,j,k) / ( tri(i,jj,k,1) + 1.0E-20_wp )
376	ELSE
377	ar(i,j,k+1) = ( ar1(i,j,k) - ddzuw(k,2) * ar(i,j,k+2) ) &
378	/ tri(i,jj,k,1)
379	ENDIF
380	ENDDO
381	ENDDO
382	!$acc end kernels
383	ENDDO
384
385	!
386	!-- Indices i=0, j=0 correspond to horizontally averaged pressure.
387	!-- The respective values of ar should be zero at all k-levels if
388	!-- acceleration of horizontally averaged vertical velocity is zero.
389	IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN
390	IF ( nys_z == 0 .AND. nxl_z == 0 ) THEN
391	!$acc kernels loop present( ar )
392	DO k = 1, nz
393	ar(nxl_z,nys_z,k) = 0.0_wp
394	ENDDO
395	ENDIF
396	ENDIF
397
398	END SUBROUTINE tridia_substi_overlap
399
400
401	SUBROUTINE split
402
403	!------------------------------------------------------------------------------!
404	! Splitting of the tridiagonal matrix (Thomas algorithm)
405	!------------------------------------------------------------------------------!
406
407	USE arrays_3d, &
408	ONLY: tri, tric
409
410	USE kinds
411
412	IMPLICIT NONE
413
414	INTEGER(iwp) :: i !:
415	INTEGER(iwp) :: j !:
416	INTEGER(iwp) :: k !:
417	!
418	!-- Splitting
419	!$acc kernels present( tri, tric )
420	!$acc loop
421	DO j = nys_z, nyn_z
422	!$acc loop vector( 32 )
423	DO i = nxl_z, nxr_z
424	tri(i,j,0,1) = tric(i,j,0)
425	ENDDO
426	ENDDO
427	!$acc end kernels
428
429	DO k = 1, nz-1
430	!$acc kernels present( tri, tric )
431	!$acc loop
432	DO j = nys_z, nyn_z
433	!$acc loop vector( 32 )
434	DO i = nxl_z, nxr_z
435	tri(i,j,k,2) = ddzuw(k,1) / tri(i,j,k-1,1)
436	tri(i,j,k,1) = tric(i,j,k) - ddzuw(k-1,2) * tri(i,j,k,2)
437	ENDDO
438	ENDDO
439	!$acc end kernels
440	ENDDO
441
442	END SUBROUTINE split
443
444
445	SUBROUTINE tridia_1dd( ddx2, ddy2, nx, ny, j, ar, tri_for_1d )
446
447	!------------------------------------------------------------------------------!
448	! Solves the linear system of equations for a 1d-decomposition along x (see
449	! tridia)
450	!
451	! Attention: when using the intel compilers older than 12.0, array tri must
452	! be passed as an argument to the contained subroutines. Otherwise
453	! addres faults will occur. This feature can be activated with
454	! cpp-switch __intel11
455	! On NEC, tri should not be passed (except for routine substi_1dd)
456	! because this causes very bad performance.
457	!------------------------------------------------------------------------------!
458
459	USE arrays_3d, &
460	ONLY: ddzu_pres, ddzw
461
462	USE control_parameters, &
463	ONLY: ibc_p_b, ibc_p_t
464
465	USE kinds
466
467	IMPLICIT NONE
468
469	INTEGER(iwp) :: i !:
470	INTEGER(iwp) :: j !:
471	INTEGER(iwp) :: k !:
472	INTEGER(iwp) :: nnyh !:
473	INTEGER(iwp) :: nx !:
474	INTEGER(iwp) :: ny !:
475	INTEGER(iwp) :: omp_get_thread_num !:
476	INTEGER(iwp) :: tn !:
477
478	REAL(wp) :: ddx2 !:
479	REAL(wp) :: ddy2 !:
480
481	REAL(wp), DIMENSION(0:nx,1:nz) :: ar !:
482	REAL(wp), DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d !:
483
484
485	nnyh = ( ny + 1 ) / 2
486
487	!
488	!-- Define constant elements of the tridiagonal matrix.
489	!-- The compiler on SX6 does loop exchange. If 0:nx is a high power of 2,
490	!-- the exchanged loops create bank conflicts. The following directive
491	!-- prohibits loop exchange and the loops perform much better.
492	! tn = omp_get_thread_num()
493	! WRITE( 120+tn, * ) '+++ id=',myid,' nx=',nx,' thread=', omp_get_thread_num()
494	! CALL local_flush( 120+tn )
495	!CDIR NOLOOPCHG
496	DO k = 0, nz-1
497	DO i = 0,nx
498	tri_for_1d(2,i,k) = ddzu_pres(k+1) * ddzw(k+1)
499	tri_for_1d(3,i,k) = ddzu_pres(k+2) * ddzw(k+1)
500	ENDDO
501	ENDDO
502	! WRITE( 120+tn, * ) '+++ id=',myid,' end of first tridia loop thread=', omp_get_thread_num()
503	! CALL local_flush( 120+tn )
504
505	IF ( j <= nnyh ) THEN
506	#if defined( __intel11 )
507	CALL maketri_1dd( j, tri_for_1d )
508	#else
509	CALL maketri_1dd( j )
510	#endif
511	ELSE
512	#if defined( __intel11 )
513	CALL maketri_1dd( ny+1-j, tri_for_1d )
514	#else
515	CALL maketri_1dd( ny+1-j )
516	#endif
517	ENDIF
518	#if defined( __intel11 )
519	CALL split_1dd( tri_for_1d )
520	#else
521	CALL split_1dd
522	#endif
523	CALL substi_1dd( ar, tri_for_1d )
524
525	CONTAINS
526
527	#if defined( __intel11 )
528	SUBROUTINE maketri_1dd( j, tri_for_1d )
529	#else
530	SUBROUTINE maketri_1dd( j )
531	#endif
532
533	!------------------------------------------------------------------------------!
534	! computes the i- and j-dependent component of the matrix
535	!------------------------------------------------------------------------------!
536
537	USE constants, &
538	ONLY: pi
539
540	USE kinds
541
542	IMPLICIT NONE
543
544	INTEGER(iwp) :: i !:
545	INTEGER(iwp) :: j !:
546	INTEGER(iwp) :: k !:
547	INTEGER(iwp) :: nnxh !:
548
549	REAL(wp) :: a !:
550	REAL(wp) :: c !:
551
552	REAL(wp), DIMENSION(0:nx) :: l !:
553
554	#if defined( __intel11 )
555	REAL(wp), DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d !:
556	#endif
557
558
559	nnxh = ( nx + 1 ) / 2
560	!
561	!-- Provide the tridiagonal matrix for solution of the Poisson equation in
562	!-- Fourier space. The coefficients are computed following the method of
563	!-- Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
564	!-- Siano's original version by discretizing the Poisson equation,
565	!-- before it is Fourier-transformed
566	DO i = 0, nx
567	IF ( i >= 0 .AND. i <= nnxh ) THEN
568	l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * i ) / &
569	REAL( nx+1, KIND=wp ) ) ) * ddx2 + &
570	2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
571	REAL( ny+1, KIND=wp ) ) ) * ddy2
572	ELSE
573	l(i) = 2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * ( nx+1-i ) ) / &
574	REAL( nx+1, KIND=wp ) ) ) * ddx2 + &
575	2.0_wp * ( 1.0_wp - COS( ( 2.0_wp * pi * j ) / &
576	REAL( ny+1, KIND=wp ) ) ) * ddy2
577	ENDIF
578	ENDDO
579
580	DO k = 0, nz-1
581	DO i = 0, nx
582	a = -1.0_wp * ddzu_pres(k+2) * ddzw(k+1)
583	c = -1.0_wp * ddzu_pres(k+1) * ddzw(k+1)
584	tri_for_1d(1,i,k) = a + c - l(i)
585	ENDDO
586	ENDDO
587	IF ( ibc_p_b == 1 ) THEN
588	DO i = 0, nx
589	tri_for_1d(1,i,0) = tri_for_1d(1,i,0) + tri_for_1d(2,i,0)
590	ENDDO
591	ENDIF
592	IF ( ibc_p_t == 1 ) THEN
593	DO i = 0, nx
594	tri_for_1d(1,i,nz-1) = tri_for_1d(1,i,nz-1) + tri_for_1d(3,i,nz-1)
595	ENDDO
596	ENDIF
597
598	END SUBROUTINE maketri_1dd
599
600
601	#if defined( __intel11 )
602	SUBROUTINE split_1dd( tri_for_1d )
603	#else
604	SUBROUTINE split_1dd
605	#endif
606
607	!------------------------------------------------------------------------------!
608	! Splitting of the tridiagonal matrix (Thomas algorithm)
609	!------------------------------------------------------------------------------!
610
611	IMPLICIT NONE
612
613	INTEGER(iwp) :: i !:
614	INTEGER(iwp) :: k !:
615
616	#if defined( __intel11 )
617	REAL(wp), DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d !:
618	#endif
619
620
621	!
622	!-- Splitting
623	DO i = 0, nx
624	tri_for_1d(4,i,0) = tri_for_1d(1,i,0)
625	ENDDO
626	DO k = 1, nz-1
627	DO i = 0, nx
628	tri_for_1d(5,i,k) = tri_for_1d(2,i,k) / tri_for_1d(4,i,k-1)
629	tri_for_1d(4,i,k) = tri_for_1d(1,i,k) - tri_for_1d(3,i,k-1) * tri_for_1d(5,i,k)
630	ENDDO
631	ENDDO
632
633	END SUBROUTINE split_1dd
634
635
636	SUBROUTINE substi_1dd( ar, tri_for_1d )
637
638	!------------------------------------------------------------------------------!
639	! Substitution (Forward and Backward) (Thomas algorithm)
640	!------------------------------------------------------------------------------!
641
642	IMPLICIT NONE
643
644	INTEGER(iwp) :: i !:
645	INTEGER(iwp) :: k !:
646
647	REAL(wp), DIMENSION(0:nx,nz) :: ar !:
648	REAL(wp), DIMENSION(0:nx,0:nz-1) :: ar1 !:
649	REAL(wp), DIMENSION(5,0:nx,0:nz-1) :: tri_for_1d !:
650
651	!
652	!-- Forward substitution
653	DO i = 0, nx
654	ar1(i,0) = ar(i,1)
655	ENDDO
656	DO k = 1, nz-1
657	DO i = 0, nx
658	ar1(i,k) = ar(i,k+1) - tri_for_1d(5,i,k) * ar1(i,k-1)
659	ENDDO
660	ENDDO
661
662	!
663	!-- Backward substitution
664	!-- Note, the add of 1.0E-20 in the denominator is due to avoid divisions
665	!-- by zero appearing if the pressure bc is set to neumann at the top of
666	!-- the model domain.
667	DO i = 0, nx
668	ar(i,nz) = ar1(i,nz-1) / ( tri_for_1d(4,i,nz-1) + 1.0E-20_wp )
669	ENDDO
670	DO k = nz-2, 0, -1
671	DO i = 0, nx
672	ar(i,k+1) = ( ar1(i,k) - tri_for_1d(3,i,k) * ar(i,k+2) ) &
673	/ tri_for_1d(4,i,k)
674	ENDDO
675	ENDDO
676
677	!
678	!-- Indices i=0, j=0 correspond to horizontally averaged pressure.
679	!-- The respective values of ar should be zero at all k-levels if
680	!-- acceleration of horizontally averaged vertical velocity is zero.
681	IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN
682	IF ( j == 0 ) THEN
683	DO k = 1, nz
684	ar(0,k) = 0.0_wp
685	ENDDO
686	ENDIF
687	ENDIF
688
689	END SUBROUTINE substi_1dd
690
691	END SUBROUTINE tridia_1dd
692
693
694	END MODULE tridia_solver

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |