Changeset 3556 for palm/trunk/SOURCE
- Timestamp:
- Nov 22, 2018 2:11:57 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
netcdf_data_input_mod.f90 (modified) (2 diffs)
-
surface_mod.f90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3553 r3556 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Some formatting adjustment 23 23 ! 24 24 ! Former revisions: … … 946 946 input_file_atts%rotation_angle, .TRUE. ) 947 947 948 CALL get_attribute( id_mod, input_file_atts%author_char, input_file_atts%author, .TRUE., no_abort=.FALSE. ) 949 CALL get_attribute( id_mod, input_file_atts%contact_person_char, input_file_atts%contact_person, .TRUE., no_abort=.FALSE. ) 950 CALL get_attribute( id_mod, input_file_atts%institution_char, input_file_atts%institution, .TRUE., no_abort=.FALSE. ) 951 CALL get_attribute( id_mod, input_file_atts%acronym_char, input_file_atts%acronym, .TRUE., no_abort=.FALSE. ) 952 953 CALL get_attribute( id_mod, input_file_atts%campaign_char, input_file_atts%campaign, .TRUE., no_abort=.FALSE. ) 954 CALL get_attribute( id_mod, input_file_atts%location_char, input_file_atts%location, .TRUE., no_abort=.FALSE. ) 955 CALL get_attribute( id_mod, input_file_atts%site_char, input_file_atts%site, .TRUE., no_abort=.FALSE. ) 956 957 CALL get_attribute( id_mod, input_file_atts%source_char, input_file_atts%source, .TRUE., no_abort=.FALSE. ) 958 CALL get_attribute( id_mod, input_file_atts%references_char, input_file_atts%references, .TRUE., no_abort=.FALSE. ) 959 CALL get_attribute( id_mod, input_file_atts%keywords_char, input_file_atts%keywords, .TRUE., no_abort=.FALSE. ) 960 CALL get_attribute( id_mod, input_file_atts%licence_char, input_file_atts%licence, .TRUE., no_abort=.FALSE. ) 961 CALL get_attribute( id_mod, input_file_atts%comment_char, input_file_atts%comment, .TRUE., no_abort=.FALSE. ) 948 CALL get_attribute( id_mod, input_file_atts%author_char, & 949 input_file_atts%author, .TRUE., no_abort=.FALSE. ) 950 CALL get_attribute( id_mod, input_file_atts%contact_person_char, & 951 input_file_atts%contact_person, .TRUE., no_abort=.FALSE. ) 952 CALL get_attribute( id_mod, input_file_atts%institution_char, & 953 input_file_atts%institution, .TRUE., no_abort=.FALSE. ) 954 CALL get_attribute( id_mod, input_file_atts%acronym_char, & 955 input_file_atts%acronym, .TRUE., no_abort=.FALSE. ) 956 957 CALL get_attribute( id_mod, input_file_atts%campaign_char, & 958 input_file_atts%campaign, .TRUE., no_abort=.FALSE. ) 959 CALL get_attribute( id_mod, input_file_atts%location_char, & 960 input_file_atts%location, .TRUE., no_abort=.FALSE. ) 961 CALL get_attribute( id_mod, input_file_atts%site_char, & 962 input_file_atts%site, .TRUE., no_abort=.FALSE. ) 963 964 CALL get_attribute( id_mod, input_file_atts%source_char, & 965 input_file_atts%source, .TRUE., no_abort=.FALSE. ) 966 CALL get_attribute( id_mod, input_file_atts%references_char, & 967 input_file_atts%references, .TRUE., no_abort=.FALSE. ) 968 CALL get_attribute( id_mod, input_file_atts%keywords_char, & 969 input_file_atts%keywords, .TRUE., no_abort=.FALSE. ) 970 CALL get_attribute( id_mod, input_file_atts%licence_char, & 971 input_file_atts%licence, .TRUE., no_abort=.FALSE. ) 972 CALL get_attribute( id_mod, input_file_atts%comment_char, & 973 input_file_atts%comment, .TRUE., no_abort=.FALSE. ) 962 974 ! 963 975 !-- Read coordinate reference system if available -
palm/trunk/SOURCE/surface_mod.f90
r3547 r3556 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Surface restoring in restarts commented. Some formatting. 24 24 ! 25 25 ! Former revisions: … … 566 566 !< in the domain (required to activiate RTM) 567 567 568 LOGICAL :: surf_bulk_cloud_model = .FALSE. 569 LOGICAL :: surf_microphysics_morrison = .FALSE. 570 LOGICAL :: surf_microphysics_seifert = .FALSE. 568 LOGICAL :: surf_bulk_cloud_model = .FALSE. !< use cloud microphysics 569 LOGICAL :: surf_microphysics_morrison = .FALSE. !< use 2-moment Morrison (add. prog. eq. for nc and qc) 570 LOGICAL :: surf_microphysics_seifert = .FALSE. !< use 2-moment Seifert and Beheng scheme 571 571 572 572 … … 613 613 !-- Public subroutines and functions 614 614 PUBLIC get_topography_top_index, get_topography_top_index_ji, init_bc, & 615 init_surfaces, & 616 init_surface_arrays, surface_rrd_local, & 617 surface_restore_elements, surface_wrd_local, & 618 surface_last_actions 615 init_surfaces, init_surface_arrays, surface_rrd_local, & 616 surface_restore_elements, surface_wrd_local, surface_last_actions 619 617 620 618 … … 845 843 terrain = BTEST( wall_flags_0(k,j-1,i), 5 ) .OR. & 846 844 topo_no_distinct 847 building = BTEST( wall_flags_0(k,j-1,i), 6 ) .OR. 845 building = BTEST( wall_flags_0(k,j-1,i), 6 ) .OR. & 848 846 topo_no_distinct 849 847 IF ( land_surface .AND. terrain ) THEN … … 859 857 !-- Unclassifified surface-grid point. Give error message. 860 858 ELSE 861 WRITE( message_string, * ) &862 'Unclassified northward-facing ' // &863 'surface element at '// &859 WRITE( message_string, * ) & 860 'Unclassified northward-facing ' // & 861 'surface element at '// & 864 862 'grid point (k,j,i) = ', k, j, i 865 863 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) … … 888 886 !-- Unclassifified surface-grid point. Give error message. 889 887 ELSE 890 WRITE( message_string, * ) &891 'Unclassified southward-facing ' // &892 'surface element at '// &888 WRITE( message_string, * ) & 889 'Unclassified southward-facing ' // & 890 'surface element at '// & 893 891 'grid point (k,j,i) = ', k, j, i 894 892 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) … … 917 915 !-- Unclassifified surface-grid point. Give error message. 918 916 ELSE 919 WRITE( message_string, * ) &920 'Unclassified eastward-facing ' // &921 'surface element at '// &917 WRITE( message_string, * ) & 918 'Unclassified eastward-facing ' // & 919 'surface element at '// & 922 920 'grid point (k,j,i) = ', k, j, i 923 921 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) … … 946 944 !-- Unclassifified surface-grid point. Give error message. 947 945 ELSE 948 WRITE( message_string, * ) &949 'Unclassified westward-facing ' // &950 'surface element at '// &946 WRITE( message_string, * ) & 947 'Unclassified westward-facing ' // & 948 'surface element at '// & 951 949 'grid point (k,j,i) = ', k, j, i 952 950 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) … … 1056 1054 1057 1055 #if defined( __parallel ) 1058 CALL MPI_ALLREDUCE( num_surf_v_l, num_surf_v, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr) 1056 CALL MPI_ALLREDUCE( num_surf_v_l, num_surf_v, 1, MPI_INTEGER, & 1057 MPI_SUM, comm2d, ierr) 1059 1058 #else 1060 1059 num_surf_v = num_surf_v_l 1061 1060 #endif 1062 IF ( num_surf_v > 0 ) vertical_surfaces_exist = .TRUE.1061 IF ( num_surf_v > 0 ) vertical_surfaces_exist = .TRUE. 1063 1062 1064 1063 … … 2900 2899 ENDDO 2901 2900 ! 2902 !-- Gather start- and end indices2901 !-- Recalculate start- and end indices for gathered surface type. 2903 2902 start_index_h(l) = 1 2904 2903 DO i = nxl, nxr … … 2906 2905 2907 2906 surf_h(l)%start_index(j,i) = start_index_h(l) 2908 surf_h(l)%end_index(j,i) = surf_h(l)%start_index(j,i) - 12907 surf_h(l)%end_index(j,i) = surf_h(l)%start_index(j,i) - 1 2909 2908 2910 2909 DO m = surf_def_h(l)%start_index(j,i), & … … 2928 2927 ENDDO 2929 2928 ENDDO 2930 2931 2929 ! 2930 !-- Treat vertically orientated surface. Again, gather data from different 2931 !-- surfaces types but identical orientation (e.g. northward-facing) onto 2932 !-- one surface type which is output afterwards. 2932 2933 mm(0:3) = 1 2933 2934 DO l = 0, 3 … … 3137 3138 ENDDO 3138 3139 ! 3139 !-- Gather start- and end indices3140 !-- Recalculate start- and end-indices for gathered surface type 3140 3141 start_index_v(l) = 1 3141 3142 DO i = nxl, nxr … … 3163 3164 3164 3165 ENDDO 3165 3166 3166 ! 3167 !-- Output strings for the total number of upward / downward-facing surfaces 3168 !-- on subdomain. 3167 3169 CALL wrd_write_string( 'ns_h_on_file' ) 3168 3170 WRITE ( 14 ) ns_h_on_file 3169 3171 ! 3172 !-- Output strings for the total number of north/south/east/westward-facing surfaces 3173 !-- on subdomain. 3170 3174 CALL wrd_write_string( 'ns_v_on_file' ) 3171 3175 WRITE ( 14 ) ns_v_on_file … … 3173 3177 ! 3174 3178 !-- Write required restart data. 3175 !-- Start with horizontal surfaces (upward-, downward-facing, and model top) 3179 !-- Start with horizontal surfaces (upward-, downward-facing, and model top). 3180 !-- Always start with %start_index followed by %end_index 3176 3181 DO l = 0, 2 3177 3182 WRITE( dum, '(I1)') l … … 3310 3315 ENDDO 3311 3316 ! 3312 !-- Write vertical surfaces 3317 !-- Write vertical surfaces. 3318 !-- Always start with %start_index followed by %end_index. 3313 3319 DO l = 0, 3 3314 3320 WRITE( dum, '(I1)') l … … 3480 3486 INTEGER(iwp) :: m !< running index for surface elements, refers to gathered array encompassing all surface types 3481 3487 INTEGER(iwp) :: mm !< running index for surface elements, refers to individual surface types 3482 INTEGER(iwp) :: ii 3483 INTEGER(iwp) :: kk 3484 INTEGER(iwp) :: nxlc 3485 INTEGER(iwp) :: nxlf 3486 INTEGER(iwp) :: nxl_on_file 3487 INTEGER(iwp) :: nxrc 3488 INTEGER(iwp) :: nxrf 3489 INTEGER(iwp) :: nxr_on_file 3490 INTEGER(iwp) :: nync 3491 INTEGER(iwp) :: nynf 3492 INTEGER(iwp) :: nyn_on_file 3493 INTEGER(iwp) :: nysc 3494 INTEGER(iwp) :: nysf 3495 INTEGER(iwp) :: nys_on_file 3496 3497 INTEGER(iwp), SAVE 3498 3499 LOGICAL 3500 LOGICAL 3501 LOGICAL 3488 INTEGER(iwp) :: ii !< running index over input files 3489 INTEGER(iwp) :: kk !< running index over previous input files covering current local domain 3490 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 3491 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 3492 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 3493 INTEGER(iwp) :: nxrc !< index of right boundary on current subdomain 3494 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 3495 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 3496 INTEGER(iwp) :: nync !< index of north boundary on current subdomain 3497 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 3498 INTEGER(iwp) :: nyn_on_file !< index of norht boundary on former local domain 3499 INTEGER(iwp) :: nysc !< index of south boundary on current subdomain 3500 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 3501 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 3502 3503 INTEGER(iwp), SAVE :: l !< index variable for surface type 3504 3505 LOGICAL :: surf_match_def !< flag indicating that surface element is of default type 3506 LOGICAL :: surf_match_lsm !< flag indicating that surface element is of natural type 3507 LOGICAL :: surf_match_usm !< flag indicating that surface element is of urban type 3502 3508 3503 3509 LOGICAL, INTENT(OUT) :: found … … 3506 3512 LOGICAL, SAVE :: vertical_surface !< flag indicating vertical surfaces 3507 3513 3508 TYPE(surf_type), DIMENSION(0:2), SAVE :: surf_h 3509 TYPE(surf_type), DIMENSION(0:3), SAVE :: surf_v 3514 TYPE(surf_type), DIMENSION(0:2), SAVE :: surf_h !< horizontal surface type on file 3515 TYPE(surf_type), DIMENSION(0:3), SAVE :: surf_v !< vertical surface type on file 3510 3516 3511 3517 … … 3513 3519 3514 3520 SELECT CASE ( restart_string(1:length) ) 3515 3521 ! 3522 !-- Read the number of horizontally orientated surface elements and 3523 !-- allocate arrays 3516 3524 CASE ( 'ns_h_on_file' ) 3517 3525 IF ( kk == 1 ) THEN … … 3524 3532 IF ( ALLOCATED( surf_h(2)%start_index ) ) & 3525 3533 CALL deallocate_surface_attributes_h_top( surf_h(2) ) 3526 3534 ! 3527 3535 !-- Allocate memory for number of surface elements on file. 3528 3536 !-- Please note, these number is not necessarily the same as … … 3535 3543 nys_on_file, nyn_on_file, & 3536 3544 nxl_on_file, nxr_on_file ) 3537 3545 ! 3538 3546 !-- Horizontal downward facing 3539 3547 surf_h(1)%ns = ns_h_on_file(1) … … 3541 3549 nys_on_file, nyn_on_file, & 3542 3550 nxl_on_file, nxr_on_file ) 3543 3551 ! 3544 3552 !-- Model top 3545 3553 surf_h(2)%ns = ns_h_on_file(2) … … 3555 3563 3556 3564 ENDIF 3557 3565 ! 3566 !-- Read the number of vertically orientated surface elements and 3567 !-- allocate arrays 3558 3568 CASE ( 'ns_v_on_file' ) 3559 3569 IF ( kk == 1 ) THEN … … 3565 3575 ENDDO 3566 3576 3567 !-- Vertical surfaces3568 3577 DO l = 0, 3 3569 3578 surf_v(l)%ns = ns_v_on_file(l) … … 3574 3583 3575 3584 ENDIF 3576 3585 ! 3586 !-- Read start and end indices of surface elements at each (ji)-gridpoint 3577 3587 CASE ( 'surf_h(0)%start_index' ) 3578 3588 IF ( kk == 1 ) & … … 3584 3594 horizontal_surface = .TRUE. 3585 3595 vertical_surface = .FALSE. 3596 ! 3597 !-- Read specific attributes 3586 3598 CASE ( 'surf_h(0)%us' ) 3587 3599 IF ( ALLOCATED( surf_h(0)%us ) .AND. kk == 1 ) & … … 4178 4190 END SELECT 4179 4191 ! 4180 !-- Redistribute surface elements on its respective type. 4192 !-- Redistribute surface elements on its respective type. Start with 4193 !-- horizontally orientated surfaces. 4181 4194 IF ( horizontal_surface .AND. & 4182 4195 .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 ) & … … 4187 4200 jc = nysc 4188 4201 DO j = nysf, nynf 4189 4202 ! 4203 !-- Determine type of surface element, i.e. default, natural, 4204 !-- urban, at current grid point. 4190 4205 surf_match_def = surf_def_h(l)%end_index(jc,ic) >= & 4191 4206 surf_def_h(l)%start_index(jc,ic) 4192 4207 surf_match_lsm = ( surf_lsm_h%end_index(jc,ic) >= & 4193 4208 surf_lsm_h%start_index(jc,ic) ) & 4194 .AND. l == 04209 .AND. l == 0 4195 4210 surf_match_usm = ( surf_usm_h%end_index(jc,ic) >= & 4196 4211 surf_usm_h%start_index(jc,ic) ) & 4197 .AND. l == 0 4198 4212 .AND. l == 0 4213 ! 4214 !-- Write restart data onto default-type surfaces if required. 4199 4215 IF ( surf_match_def ) THEN 4216 ! 4217 !-- Set the start index for the local surface element 4200 4218 mm = surf_def_h(l)%start_index(jc,ic) 4219 ! 4220 !-- For index pair (j,i) on file loop from start to end index, 4221 !-- and in case the local surface element mm is smaller than 4222 !-- the local end index, assign the respective surface data 4223 !-- to this element. 4201 4224 DO m = surf_h(l)%start_index(j,i), & 4202 4225 surf_h(l)%end_index(j,i) … … 4207 4230 ENDDO 4208 4231 ENDIF 4209 4232 ! 4233 !-- Same for natural-type surfaces. Please note, it is implicitly 4234 !-- assumed that natural surface elements are below urban 4235 !-- urban surface elements if there are several horizontal surfaces 4236 !-- at (j,i). An example would be bridges. 4210 4237 IF ( surf_match_lsm ) THEN 4211 4238 mm = surf_lsm_h%start_index(jc,ic) … … 4218 4245 ENDDO 4219 4246 ENDIF 4220 4247 ! 4248 !-- Same for urban-type surfaces 4221 4249 IF ( surf_match_usm ) THEN 4222 4250 mm = surf_usm_h%start_index(jc,ic) … … 4241 4269 jc = nysc 4242 4270 DO j = nysf, nynf 4243 4271 ! 4272 !-- Determine type of surface element, i.e. default, natural, 4273 !-- urban, at current grid point. 4244 4274 surf_match_def = surf_def_v(l)%end_index(jc,ic) >= & 4245 4275 surf_def_v(l)%start_index(jc,ic) … … 4248 4278 surf_match_usm = surf_usm_v(l)%end_index(jc,ic) >= & 4249 4279 surf_usm_v(l)%start_index(jc,ic) 4250 4280 ! 4281 !-- Write restart data onto default-type surfaces if required. 4251 4282 IF ( surf_match_def ) THEN 4283 ! 4284 !-- Set the start index for the local surface element 4252 4285 mm = surf_def_v(l)%start_index(jc,ic) 4286 ! 4287 !-- For index pair (j,i) on file loop from start to end index, 4288 !-- and in case the local surface element mm is smaller than 4289 !-- the local end index, assign the respective surface data 4290 !-- to this element. 4253 4291 DO m = surf_v(l)%start_index(j,i), & 4254 4292 surf_v(l)%end_index(j,i) … … 4259 4297 ENDDO 4260 4298 ENDIF 4261 4299 ! 4300 !-- Same for natural-type surfaces. Please note, it is implicitly 4301 !-- assumed that natural surface elements are below urban 4302 !-- urban surface elements if there are several vertical surfaces 4303 !-- at (j,i). An example a terrain elevations with a building on 4304 !-- top. So far, initialization of urban surfaces below natural 4305 !-- surfaces on the same (j,i) is not possible, so that this case 4306 !-- cannot occur. 4262 4307 IF ( surf_match_lsm ) THEN 4263 4308 mm = surf_lsm_v(l)%start_index(jc,ic) … … 4293 4338 ! Description: 4294 4339 ! ------------ 4295 !> Restores surfac le elements back on its respective type.4340 !> Restores surface elements back on its respective type. 4296 4341 !------------------------------------------------------------------------------! 4297 4342 SUBROUTINE restore_surface_elements( surf_target, m_target, & … … 4511 4556 ! Description: 4512 4557 ! ------------ 4513 !> Routine maps surface data read from file after restart - 1D arrays 4558 !> Routine maps surface data read from file after restart - 1D arrays. 4514 4559 !------------------------------------------------------------------------------! 4515 4560 SUBROUTINE surface_restore_elements_1d( surf_target, surf_file, &
Note: See TracChangeset
for help on using the changeset viewer.
