Ignore:
Timestamp:
Jun 9, 2017 11:57:32 AM (4 years ago)
Author:
suehring
Message:

Enable restarts with USM with different number of PEs; some bugfixes in new surface structure in USM; formatting adjustments and descriptions in surface_mod

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r2258 r2269  
    2626! -----------------
    2727! $Id$
     28! Enable restart runs with different number of PEs
     29! Bugfixes nopointer branch
     30!
     31! 2258 2017-06-08 07:55:13Z suehring
    2832! Bugfix, add pre-preprocessor directives to enable non-parrallel mode
    2933!
     
    113117!>    1.2 Km/s, which seem to be not realistic.
    114118!>
     119!> @todo Revise flux conversion in energy-balance solver
     120!> @todo Bugfixing in nopointer branch
    115121!> @todo Check optimizations for RMA operations
    116122!> @todo Alternatives for MPI_WIN_ALLOCATE? (causes problems with openmpi)
     
    513519    SAVE
    514520
    515     PRIVATE
     521    PRIVATE 
    516522   
    517523!-- Public parameters, constants and initial values
     
    959965!--     allocate wall and roof temperature arrays, for horizontal walls
    960966#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) ) 
    970975#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!           
    976988!--     initial assignment of the pointers
    977989        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           
    979991#endif
    980992
    981 !--     allocate wall and roof temperature arrays, for vertical walls
     993!--     allocate wall and roof temperature arrays, for vertical walls if required
    982994#if defined( __nopointer )
    983995        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) )
    9881004        ENDDO
    9891005#else
     1006!
     1007!--     Allocate if required. Note, in case of restarts, some of these arrays
     1008!--     might be already allocated.
    9901009        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) ) 
    9951018        ENDDO
    9961019!
     
    31993222
    32003223!--     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
    32063226       
    32073227!--         Calculate initial surface temperature from pt of adjacent gridbox
     
    41534173!        So, I added some directives here.
    41544174!------------------------------------------------------------------------------!
    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           
    41584184       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
    41594206       
    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   !<
    41614215       
    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
    41714285               
    41724286                   CASE ( 't_surf_h' )
    41734287#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
    41774297#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 )
    41814306#endif
     4307
    41824308                   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
    41874319#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 )
    41914328#endif
     4329                         
    41924330                   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 )                       
    41974340#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 )
    42014349#endif
     4350
    42024351                   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 )
    42074361#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 )
    42114370#endif
     4371                         
    42124372                   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 )
    42174382#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 )
    42214391#endif
    42224392                   CASE ( 't_wall_h' )
    42234393#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 )
    42274402#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 )
    42314411#endif
    42324412                   CASE ( 't_wall_v(0)' )
    42334413#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 )
    42374422#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 )
    42414431#endif
    42424432                   CASE ( 't_wall_v(1)' )
    42434433#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 )
    42474442#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 )
    42514451#endif
    42524452                   CASE ( 't_wall_v(2)' )
    42534453#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
    42574463#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 )
    42614472#endif
    42624473                   CASE ( 't_wall_v(3)' )
    42634474#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 )
    42674483#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 )
    42714492#endif
    42724493
    42734494                   CASE DEFAULT
    42744495                      WRITE ( message_string, * )  'unknown variable named "', &
    4275                                         TRIM( variable_chr ), '" found in',    &
     4496                                        TRIM( field_chr ), '" found in',       &
    42764497                                        '&data from prior run on PE ', myid
    42774498                      CALL message( 'user_read_restart_data', 'UI0012', 1, 2, 0, 6, 0 )
     
    42794500                END SELECT
    42804501
    4281                 READ ( 13 )  variable_chr
    4282 
    42834502             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
    42894580
    42904581    END SUBROUTINE usm_read_restart_data
     4582   
    42914583
    42924584
     
    51055397       IMPLICIT NONE
    51065398       
    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         
    51775422       ENDDO
    51785423
     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 ***               '
    51795441       
    51805442    END SUBROUTINE usm_write_restart_data
Note: See TracChangeset for help on using the changeset viewer.