source: palm/trunk/SOURCE/swap_timelevel.f90 @ 1017

Last change on this file since 1017 was 1011, checked in by raasch, 12 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 2.7 KB
Line 
1 SUBROUTINE swap_timelevel
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: swap_timelevel.f90 1011 2012-09-20 08:15:29Z raasch $
11!
12! 1010 2012-09-20 07:59:54Z raasch
13! cpp switch __nopointer added for pointer free version
14!
15! 1001 2012-09-13 14:08:46Z raasch
16! all actions concerning leapfrog scheme removed
17!
18! 102 2007-07-27 09:09:17Z raasch
19! swaping of uswst, vswst included
20!
21! 95 2007-06-02 16:48:38Z raasch
22! Swaping of salinity
23!
24! 75 2007-03-22 09:54:05Z raasch
25! moisture renamed humidity
26!
27! 19 2007-02-23 04:53:48Z raasch
28! Swaping of top fluxes
29!
30! RCS Log replace by Id keyword, revision history cleaned up
31!
32! Revision 1.8  2004/01/28 15:28:18  raasch
33! Swaping for Runge-Kutta schemes implemented
34!
35! Revision 1.1  2000/01/10  10:08:58  10:08:58  raasch (Siegfried Raasch)
36! Initial revision
37!
38!
39! Description:
40! ------------
41! Swap of timelevels of variables after each timestep
42!------------------------------------------------------------------------------!
43
44    USE arrays_3d
45    USE cpulog
46    USE interfaces
47    USE control_parameters
48
49    IMPLICIT NONE
50
51!
52!-- Incrementing timestep counter
53    timestep_count = timestep_count + 1
54
55!
56!-- Swap of variables
57#if defined( __nopointer )
58    CALL cpu_log( log_point(28), 'swap_timelevel (nop)', 'start' )
59
60    u  = u_p
61    v  = v_p
62    w  = w_p
63    pt = pt_p
64    IF ( .NOT. constant_diffusion )  THEN
65       e = e_p
66    ENDIF
67    IF ( ocean )  THEN
68       sa = sa_p
69    ENDIF
70    IF ( humidity  .OR.  passive_scalar )  THEN
71       q = q_p
72    ENDIF
73
74    CALL cpu_log( log_point(28), 'swap_timelevel (nop)', 'stop' )
75#else
76    CALL cpu_log( log_point(28), 'swap_timelevel', 'start' )
77
78    SELECT CASE ( MOD( timestep_count, 2 ) )
79
80       CASE ( 0 )
81
82          u  => u_1;   u_p  => u_2
83          v  => v_1;   v_p  => v_2
84          w  => w_1;   w_p  => w_2
85          pt => pt_1;  pt_p => pt_2
86          IF ( .NOT. constant_diffusion )  THEN
87             e => e_1;    e_p => e_2
88          ENDIF
89          IF ( ocean )  THEN
90             sa => sa_1;  sa_p => sa_2
91          ENDIF
92          IF ( humidity  .OR.  passive_scalar )  THEN
93             q => q_1;    q_p => q_2
94          ENDIF
95
96
97       CASE ( 1 )
98
99          u  => u_2;   u_p  => u_1
100          v  => v_2;   v_p  => v_1
101          w  => w_2;   w_p  => w_1
102          pt => pt_2;  pt_p => pt_1
103          IF ( .NOT. constant_diffusion )  THEN
104             e => e_2;    e_p => e_1
105          ENDIF
106          IF ( ocean )  THEN
107             sa => sa_2;  sa_p => sa_1
108          ENDIF
109          IF ( humidity  .OR.  passive_scalar )  THEN
110             q => q_2;    q_p => q_1
111          ENDIF
112
113
114    END SELECT
115
116    CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
117#endif
118
119 END SUBROUTINE swap_timelevel
120
121
Note: See TracBrowser for help on using the repository browser.