[1] | 1 | SUBROUTINE swap_timelevel |
---|
| 2 | |
---|
[3] | 3 | !------------------------------------------------------------------------------! |
---|
[1] | 4 | ! Actual revisions: |
---|
| 5 | ! ----------------- |
---|
| 6 | ! |
---|
| 7 | ! |
---|
| 8 | ! Former revisions: |
---|
| 9 | ! ----------------- |
---|
[3] | 10 | ! $Id: swap_timelevel.f90 4 2007-02-13 11:33:16Z raasch $ |
---|
| 11 | ! RCS Log replace by Id keyword, revision history cleaned up |
---|
| 12 | ! |
---|
[1] | 13 | ! Revision 1.8 2004/01/28 15:28:18 raasch |
---|
| 14 | ! Swaping for Runge-Kutta schemes implemented |
---|
| 15 | ! |
---|
| 16 | ! Revision 1.1 2000/01/10 10:08:58 10:08:58 raasch (Siegfried Raasch) |
---|
| 17 | ! Initial revision |
---|
| 18 | ! |
---|
| 19 | ! |
---|
| 20 | ! Description: |
---|
| 21 | ! ------------ |
---|
| 22 | ! Swap of timelevels of variables after each timestep |
---|
[3] | 23 | !------------------------------------------------------------------------------! |
---|
[1] | 24 | |
---|
| 25 | USE arrays_3d |
---|
| 26 | USE cpulog |
---|
| 27 | USE interfaces |
---|
| 28 | USE control_parameters |
---|
| 29 | |
---|
| 30 | IMPLICIT NONE |
---|
| 31 | |
---|
| 32 | |
---|
| 33 | CALL cpu_log( log_point(28), 'swap_timelevel', 'start' ) |
---|
| 34 | |
---|
| 35 | ! |
---|
| 36 | !-- Incrementing timestep counter |
---|
| 37 | timestep_count = timestep_count + 1 |
---|
| 38 | |
---|
| 39 | ! |
---|
| 40 | !-- Swap of 3-level variables |
---|
| 41 | IF ( timestep_scheme(1:5) /= 'runge' ) THEN |
---|
| 42 | |
---|
| 43 | SELECT CASE ( MOD( timestep_count, 3 ) ) |
---|
| 44 | |
---|
| 45 | CASE ( 0 ) |
---|
| 46 | |
---|
| 47 | u_m => u_1; u => u_2; u_p => u_3 |
---|
| 48 | v_m => v_1; v => v_2; v_p => v_3 |
---|
| 49 | w_m => w_1; w => w_2; w_p => w_3 |
---|
| 50 | pt_m => pt_1; pt => pt_2; pt_p => pt_3 |
---|
| 51 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 52 | e_m => e_1; e => e_2; e_p => e_3 |
---|
| 53 | ENDIF |
---|
| 54 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 55 | q_m => q_1; q => q_2; q_p => q_3 |
---|
| 56 | ENDIF |
---|
| 57 | |
---|
| 58 | CASE ( 1 ) |
---|
| 59 | |
---|
| 60 | u_m => u_2; u => u_3; u_p => u_1 |
---|
| 61 | v_m => v_2; v => v_3; v_p => v_1 |
---|
| 62 | w_m => w_2; w => w_3; w_p => w_1 |
---|
| 63 | pt_m => pt_2; pt => pt_3; pt_p => pt_1 |
---|
| 64 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 65 | e_m => e_2; e => e_3; e_p => e_1 |
---|
| 66 | ENDIF |
---|
| 67 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 68 | q_m => q_2; q => q_3; q_p => q_1 |
---|
| 69 | ENDIF |
---|
| 70 | |
---|
| 71 | CASE ( 2 ) |
---|
| 72 | |
---|
| 73 | u_m => u_3; u => u_1; u_p => u_2 |
---|
| 74 | v_m => v_3; v => v_1; v_p => v_2 |
---|
| 75 | w_m => w_3; w => w_1; w_p => w_2 |
---|
| 76 | pt_m => pt_3; pt => pt_1; pt_p => pt_2 |
---|
| 77 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 78 | e_m => e_3; e => e_1; e_p => e_2 |
---|
| 79 | ENDIF |
---|
| 80 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 81 | q_m => q_3; q => q_1; q_p => q_2 |
---|
| 82 | ENDIF |
---|
| 83 | |
---|
| 84 | END SELECT |
---|
| 85 | |
---|
| 86 | ENDIF |
---|
| 87 | |
---|
| 88 | ! |
---|
| 89 | !-- Swap of 2-level variables |
---|
| 90 | SELECT CASE ( MOD( timestep_count, 2 ) ) |
---|
| 91 | |
---|
| 92 | CASE ( 0 ) |
---|
| 93 | |
---|
| 94 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
| 95 | |
---|
| 96 | u => u_1; u_p => u_2 |
---|
| 97 | v => v_1; v_p => v_2 |
---|
| 98 | w => w_1; w_p => w_2 |
---|
| 99 | pt => pt_1; pt_p => pt_2 |
---|
| 100 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 101 | e => e_1; e_p => e_2 |
---|
| 102 | ENDIF |
---|
| 103 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 104 | q => q_1; q_p => q_2 |
---|
| 105 | ENDIF |
---|
| 106 | |
---|
| 107 | ELSE |
---|
| 108 | ! |
---|
| 109 | !-- Old timelevels are needed for explicit diffusion within leapfrog |
---|
| 110 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 111 | kh_m => kh_1; kh => kh_2 |
---|
| 112 | km_m => km_1; km => km_2 |
---|
| 113 | IF ( use_surface_fluxes ) THEN |
---|
| 114 | usws_m => usws_1; usws => usws_2 |
---|
| 115 | vsws_m => vsws_1; vsws => vsws_2 |
---|
| 116 | shf_m => shf_1; shf => shf_2 |
---|
| 117 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 118 | qsws_m => qsws_1; qsws => qsws_2 |
---|
| 119 | ENDIF |
---|
| 120 | ENDIF |
---|
| 121 | IF ( prandtl_layer ) THEN |
---|
| 122 | rif_m => rif_1; rif => rif_2 |
---|
| 123 | ENDIF |
---|
| 124 | ENDIF |
---|
| 125 | |
---|
| 126 | IF ( moisture ) THEN |
---|
| 127 | vpt_m => vpt_1; vpt => vpt_2 |
---|
| 128 | ENDIF |
---|
| 129 | |
---|
| 130 | ENDIF |
---|
| 131 | |
---|
| 132 | CASE ( 1 ) |
---|
| 133 | |
---|
| 134 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
| 135 | |
---|
| 136 | u => u_2; u_p => u_1 |
---|
| 137 | v => v_2; v_p => v_1 |
---|
| 138 | w => w_2; w_p => w_1 |
---|
| 139 | pt => pt_2; pt_p => pt_1 |
---|
| 140 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 141 | e => e_2; e_p => e_1 |
---|
| 142 | ENDIF |
---|
| 143 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 144 | q => q_2; q_p => q_1 |
---|
| 145 | ENDIF |
---|
| 146 | |
---|
| 147 | ELSE |
---|
| 148 | |
---|
| 149 | IF ( .NOT. constant_diffusion ) THEN |
---|
| 150 | kh_m => kh_2; kh => kh_1 |
---|
| 151 | km_m => km_2; km => km_1 |
---|
| 152 | IF ( use_surface_fluxes ) THEN |
---|
| 153 | usws_m => usws_2; usws => usws_1 |
---|
| 154 | vsws_m => vsws_2; vsws => vsws_1 |
---|
| 155 | shf_m => shf_2; shf => shf_1 |
---|
| 156 | IF ( moisture .OR. passive_scalar ) THEN |
---|
| 157 | qsws_m => qsws_2; qsws => qsws_1 |
---|
| 158 | ENDIF |
---|
| 159 | ENDIF |
---|
| 160 | IF ( prandtl_layer ) THEN |
---|
| 161 | rif_m => rif_2; rif => rif_1 |
---|
| 162 | ENDIF |
---|
| 163 | ENDIF |
---|
| 164 | |
---|
| 165 | IF ( moisture ) THEN |
---|
| 166 | vpt_m => vpt_2; vpt => vpt_1 |
---|
| 167 | ENDIF |
---|
| 168 | |
---|
| 169 | ENDIF |
---|
| 170 | |
---|
| 171 | END SELECT |
---|
| 172 | |
---|
| 173 | CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' ) |
---|
| 174 | |
---|
| 175 | END SUBROUTINE swap_timelevel |
---|
| 176 | |
---|
| 177 | |
---|