- Timestamp:
- Jun 9, 2017 11:57:32 AM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
Makefile (modified) (2 diffs)
-
read_3d_binary.f90 (modified) (4 diffs)
-
surface_mod.f90 (modified) (5 diffs)
-
urban_surface_mod.f90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r2263 r2269 25 25 # ----------------- 26 26 # $Id$ 27 # Add dependency in read_3d_binary 28 # 29 # 2263 2017-06-08 14:59:01Z schwenkel 27 30 # Implemented splitting and merging algorithm 28 31 # … … 590 593 read_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o \ 591 594 land_surface_model_mod.o radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \ 592 spectra_mod.o surface_mod.o 595 spectra_mod.o surface_mod.o urban_surface_mod.o 593 596 read_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o \ 594 597 spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o -
palm/trunk/SOURCE/read_3d_binary.f90
r2233 r2269 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable restart runs for urban_surface_mod 28 ! 29 ! 2233 2017-05-30 18:08:54Z suehring 27 30 ! 28 31 ! 2232 2017-05-30 17:47:52Z suehring … … 132 135 USE control_parameters, & 133 136 ONLY: iran, land_surface, message_string, outflow_l, outflow_n, & 134 outflow_r, outflow_s 137 outflow_r, outflow_s, urban_surface 135 138 136 139 USE cpulog, & … … 165 168 USE surface_mod, & 166 169 ONLY : surface_read_restart_data 170 171 USE urban_surface_mod, & 172 ONLY: usm_read_restart_data 167 173 168 174 IMPLICIT NONE … … 1012 1018 nys_on_file, offset_xa, offset_ya, & 1013 1019 overlap_count(i), tmp_2d ) 1020 1021 ENDIF 1022 1023 ! 1024 !-- Read land surface restart data 1025 IF ( urban_surface ) THEN 1026 CALL usm_read_restart_data( i, nxlfa, nxl_on_file, nxrfa, & 1027 nxr_on_file, nynfa, nyn_on_file, nysfa, & 1028 nys_on_file, offset_xa, offset_ya, & 1029 overlap_count(i) ) 1014 1030 ENDIF 1015 1031 -
palm/trunk/SOURCE/surface_mod.f90
r2256 r2269 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Formatting and description adjustments 28 ! 29 ! 2256 2017-06-07 13:58:08Z suehring 27 30 ! Enable heating at downward-facing surfaces 28 31 ! … … 33 36 ! Description: 34 37 ! ------------ 35 !> Surface module containsdefines derived data structures to treat surface-38 !> Surface module defines derived data structures to treat surface- 36 39 !> bounded grid cells. Three different types of surfaces are defined: 37 !> default surfaces, natural surfaces, and urban surfaces. Moreover, the module38 !> encompasses the initialization of near-surface grid cells, and handles reading39 !> and writing restart data.40 !> default surfaces, natural surfaces, and urban surfaces. The module 41 !> encompasses the allocation and initialization of surface arrays, and handles 42 !> reading and writing restart data. 40 43 !> In addition, a further derived data structure is defined, in order to set 41 !> boundary conditions at surfaces. 44 !> boundary conditions at surfaces. 42 45 !------------------------------------------------------------------------------! 43 46 MODULE surface_mod … … 1602 1605 IMPLICIT NONE 1603 1606 1604 CHARACTER(LEN=1) :: dum 1605 1606 INTEGER(iwp) :: i 1607 INTEGER(iwp) :: j 1608 INTEGER(iwp) :: l 1609 INTEGER(iwp) :: m 1610 INTEGER(iwp), DIMENSION(0:3) :: mm 1611 1612 TYPE(surf_type), DIMENSION(0:2) :: surf_h 1613 TYPE(surf_type), DIMENSION(0:3) :: surf_v 1607 CHARACTER(LEN=1) :: dum !< dummy string to create output-variable name 1608 1609 INTEGER(iwp) :: i !< running index x-direction 1610 INTEGER(iwp) :: j !< running index y-direction 1611 INTEGER(iwp) :: l !< index surface type orientation 1612 INTEGER(iwp) :: m !< running index for surface elements on individual surface array 1613 INTEGER(iwp), DIMENSION(0:3) :: mm !< running index for surface elements on gathered surface array 1614 1615 TYPE(surf_type), DIMENSION(0:2) :: surf_h !< gathered horizontal surfaces, contains all surface types 1616 TYPE(surf_type), DIMENSION(0:3) :: surf_v !< gathered vertical surfaces, contains all surface types 1614 1617 1615 1618 ! … … 2088 2091 !> respective surface types within this routine. This allows e.g. changing the 2089 2092 !> surface type after reading the restart data, which might be required in case 2090 !> of cyclic -filling a simulation.2093 !> of cyclic_fill mode. 2091 2094 !------------------------------------------------------------------------------! 2092 2095 SUBROUTINE surface_read_restart_data( ii, & … … 2135 2138 2136 2139 LOGICAL :: horizontal_surface !< flag indicating horizontal surfaces 2137 LOGICAL :: vertical_surface !< flag indicating vertical surfaces2138 2140 LOGICAL :: surf_match_def !< flag indicating that surface element is of default type 2139 2141 LOGICAL :: surf_match_lsm !< flag indicating that surface element is of natural type 2140 2142 LOGICAL :: surf_match_usm !< flag indicating that surface element is of urban type 2143 LOGICAL :: vertical_surface !< flag indicating vertical surfaces 2141 2144 2142 2145 TYPE(surf_type), DIMENSION(0:2) :: surf_h !< horizontal surface type on file -
palm/trunk/SOURCE/urban_surface_mod.f90
r2258 r2269 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Enable restart runs with different number of PEs 29 ! Bugfixes nopointer branch 30 ! 31 ! 2258 2017-06-08 07:55:13Z suehring 28 32 ! Bugfix, add pre-preprocessor directives to enable non-parrallel mode 29 33 ! … … 113 117 !> 1.2 Km/s, which seem to be not realistic. 114 118 !> 119 !> @todo Revise flux conversion in energy-balance solver 120 !> @todo Bugfixing in nopointer branch 115 121 !> @todo Check optimizations for RMA operations 116 122 !> @todo Alternatives for MPI_WIN_ALLOCATE? (causes problems with openmpi) … … 513 519 SAVE 514 520 515 PRIVATE 521 PRIVATE 516 522 517 523 !-- Public parameters, constants and initial values … … 959 965 !-- allocate wall and roof temperature arrays, for horizontal walls 960 966 #if defined( __nopointer ) 961 ALLOCATE ( t_surf_h(1:surf_usm_h%ns) ) 962 ALLOCATE ( t_surf_h_p(1:surf_usm_h%ns) ) 963 ALLOCATE ( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 964 ALLOCATE ( t_wall_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 965 966 ALLOCATE ( t_surf_h(1:surf_usm_h%ns) ) 967 ALLOCATE ( t_surf_h_p(1:surf_usm_h%ns) ) 968 ALLOCATE ( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 969 ALLOCATE ( t_wall_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 967 IF ( .NOT. ALLOCATED( t_surf_h ) ) & 968 ALLOCATE ( t_surf_h(1:surf_usm_h%ns) ) 969 IF ( .NOT. ALLOCATED( t_surf_h_p ) ) & 970 ALLOCATE ( t_surf_h_p(1:surf_usm_h%ns) ) 971 IF ( .NOT. ALLOCATED( t_wall_h ) ) & 972 ALLOCATE ( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 973 IF ( .NOT. ALLOCATED( t_wall_h_p ) ) & 974 ALLOCATE ( t_wall_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 970 975 #else 971 ALLOCATE ( t_surf_h_1(1:surf_usm_h%ns) ) 972 ALLOCATE ( t_surf_h_2(1:surf_usm_h%ns) ) 973 ALLOCATE ( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 974 ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 975 976 ! 977 !-- Allocate if required. Note, in case of restarts, some of these arrays 978 !-- might be already allocated. 979 IF ( .NOT. ALLOCATED( t_surf_h_1 ) ) & 980 ALLOCATE ( t_surf_h_1(1:surf_usm_h%ns) ) 981 IF ( .NOT. ALLOCATED( t_surf_h_2 ) ) & 982 ALLOCATE ( t_surf_h_2(1:surf_usm_h%ns) ) 983 IF ( .NOT. ALLOCATED( t_wall_h_1 ) ) & 984 ALLOCATE ( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 985 IF ( .NOT. ALLOCATED( t_wall_h_2 ) ) & 986 ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 987 ! 976 988 !-- initial assignment of the pointers 977 989 t_wall_h => t_wall_h_1; t_wall_h_p => t_wall_h_2 978 t_surf_h => t_surf_h_1; t_surf_h_p => t_surf_h_2 990 t_surf_h => t_surf_h_1; t_surf_h_p => t_surf_h_2 979 991 #endif 980 992 981 !-- allocate wall and roof temperature arrays, for vertical walls 993 !-- allocate wall and roof temperature arrays, for vertical walls if required 982 994 #if defined( __nopointer ) 983 995 DO l = 0, 3 984 ALLOCATE ( t_surf_v(l)%t(1:surf_usm_v(l)%ns) ) 985 ALLOCATE ( t_surf_v(l)%t_p(1:surf_usm_v(l)%ns) ) 986 ALLOCATE ( t_wall_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 987 ALLOCATE ( t_wall_v(l)%t_p(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 996 IF ( .NOT. ALLOCATED( t_surf_v(l)%t ) ) & 997 ALLOCATE ( t_surf_v(l)%t(1:surf_usm_v(l)%ns) ) 998 IF ( .NOT. ALLOCATED( t_surf_v_p(l)%t ) ) & 999 ALLOCATE ( t_surf_v_p(l)%t(1:surf_usm_v(l)%ns) ) 1000 IF ( .NOT. ALLOCATED( t_wall_v(l)%t ) ) & 1001 ALLOCATE ( t_wall_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 1002 IF ( .NOT. ALLOCATED( t_wall_v_p(l)%t ) ) & 1003 ALLOCATE ( t_wall_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 988 1004 ENDDO 989 1005 #else 1006 ! 1007 !-- Allocate if required. Note, in case of restarts, some of these arrays 1008 !-- might be already allocated. 990 1009 DO l = 0, 3 991 ALLOCATE ( t_surf_v_1(l)%t(1:surf_usm_v(l)%ns) ) 992 ALLOCATE ( t_surf_v_2(l)%t(1:surf_usm_v(l)%ns) ) 993 ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 994 ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 1010 IF ( .NOT. ALLOCATED( t_surf_v_1(l)%t ) ) & 1011 ALLOCATE ( t_surf_v_1(l)%t(1:surf_usm_v(l)%ns) ) 1012 IF ( .NOT. ALLOCATED( t_surf_v_2(l)%t ) ) & 1013 ALLOCATE ( t_surf_v_2(l)%t(1:surf_usm_v(l)%ns) ) 1014 IF ( .NOT. ALLOCATED( t_wall_v_1(l)%t ) ) & 1015 ALLOCATE ( t_wall_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 1016 IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) ) & 1017 ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 995 1018 ENDDO 996 1019 ! … … 3199 3222 3200 3223 !-- Initialization for restart runs 3201 IF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN 3202 3203 !-- restore data from restart file 3204 CALL usm_read_restart_data() 3205 ELSE 3224 IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. & 3225 TRIM( initializing_actions ) /= 'cyclic_fill' ) THEN 3206 3226 3207 3227 !-- Calculate initial surface temperature from pt of adjacent gridbox … … 4153 4173 ! So, I added some directives here. 4154 4174 !------------------------------------------------------------------------------! 4155 SUBROUTINE usm_read_restart_data 4156 4157 4175 SUBROUTINE usm_read_restart_data( ii, & 4176 nxlfa, nxl_on_file, nxrfa, nxr_on_file, & 4177 nynfa, nyn_on_file, nysfa, nys_on_file, & 4178 offset_xa, offset_ya, overlap_count ) 4179 4180 4181 USE pegrid, & 4182 ONLY: numprocs_previous_run 4183 4158 4184 IMPLICIT NONE 4185 4186 CHARACTER (LEN=1) :: dum !< dummy to create correct string for reading input variable 4187 CHARACTER (LEN=30) :: field_chr !< input variable 4188 4189 INTEGER(iwp) :: l !< index variable for surface type 4190 INTEGER(iwp) :: ii !< running index over input files 4191 INTEGER(iwp) :: kk !< running index over previous input files covering current local domain 4192 INTEGER(iwp) :: ns_h_on_file_usm !< number of horizontal surface elements (urban type) on file 4193 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 4194 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 4195 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 4196 INTEGER(iwp) :: nxrc !< index of right boundary on current subdomain 4197 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 4198 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 4199 INTEGER(iwp) :: nync !< index of north boundary on current subdomain 4200 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 4201 INTEGER(iwp) :: nyn_on_file !< index of norht boundary on former local domain 4202 INTEGER(iwp) :: nysc !< index of south boundary on current subdomain 4203 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 4204 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 4205 INTEGER(iwp) :: overlap_count !< number of overlaps 4159 4206 4160 CHARACTER (LEN=30) :: variable_chr !< dummy variable to read string 4207 INTEGER(iwp) :: ns_v_on_file_usm(0:3) !< number of vertical surface elements (urban type) on file 4208 4209 INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) :: nxlfa !< 4210 INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) :: nxrfa !< 4211 INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) :: nynfa !< 4212 INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) :: nysfa !< 4213 INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) :: offset_xa !< 4214 INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) :: offset_ya !< 4161 4215 4162 INTEGER(iwp) :: i !< running index 4163 4164 4165 DO i = 0, io_blocks-1 4166 IF ( i == io_group ) THEN 4167 READ ( 13 ) variable_chr 4168 DO WHILE ( TRIM( variable_chr ) /= '*** end usm ***' ) 4169 4170 SELECT CASE ( TRIM( variable_chr ) ) 4216 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: start_index_on_file 4217 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: end_index_on_file 4218 4219 REAL(wp), DIMENSION(:), ALLOCATABLE :: tmp_surf_h 4220 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp_wall_h 4221 4222 TYPE( t_surf_vertical ), DIMENSION(0:3) :: tmp_surf_v 4223 TYPE( t_wall_vertical ), DIMENSION(0:3) :: tmp_wall_v 4224 4225 4226 IF ( initializing_actions == 'read_restart_data' .OR. & 4227 initializing_actions == 'cyclic_fill' ) THEN 4228 4229 ! 4230 !-- Read number of respective surface elements on file 4231 READ ( 13 ) field_chr 4232 IF ( TRIM( field_chr ) /= 'ns_h_on_file_usm' ) THEN 4233 ! 4234 !-- Add a proper error message 4235 ENDIF 4236 READ ( 13 ) ns_h_on_file_usm 4237 4238 READ ( 13 ) field_chr 4239 IF ( TRIM( field_chr ) /= 'ns_v_on_file_usm' ) THEN 4240 ! 4241 !-- Add a proper error message 4242 ENDIF 4243 READ ( 13 ) ns_v_on_file_usm 4244 ! 4245 !-- Allocate temporary arrays for reading data on file. Note, the 4246 !-- size of allocated surface elements do not necessarily need to match 4247 !-- the size of present surface elements on current processor, as the 4248 !-- number of processors between restarts can change. 4249 ALLOCATE( tmp_surf_h(1:ns_h_on_file_usm) ) 4250 ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) ) 4251 4252 DO l = 0, 3 4253 ALLOCATE( tmp_surf_v(l)%t(1:ns_v_on_file_usm(l)) ) 4254 ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) ) 4255 ENDDO 4256 4257 4258 READ ( 13 ) field_chr 4259 4260 DO WHILE ( TRIM( field_chr ) /= '*** end usm ***' ) 4261 ! 4262 !-- Map data on file as often as needed (data are read only for k=1) 4263 DO kk = 1, overlap_count 4264 ! 4265 !-- Get the index range of the subdomain on file which overlap with the 4266 !-- current subdomain 4267 nxlf = nxlfa(ii,kk) 4268 nxlc = nxlfa(ii,kk) + offset_xa(ii,kk) 4269 nxrf = nxrfa(ii,kk) 4270 nxrc = nxrfa(ii,kk) + offset_xa(ii,kk) 4271 nysf = nysfa(ii,kk) 4272 nysc = nysfa(ii,kk) + offset_ya(ii,kk) 4273 nynf = nynfa(ii,kk) 4274 nync = nynfa(ii,kk) + offset_ya(ii,kk) 4275 4276 SELECT CASE ( TRIM( field_chr ) ) 4277 4278 CASE ( 'usm_start_index_h', 'usm_start_index_v' ) 4279 IF ( kk == 1 ) & 4280 READ ( 13 ) start_index_on_file 4281 4282 CASE ( 'usm_end_index_h', 'usm_end_index_v' ) 4283 IF ( kk == 1 ) & 4284 READ ( 13 ) end_index_on_file 4171 4285 4172 4286 CASE ( 't_surf_h' ) 4173 4287 #if defined( __nopointer ) 4174 IF ( .NOT. ALLOCATED( t_surf_h ) ) & 4175 ALLOCATE( t_surf_h(1:surf_usm_h%ns) ) 4176 READ ( 13 ) t_surf_h 4288 IF ( kk == 1 ) THEN 4289 IF ( .NOT. ALLOCATED( t_surf_h ) ) & 4290 ALLOCATE( t_surf_h(1:surf_usm_h%ns) ) 4291 READ ( 13 ) tmp_surf_h 4292 ENDIF 4293 CALL restore_surface_elements_usm_1d( & 4294 t_surf_h, tmp_surf_h, & 4295 surf_usm_h%start_index ) 4296 ENDIF 4177 4297 #else 4178 IF ( .NOT. ALLOCATED( t_surf_h_1 ) ) & 4179 ALLOCATE( t_surf_h_1(1:surf_usm_h%ns) ) 4180 READ ( 13 ) t_surf_h_1 4298 IF ( kk == 1 ) THEN 4299 IF ( .NOT. ALLOCATED( t_surf_h_1 ) ) & 4300 ALLOCATE( t_surf_h_1(1:surf_usm_h%ns) ) 4301 READ ( 13 ) tmp_surf_h 4302 ENDIF 4303 CALL restore_surface_elements_usm_1d( & 4304 t_surf_h_1, tmp_surf_h, & 4305 surf_usm_h%start_index ) 4181 4306 #endif 4307 4182 4308 CASE ( 't_surf_v(0)' ) 4183 #if defined( __nopointer ) 4184 IF ( .NOT. ALLOCATED( t_surf_v(0)%t ) ) & 4185 ALLOCATE( t_surf_v(0)%t(1:surf_usm_v(0)%ns) ) 4186 READ ( 13 ) t_surf_v(0)%t 4309 #if defined( __nopointer ) 4310 IF ( kk == 1 ) THEN 4311 IF ( .NOT. ALLOCATED( t_surf_v(0)%t ) ) & 4312 ALLOCATE( t_surf_v(0)%t(1:surf_usm_v(0)%ns) ) 4313 READ ( 13 ) tmp_surf_v(0)%t 4314 ENDIF 4315 CALL restore_surface_elements_usm_1d( & 4316 t_surf_v(0)%t, tmp_surf_v(0)%t, & 4317 surf_usm_v(0)%start_index ) 4318 ENDIF 4187 4319 #else 4188 IF ( .NOT. ALLOCATED( t_surf_v_1(0)%t ) ) & 4189 ALLOCATE( t_surf_v_1(0)%t(1:surf_usm_v(0)%ns) ) 4190 READ ( 13 ) t_surf_v_1(0)%t 4320 IF ( kk == 1 ) THEN 4321 IF ( .NOT. ALLOCATED( t_surf_v_1(0)%t ) ) & 4322 ALLOCATE( t_surf_v_1(0)%t(1:surf_usm_v(0)%ns) ) 4323 READ ( 13 ) tmp_surf_v(0)%t 4324 ENDIF 4325 CALL restore_surface_elements_usm_1d( & 4326 t_surf_v_1(0)%t, tmp_surf_v(0)%t,& 4327 surf_usm_v(0)%start_index ) 4191 4328 #endif 4329 4192 4330 CASE ( 't_surf_v(1)' ) 4193 #if defined( __nopointer ) 4194 IF ( .NOT. ALLOCATED( t_surf_v(1)%t ) ) & 4195 ALLOCATE( t_surf_v(1)%t(1:surf_usm_v(1)%ns) ) 4196 READ ( 13 ) t_surf_v(1)%t 4331 #if defined( __nopointer ) 4332 IF ( kk == 1 ) THEN 4333 IF ( .NOT. ALLOCATED( t_surf_v(1)%t ) ) & 4334 ALLOCATE( t_surf_v(1)%t(1:surf_usm_v(1)%ns) ) 4335 READ ( 13 ) tmp_surf_v(1)%t 4336 ENDIF 4337 CALL restore_surface_elements_usm_1d( & 4338 t_surf_v(1)%t, tmp_surf_v(1)%t, & 4339 surf_usm_v(1)%start_index ) 4197 4340 #else 4198 IF ( .NOT. ALLOCATED( t_surf_v_1(1)%t ) ) & 4199 ALLOCATE( t_surf_v_1(1)%t(1:surf_usm_v(1)%ns) ) 4200 READ ( 13 ) t_surf_v_1(1)%t 4341 IF ( kk == 1 ) THEN 4342 IF ( .NOT. ALLOCATED( t_surf_v_1(1)%t ) ) & 4343 ALLOCATE( t_surf_v_1(1)%t(1:surf_usm_v(1)%ns) ) 4344 READ ( 13 ) tmp_surf_v(1)%t 4345 ENDIF 4346 CALL restore_surface_elements_usm_1d( & 4347 t_surf_v_1(1)%t, tmp_surf_v(1)%t,& 4348 surf_usm_v(1)%start_index ) 4201 4349 #endif 4350 4202 4351 CASE ( 't_surf_v(2)' ) 4203 #if defined( __nopointer ) 4204 IF ( .NOT. ALLOCATED( t_surf_v(2)%t ) ) & 4205 ALLOCATE( t_surf_v(2)%t(1:surf_usm_v(2)%ns) ) 4206 READ ( 13 ) t_surf_v(2)%t 4352 #if defined( __nopointer ) 4353 IF ( kk == 1 ) THEN 4354 IF ( .NOT. ALLOCATED( t_surf_v(2)%t ) ) & 4355 ALLOCATE( t_surf_v(2)%t(1:surf_usm_v(2)%ns) ) 4356 READ ( 13 ) tmp_surf_v(2)%t 4357 ENDIF 4358 CALL restore_surface_elements_usm_1d( & 4359 t_surf_v(2)%t, tmp_surf_v(2)%t, & 4360 surf_usm_v(2)%start_index ) 4207 4361 #else 4208 IF ( .NOT. ALLOCATED( t_surf_v_1(2)%t ) ) & 4209 ALLOCATE( t_surf_v_1(2)%t(1:surf_usm_v(2)%ns) ) 4210 READ ( 13 ) t_surf_v_1(2)%t 4362 IF ( kk == 1 ) THEN 4363 IF ( .NOT. ALLOCATED( t_surf_v_1(2)%t ) ) & 4364 ALLOCATE( t_surf_v_1(2)%t(1:surf_usm_v(2)%ns) ) 4365 READ ( 13 ) tmp_surf_v(2)%t 4366 ENDIF 4367 CALL restore_surface_elements_usm_1d( & 4368 t_surf_v_1(2)%t, tmp_surf_v(2)%t,& 4369 surf_usm_v(2)%start_index ) 4211 4370 #endif 4371 4212 4372 CASE ( 't_surf_v(3)' ) 4213 #if defined( __nopointer ) 4214 IF ( .NOT. ALLOCATED( t_surf_v(3)%t ) ) & 4215 ALLOCATE( t_surf_v(3)%t(1:surf_usm_v(3)%ns) ) 4216 READ ( 13 ) t_surf_v(3)%t 4373 #if defined( __nopointer ) 4374 IF ( kk == 1 ) THEN 4375 IF ( .NOT. ALLOCATED( t_surf_v(3)%t ) ) & 4376 ALLOCATE( t_surf_v(3)%t(1:surf_usm_v(3)%ns) ) 4377 READ ( 13 ) tmp_surf_v(3)%t 4378 ENDIF 4379 CALL restore_surface_elements_usm_1d( & 4380 t_surf_v(3)%t, tmp_surf_v(3)%t, & 4381 surf_usm_v(3)%start_index ) 4217 4382 #else 4218 IF ( .NOT. ALLOCATED( t_surf_v_1(3)%t ) ) & 4219 ALLOCATE( t_surf_v_1(3)%t(1:surf_usm_v(3)%ns) ) 4220 READ ( 13 ) t_surf_v_1(3)%t 4383 IF ( kk == 1 ) THEN 4384 IF ( .NOT. ALLOCATED( t_surf_v_1(3)%t ) ) & 4385 ALLOCATE( t_surf_v_1(3)%t(1:surf_usm_v(3)%ns) ) 4386 READ ( 13 ) tmp_surf_v(3)%t 4387 ENDIF 4388 CALL restore_surface_elements_usm_1d( & 4389 t_surf_v_1(3)%t, tmp_surf_v(3)%t,& 4390 surf_usm_v(3)%start_index ) 4221 4391 #endif 4222 4392 CASE ( 't_wall_h' ) 4223 4393 #if defined( __nopointer ) 4224 IF ( .NOT. ALLOCATED( t_wall_h ) ) & 4225 ALLOCATE( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 4226 READ ( 13 ) t_wall_h 4394 IF ( kk == 1 ) THEN 4395 IF ( .NOT. ALLOCATED( t_wall_h ) ) & 4396 ALLOCATE( t_wall_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 4397 READ ( 13 ) tmp_wall_h 4398 ENDIF 4399 CALL restore_surface_elements_usm_2d( & 4400 t_wall_h, tmp_wall_h, & 4401 surf_usm_h%start_index ) 4227 4402 #else 4228 IF ( .NOT. ALLOCATED( t_wall_h_1 ) ) & 4229 ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 4230 READ ( 13 ) t_wall_h_1 4403 IF ( kk == 1 ) THEN 4404 IF ( .NOT. ALLOCATED( t_wall_h_1 ) ) & 4405 ALLOCATE( t_wall_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 4406 READ ( 13 ) tmp_wall_h 4407 ENDIF 4408 CALL restore_surface_elements_usm_2d( & 4409 t_wall_h_1, tmp_wall_h, & 4410 surf_usm_h%start_index ) 4231 4411 #endif 4232 4412 CASE ( 't_wall_v(0)' ) 4233 4413 #if defined( __nopointer ) 4234 IF ( .NOT. ALLOCATED( t_wall_v(0)%t ) ) & 4235 ALLOCATE( t_wall_v(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) ) 4236 READ ( 13 ) t_wall_v(0)%t 4414 IF ( kk == 1 ) THEN 4415 IF ( .NOT. ALLOCATED( t_wall_v(0)%t ) ) & 4416 ALLOCATE( t_wall_v(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) ) 4417 READ ( 13 ) tmp_wall_v(0)%t 4418 ENDIF 4419 CALL restore_surface_elements_usm_2d( & 4420 t_wall_v(0)%t, tmp_wall_v(0)%t, & 4421 surf_usm_v(0)%start_index ) 4237 4422 #else 4238 IF ( .NOT. ALLOCATED( t_wall_v_1(0)%t ) ) & 4239 ALLOCATE( t_wall_v_1(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) ) 4240 READ ( 13 ) t_wall_v_1(0)%t 4423 IF ( kk == 1 ) THEN 4424 IF ( .NOT. ALLOCATED( t_wall_v_1(0)%t ) ) & 4425 ALLOCATE( t_wall_v_1(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) ) 4426 READ ( 13 ) tmp_wall_v(0)%t 4427 ENDIF 4428 CALL restore_surface_elements_usm_2d( & 4429 t_wall_v_1(0)%t, tmp_wall_v(0)%t,& 4430 surf_usm_v(0)%start_index ) 4241 4431 #endif 4242 4432 CASE ( 't_wall_v(1)' ) 4243 4433 #if defined( __nopointer ) 4244 IF ( .NOT. ALLOCATED( t_wall_v(1)%t ) ) & 4245 ALLOCATE( t_wall_v(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) ) 4246 READ ( 13 ) t_wall_v(1)%t 4434 IF ( kk == 1 ) THEN 4435 IF ( .NOT. ALLOCATED( t_wall_v(1)%t ) ) & 4436 ALLOCATE( t_wall_v(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) ) 4437 READ ( 13 ) tmp_wall_v(1)%t 4438 ENDIF 4439 CALL restore_surface_elements_usm_2d( & 4440 t_wall_v(1)%t, tmp_wall_v(1)%t, & 4441 surf_usm_v(1)%start_index ) 4247 4442 #else 4248 IF ( .NOT. ALLOCATED( t_wall_v_1(0)%t ) ) & 4249 ALLOCATE( t_wall_v_1(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) ) 4250 READ ( 13 ) t_wall_v_1(1)%t 4443 IF ( kk == 1 ) THEN 4444 IF ( .NOT. ALLOCATED( t_wall_v_1(1)%t ) ) & 4445 ALLOCATE( t_wall_v_1(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) ) 4446 READ ( 13 ) tmp_wall_v(1)%t 4447 ENDIF 4448 CALL restore_surface_elements_usm_2d( & 4449 t_wall_v_1(1)%t, tmp_wall_v(1)%t,& 4450 surf_usm_v(1)%start_index ) 4251 4451 #endif 4252 4452 CASE ( 't_wall_v(2)' ) 4253 4453 #if defined( __nopointer ) 4254 IF ( .NOT. ALLOCATED( t_wall_v(2)%t ) ) & 4255 ALLOCATE( t_wall_v(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) ) 4256 READ ( 13 ) t_wall_v(2)%t 4454 IF ( kk == 1 ) THEN 4455 IF ( .NOT. ALLOCATED( t_wall_v(2)%t ) ) & 4456 ALLOCATE( t_wall_v(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) ) 4457 READ ( 13 ) tmp_wall_v(2)%t 4458 ENDIF 4459 CALL restore_surface_elements_usm_2d( & 4460 t_wall_v(2)%t, tmp_wall_v(2)%t, & 4461 surf_usm_v(2)%start_index ) 4462 ENDIF 4257 4463 #else 4258 IF ( .NOT. ALLOCATED( t_wall_v_1(2)%t ) ) & 4259 ALLOCATE( t_wall_v_1(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) ) 4260 READ ( 13 ) t_wall_v_1(2)%t 4464 IF ( kk == 1 ) THEN 4465 IF ( .NOT. ALLOCATED( t_wall_v_1(2)%t ) ) & 4466 ALLOCATE( t_wall_v_1(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) ) 4467 READ ( 13 ) tmp_wall_v(2)%t 4468 ENDIF 4469 CALL restore_surface_elements_usm_2d( & 4470 t_wall_v_1(2)%t, tmp_wall_v(2)%t,& 4471 surf_usm_v(2)%start_index ) 4261 4472 #endif 4262 4473 CASE ( 't_wall_v(3)' ) 4263 4474 #if defined( __nopointer ) 4264 IF ( .NOT. ALLOCATED( t_wall_v(3)%t ) ) & 4265 ALLOCATE( t_wall_v(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) ) 4266 READ ( 13 ) t_wall_v(3)%t 4475 IF ( kk == 1 ) THEN 4476 IF ( .NOT. ALLOCATED( t_wall_v(3)%t ) ) & 4477 ALLOCATE( t_wall_v(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) ) 4478 READ ( 13 ) tmp_wall_v(3)%t 4479 ENDIF 4480 CALL restore_surface_elements_usm_2d( & 4481 t_wall_v(3)%t, tmp_wall_v(3)%t, & 4482 surf_usm_v(3)%start_index ) 4267 4483 #else 4268 IF ( .NOT. ALLOCATED( t_wall_v_1(3)%t ) ) & 4269 ALLOCATE( t_wall_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) ) 4270 READ ( 13 ) t_wall_v_1(3)%t 4484 IF ( kk == 1 ) THEN 4485 IF ( .NOT. ALLOCATED( t_wall_v_1(3)%t ) ) & 4486 ALLOCATE( t_wall_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) ) 4487 READ ( 13 ) tmp_wall_v(3)%t 4488 ENDIF 4489 CALL restore_surface_elements_usm_2d( & 4490 t_wall_v_1(3)%t, tmp_wall_v(3)%t,& 4491 surf_usm_v(3)%start_index ) 4271 4492 #endif 4272 4493 4273 4494 CASE DEFAULT 4274 4495 WRITE ( message_string, * ) 'unknown variable named "', & 4275 TRIM( variable_chr ), '" found in',&4496 TRIM( field_chr ), '" found in', & 4276 4497 '&data from prior run on PE ', myid 4277 4498 CALL message( 'user_read_restart_data', 'UI0012', 1, 2, 0, 6, 0 ) … … 4279 4500 END SELECT 4280 4501 4281 READ ( 13 ) variable_chr4282 4283 4502 ENDDO 4284 ENDIF 4285 #if defined( __parallel ) 4286 CALL MPI_BARRIER( comm2d, ierr ) 4287 #endif 4288 ENDDO 4503 4504 READ ( 13 ) field_chr 4505 4506 ENDDO 4507 4508 ENDIF 4509 4510 CONTAINS 4511 4512 SUBROUTINE restore_surface_elements_usm_1d( surf_target, surf_file, start_index_c ) 4513 4514 IMPLICIT NONE 4515 4516 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 4517 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 4518 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 4519 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 4520 INTEGER(iwp) :: m !< surface-element index on file 4521 INTEGER(iwp) :: mm !< surface-element index on current subdomain 4522 4523 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c 4524 4525 REAL(wp), DIMENSION(:) :: surf_target !< target surface type 4526 REAL(wp), DIMENSION(:) :: surf_file !< surface type on file 4527 4528 ic = nxlc 4529 DO i = nxlf, nxrf 4530 jc = nysc 4531 DO j = nysf, nynf 4532 4533 mm = start_index_c(jc,ic) 4534 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 4535 surf_target(mm) = surf_file(m) 4536 mm = mm + 1 4537 ENDDO 4538 4539 jc = jc + 1 4540 ENDDO 4541 ic = ic + 1 4542 ENDDO 4543 4544 4545 END SUBROUTINE restore_surface_elements_usm_1d 4546 4547 SUBROUTINE restore_surface_elements_usm_2d( surf_target, surf_file, start_index_c ) 4548 4549 IMPLICIT NONE 4550 4551 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 4552 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 4553 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 4554 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 4555 INTEGER(iwp) :: m !< surface-element index on file 4556 INTEGER(iwp) :: mm !< surface-element index on current subdomain 4557 4558 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c 4559 4560 REAL(wp), DIMENSION(:,:) :: surf_target !< target surface type 4561 REAL(wp), DIMENSION(:,:) :: surf_file !< surface type on file 4562 4563 ic = nxlc 4564 DO i = nxlf, nxrf 4565 jc = nysc 4566 DO j = nysf, nynf 4567 4568 mm = start_index_c(jc,ic) 4569 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 4570 surf_target(:,mm) = surf_file(:,m) 4571 mm = mm + 1 4572 ENDDO 4573 4574 jc = jc + 1 4575 ENDDO 4576 ic = ic + 1 4577 ENDDO 4578 4579 END SUBROUTINE restore_surface_elements_usm_2d 4289 4580 4290 4581 END SUBROUTINE usm_read_restart_data 4582 4291 4583 4292 4584 … … 5105 5397 IMPLICIT NONE 5106 5398 5107 INTEGER(iwp) :: i 5108 5109 DO i = 0, io_blocks-1 5110 IF ( i == io_group ) THEN 5111 5112 WRITE ( 14 ) 't_surf_h ' 5113 #if defined( __nopointer ) 5114 WRITE ( 14 ) t_surf_h 5115 #else 5116 WRITE ( 14 ) t_surf_h_1 5117 #endif 5118 WRITE ( 14 ) 't_surf_v(0) ' 5119 #if defined( __nopointer ) 5120 WRITE ( 14 ) t_surf_v(0)%t 5121 #else 5122 WRITE ( 14 ) t_surf_v_1(0)%t 5123 #endif 5124 WRITE ( 14 ) 't_surf_v(1) ' 5125 #if defined( __nopointer ) 5126 WRITE ( 14 ) t_surf_v(1)%t 5127 #else 5128 WRITE ( 14 ) t_surf_v_1(1)%t 5129 #endif 5130 WRITE ( 14 ) 't_surf_v(2) ' 5131 #if defined( __nopointer ) 5132 WRITE ( 14 ) t_surf_v(2)%t 5133 #else 5134 WRITE ( 14 ) t_surf_v_1(2)%t 5135 #endif 5136 WRITE ( 14 ) 't_surf_v(3) ' 5137 #if defined( __nopointer ) 5138 WRITE ( 14 ) t_surf_v(3)%t 5139 #else 5140 WRITE ( 14 ) t_surf_v_1(3)%t 5141 #endif 5142 WRITE ( 14 ) 't_wall_h ' 5143 #if defined( __nopointer ) 5144 WRITE ( 14 ) t_wall_h 5145 #else 5146 WRITE ( 14 ) t_wall_h_1 5147 #endif 5148 WRITE ( 14 ) 't_wall_v(0) ' 5149 #if defined( __nopointer ) 5150 WRITE ( 14 ) t_wall_v(0)%t 5151 #else 5152 WRITE ( 14 ) t_wall_v_1(0)%t 5153 #endif 5154 WRITE ( 14 ) 't_wall_v(1) ' 5155 #if defined( __nopointer ) 5156 WRITE ( 14 ) t_wall_v(1)%t 5157 #else 5158 WRITE ( 14 ) t_wall_v_1(1)%t 5159 #endif 5160 WRITE ( 14 ) 't_wall_v(2) ' 5161 #if defined( __nopointer ) 5162 WRITE ( 14 ) t_wall_v(2)%t 5163 #else 5164 WRITE ( 14 ) t_wall_v_1(2)%t 5165 #endif 5166 WRITE ( 14 ) 't_wall_v(3) ' 5167 #if defined( __nopointer ) 5168 WRITE ( 14 ) t_wall_v(3)%t 5169 #else 5170 WRITE ( 14 ) t_wall_v_1(3)%t 5171 #endif 5172 WRITE ( 14 ) '*** end usm *** ' 5173 ENDIF 5174 #if defined( __parallel ) 5175 CALL MPI_BARRIER( comm2d, ierr ) 5176 #endif 5399 CHARACTER(LEN=1) :: dum !< dummy string to create output-variable name 5400 INTEGER(iwp) :: l !< index surface type orientation 5401 5402 WRITE ( 14 ) 'ns_h_on_file_usm ' 5403 WRITE ( 14 ) surf_usm_h%ns 5404 WRITE ( 14 ) 'ns_v_on_file_usm ' 5405 WRITE ( 14 ) surf_usm_v(0:3)%ns 5406 5407 WRITE ( 14 ) 'usm_start_index_h ' 5408 WRITE ( 14 ) surf_usm_h%start_index 5409 WRITE ( 14 ) 'usm_end_index_h ' 5410 WRITE ( 14 ) surf_usm_h%end_index 5411 WRITE ( 14 ) 't_surf_h ' 5412 WRITE ( 14 ) t_surf_h 5413 5414 DO l = 0, 3 5415 WRITE ( 14 ) 'usm_start_index_v ' 5416 WRITE ( 14 ) surf_usm_v(l)%start_index 5417 WRITE ( 14 ) 'usm_end_index_v ' 5418 WRITE ( 14 ) surf_usm_v(l)%end_index 5419 WRITE( dum, '(I1)') l 5420 WRITE ( 14 ) 't_surf_v(' // dum // ') ' 5421 WRITE ( 14 ) t_surf_v(l)%t 5177 5422 ENDDO 5178 5423 5424 WRITE ( 14 ) 'usm_start_index_h ' 5425 WRITE ( 14 ) surf_usm_h%start_index 5426 WRITE ( 14 ) 'usm_end_index_h ' 5427 WRITE ( 14 ) surf_usm_h%end_index 5428 WRITE ( 14 ) 't_wall_h ' 5429 WRITE ( 14 ) t_wall_h 5430 DO l = 0, 3 5431 WRITE ( 14 ) 'usm_start_index_v ' 5432 WRITE ( 14 ) surf_usm_v(l)%start_index 5433 WRITE ( 14 ) 'usm_end_index_v ' 5434 WRITE ( 14 ) surf_usm_v(l)%end_index 5435 WRITE( dum, '(I1)') l 5436 WRITE ( 14 ) 't_wall_v(' // dum // ') ' 5437 WRITE ( 14 ) t_wall_v(l)%t 5438 ENDDO 5439 5440 WRITE ( 14 ) '*** end usm *** ' 5179 5441 5180 5442 END SUBROUTINE usm_write_restart_data
Note: See TracChangeset
for help on using the changeset viewer.
