- Timestamp:
- May 27, 2020 9:05:24 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_data_output_mod.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_data_output_mod.f90
r4535 r4547 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Added surface albedo and emissivity, which are defined using 28 ! the tile approach 29 ! 30 ! 4535 2020-05-15 12:07:23Z raasch 31 ! bugfix for restart data format query 32 ! 33 ! 4535 2020-05-15 12:07:23Z raasch 27 34 ! bugfix for restart data format query 28 35 ! … … 284 291 MODULE PROCEDURE surface_data_output_wrd_local 285 292 END INTERFACE surface_data_output_wrd_local 293 294 INTERFACE surface_data_output_sum_up 295 MODULE PROCEDURE surface_data_output_sum_up_1d 296 MODULE PROCEDURE surface_data_output_sum_up_2d 297 END INTERFACE surface_data_output_sum_up 298 299 INTERFACE surface_data_output_collect 300 MODULE PROCEDURE surface_data_output_collect_1d 301 MODULE PROCEDURE surface_data_output_collect_2d 302 END INTERFACE surface_data_output_collect 286 303 287 304 ! … … 3068 3085 ENDIF 3069 3086 ! 3087 !-- Surface albedo (tile approach) 3088 CASE ( 'albedo' ) 3089 ! 3090 !-- Output of instantaneous data 3091 IF ( av == 0 ) THEN 3092 CALL surface_data_output_collect( surf_def_h(0)%albedo, & 3093 surf_def_h(1)%albedo, & 3094 surf_lsm_h%albedo, & 3095 surf_usm_h%albedo, & 3096 surf_def_v(0)%albedo, & 3097 surf_lsm_v(0)%albedo, & 3098 surf_usm_v(0)%albedo, & 3099 surf_def_v(1)%albedo, & 3100 surf_lsm_v(1)%albedo, & 3101 surf_usm_v(1)%albedo, & 3102 surf_def_v(2)%albedo, & 3103 surf_lsm_v(2)%albedo, & 3104 surf_usm_v(2)%albedo, & 3105 surf_def_v(3)%albedo, & 3106 surf_lsm_v(3)%albedo, & 3107 surf_usm_v(3)%albedo ) 3108 ELSE 3109 ! 3110 !-- Output of averaged data 3111 surfaces%var_out(:) = surfaces%var_av(:,n_out) / & 3112 REAL( average_count_surf, KIND=wp ) 3113 surfaces%var_av(:,n_out) = 0.0_wp 3114 3115 ENDIF 3116 ! 3117 !-- Surface emissivity (tile approach) 3118 CASE ( 'emissivity' ) 3119 ! 3120 !-- Output of instantaneous data 3121 IF ( av == 0 ) THEN 3122 CALL surface_data_output_collect( surf_def_h(0)%emissivity, & 3123 surf_def_h(1)%emissivity, & 3124 surf_lsm_h%emissivity, & 3125 surf_usm_h%emissivity, & 3126 surf_def_v(0)%emissivity, & 3127 surf_lsm_v(0)%emissivity, & 3128 surf_usm_v(0)%emissivity, & 3129 surf_def_v(1)%emissivity, & 3130 surf_lsm_v(1)%emissivity, & 3131 surf_usm_v(1)%emissivity, & 3132 surf_def_v(2)%emissivity, & 3133 surf_lsm_v(2)%emissivity, & 3134 surf_usm_v(2)%emissivity, & 3135 surf_def_v(3)%emissivity, & 3136 surf_lsm_v(3)%emissivity, & 3137 surf_usm_v(3)%emissivity ) 3138 ELSE 3139 ! 3140 !-- Output of averaged data 3141 surfaces%var_out(:) = surfaces%var_av(:,n_out) / & 3142 REAL( average_count_surf, KIND=wp ) 3143 surfaces%var_av(:,n_out) = 0.0_wp 3144 3145 ENDIF 3146 ! 3070 3147 !-- Add further variables: 3071 3148 !-- 'css', 'cssws', 'qsws_liq', 'qsws_soil', 'qsws_veg' … … 4103 4180 surf_usm_v(3)%iwghf_eb, n_out ) 4104 4181 4182 CASE ( 'albedo' ) 4183 CALL surface_data_output_sum_up( surf_def_h(0)%albedo, & 4184 surf_def_h(1)%albedo, & 4185 surf_lsm_h%albedo, & 4186 surf_usm_h%albedo, & 4187 surf_def_v(0)%albedo, & 4188 surf_lsm_v(0)%albedo, & 4189 surf_usm_v(0)%albedo, & 4190 surf_def_v(1)%albedo, & 4191 surf_lsm_v(1)%albedo, & 4192 surf_usm_v(1)%albedo, & 4193 surf_def_v(2)%albedo, & 4194 surf_lsm_v(2)%albedo, & 4195 surf_usm_v(2)%albedo, & 4196 surf_def_v(3)%albedo, & 4197 surf_lsm_v(3)%albedo, & 4198 surf_usm_v(3)%albedo, n_out ) 4199 4200 4201 CASE ( 'emissivity' ) 4202 CALL surface_data_output_sum_up( surf_def_h(0)%emissivity, & 4203 surf_def_h(1)%emissivity, & 4204 surf_lsm_h%emissivity, & 4205 surf_usm_h%emissivity, & 4206 surf_def_v(0)%emissivity, & 4207 surf_lsm_v(0)%emissivity, & 4208 surf_usm_v(0)%emissivity, & 4209 surf_def_v(1)%emissivity, & 4210 surf_lsm_v(1)%emissivity, & 4211 surf_usm_v(1)%emissivity, & 4212 surf_def_v(2)%emissivity, & 4213 surf_lsm_v(2)%emissivity, & 4214 surf_usm_v(2)%emissivity, & 4215 surf_def_v(3)%emissivity, & 4216 surf_lsm_v(3)%emissivity, & 4217 surf_usm_v(3)%emissivity, n_out ) 4218 4105 4219 END SELECT 4106 4220 ENDDO … … 4114 4228 !> Sum-up the surface data for average output variables. 4115 4229 !------------------------------------------------------------------------------! 4116 SUBROUTINE surface_data_output_sum_up ( var_def_h0, var_def_h1,&4230 SUBROUTINE surface_data_output_sum_up_1d( var_def_h0, var_def_h1, & 4117 4231 var_lsm_h, var_usm_h, & 4118 4232 var_def_v0, var_lsm_v0, var_usm_v0, & … … 4339 4453 ENDIF 4340 4454 4341 END SUBROUTINE surface_data_output_sum_up 4455 END SUBROUTINE surface_data_output_sum_up_1d 4456 4457 !------------------------------------------------------------------------------! 4458 ! Description: 4459 ! ------------ 4460 !> Sum-up the surface data for average output variables for properties which 4461 !> are defined using tile approach. 4462 !------------------------------------------------------------------------------! 4463 SUBROUTINE surface_data_output_sum_up_2d( var_def_h0, var_def_h1, & 4464 var_lsm_h, var_usm_h, & 4465 var_def_v0, var_lsm_v0, var_usm_v0, & 4466 var_def_v1, var_lsm_v1, var_usm_v1, & 4467 var_def_v2, var_lsm_v2, var_usm_v2, & 4468 var_def_v3, var_lsm_v3, var_usm_v3, n_out,& 4469 fac ) 4470 4471 IMPLICIT NONE 4472 4473 INTEGER(iwp) :: k !< height index of surface element 4474 INTEGER(iwp) :: m !< running index for surface elements 4475 INTEGER(iwp) :: n_out !< index for output variable 4476 INTEGER(iwp) :: n_surf !< running index for surface elements 4477 4478 REAL(wp), DIMENSION(:), OPTIONAL :: fac !< passed output conversion factor for heatflux output 4479 REAL(wp), DIMENSION(nzb:nzt+1) :: conversion_factor !< effective array for output conversion factor 4480 4481 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_h0 !< output variable at upward-facing default-type surfaces 4482 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_h1 !< output variable at downward-facing default-type surfaces 4483 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_h !< output variable at upward-facing natural-type surfaces 4484 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_h !< output variable at upward-facing urban-type surfaces 4485 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v0 !< output variable at northward-facing default-type surfaces 4486 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v1 !< output variable at southward-facing default-type surfaces 4487 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v2 !< output variable at eastward-facing default-type surfaces 4488 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v3 !< output variable at westward-facing default-type surfaces 4489 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v0 !< output variable at northward-facing natural-type surfaces 4490 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v1 !< output variable at southward-facing natural-type surfaces 4491 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v2 !< output variable at eastward-facing natural-type surfaces 4492 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v3 !< output variable at westward-facing natural-type surfaces 4493 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v0 !< output variable at northward-facing urban-type surfaces 4494 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v1 !< output variable at southward-facing urban-type surfaces 4495 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v2 !< output variable at eastward-facing urban-type surfaces 4496 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v3 !< output variable at westward-facing urban-type surfaces 4497 4498 ! 4499 !-- Set conversion factor to one if not present 4500 IF ( .NOT. PRESENT( fac ) ) THEN 4501 conversion_factor = 1.0_wp 4502 ELSE 4503 conversion_factor = fac 4504 ENDIF 4505 ! 4506 !-- Set counter variable to zero before the variable is written to 4507 !-- the output array. 4508 n_surf = 0 4509 4510 ! 4511 !-- Write the horizontal surfaces. 4512 !-- Before each the variable is written to the output data structure, first 4513 !-- check if the variable for the respective surface type is defined. 4514 !-- If a variable is not defined, skip the block and increment the counter 4515 !-- variable by the number of surface elements of this type. Usually this 4516 !-- is zere, however, there might be the situation that e.g. urban surfaces 4517 !-- are defined but the respective variable is not allocated for this surface 4518 !-- type. To write the data on the exact position, increment the counter. 4519 IF ( ALLOCATED( var_def_h0 ) ) THEN 4520 DO m = 1, surf_def_h(0)%ns 4521 n_surf = n_surf + 1 4522 k = surf_def_h(0)%k(m) 4523 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4524 + SUM ( surf_def_h(0)%frac(m,:) * & 4525 var_def_h0(m,:) ) * conversion_factor(k) 4526 ENDDO 4527 ELSE 4528 n_surf = n_surf + surf_def_h(0)%ns 4529 ENDIF 4530 IF ( ALLOCATED( var_def_h1 ) ) THEN 4531 DO m = 1, surf_def_h(1)%ns 4532 n_surf = n_surf + 1 4533 k = surf_def_h(1)%k(m) 4534 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4535 + SUM ( surf_def_h(1)%frac(m,:) * & 4536 var_def_h1(m,:) ) * conversion_factor(k) 4537 ENDDO 4538 ELSE 4539 n_surf = n_surf + surf_def_h(1)%ns 4540 ENDIF 4541 IF ( ALLOCATED( var_lsm_h ) ) THEN 4542 DO m = 1, surf_lsm_h%ns 4543 n_surf = n_surf + 1 4544 k = surf_lsm_h%k(m) 4545 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4546 + SUM ( surf_lsm_h%frac(m,:) * & 4547 var_lsm_h(m,:) ) * conversion_factor(k) 4548 ENDDO 4549 ELSE 4550 n_surf = n_surf + surf_lsm_h%ns 4551 ENDIF 4552 IF ( ALLOCATED( var_usm_h ) ) THEN 4553 DO m = 1, surf_usm_h%ns 4554 n_surf = n_surf + 1 4555 k = surf_usm_h%k(m) 4556 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4557 + SUM ( surf_usm_h%frac(m,:) * & 4558 var_usm_h(m,:) ) * conversion_factor(k) 4559 ENDDO 4560 ELSE 4561 n_surf = n_surf + surf_usm_h%ns 4562 ENDIF 4563 ! 4564 !-- Write northward-facing 4565 IF ( ALLOCATED( var_def_v0 ) ) THEN 4566 DO m = 1, surf_def_v(0)%ns 4567 n_surf = n_surf + 1 4568 k = surf_def_v(0)%k(m) 4569 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4570 + SUM ( surf_def_v(0)%frac(m,:) * & 4571 var_def_v0(m,:) ) * conversion_factor(k) 4572 ENDDO 4573 ELSE 4574 n_surf = n_surf + surf_def_v(0)%ns 4575 ENDIF 4576 IF ( ALLOCATED( var_lsm_v0 ) ) THEN 4577 DO m = 1, surf_lsm_v(0)%ns 4578 n_surf = n_surf + 1 4579 k = surf_lsm_v(0)%k(m) 4580 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4581 + SUM ( surf_lsm_v(0)%frac(m,:) * & 4582 var_lsm_v0(m,:) ) * conversion_factor(k) 4583 ENDDO 4584 ELSE 4585 n_surf = n_surf + surf_lsm_v(0)%ns 4586 ENDIF 4587 IF ( ALLOCATED( var_usm_v0 ) ) THEN 4588 DO m = 1, surf_usm_v(0)%ns 4589 n_surf = n_surf + 1 4590 k = surf_usm_v(0)%k(m) 4591 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4592 + SUM ( surf_usm_v(0)%frac(m,:) * & 4593 var_usm_v0(m,:) ) * conversion_factor(k) 4594 ENDDO 4595 ELSE 4596 n_surf = n_surf + surf_usm_v(0)%ns 4597 ENDIF 4598 ! 4599 !-- Write southward-facing 4600 IF ( ALLOCATED( var_def_v1 ) ) THEN 4601 DO m = 1, surf_def_v(1)%ns 4602 n_surf = n_surf + 1 4603 k = surf_def_v(1)%k(m) 4604 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4605 + SUM ( surf_def_v(1)%frac(m,:) * & 4606 var_def_v1(m,:) ) * conversion_factor(k) 4607 ENDDO 4608 ELSE 4609 n_surf = n_surf + surf_def_v(1)%ns 4610 ENDIF 4611 IF ( ALLOCATED( var_lsm_v1 ) ) THEN 4612 DO m = 1, surf_lsm_v(1)%ns 4613 n_surf = n_surf + 1 4614 k = surf_lsm_v(1)%k(m) 4615 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4616 + SUM ( surf_lsm_v(1)%frac(m,:) * & 4617 var_lsm_v1(m,:) ) * conversion_factor(k) 4618 ENDDO 4619 ELSE 4620 n_surf = n_surf + surf_lsm_v(1)%ns 4621 ENDIF 4622 IF ( ALLOCATED( var_usm_v1 ) ) THEN 4623 DO m = 1, surf_usm_v(1)%ns 4624 n_surf = n_surf + 1 4625 k = surf_usm_v(1)%k(m) 4626 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4627 + SUM ( surf_usm_v(1)%frac(m,:) * & 4628 var_usm_v1(m,:) ) * conversion_factor(k) 4629 ENDDO 4630 ELSE 4631 n_surf = n_surf + surf_usm_v(1)%ns 4632 ENDIF 4633 ! 4634 !-- Write eastward-facing 4635 IF ( ALLOCATED( var_def_v2 ) ) THEN 4636 DO m = 1, surf_def_v(2)%ns 4637 n_surf = n_surf + 1 4638 k = surf_def_v(2)%k(m) 4639 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4640 + SUM ( surf_def_v(2)%frac(m,:) * & 4641 var_def_v2(m,:) ) * conversion_factor(k) 4642 ENDDO 4643 ELSE 4644 n_surf = n_surf + surf_def_v(2)%ns 4645 ENDIF 4646 IF ( ALLOCATED( var_lsm_v2 ) ) THEN 4647 DO m = 1, surf_lsm_v(2)%ns 4648 n_surf = n_surf + 1 4649 k = surf_lsm_v(2)%k(m) 4650 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4651 + SUM ( surf_lsm_v(2)%frac(m,:) * & 4652 var_lsm_v2(m,:) ) * conversion_factor(k) 4653 ENDDO 4654 ELSE 4655 n_surf = n_surf + surf_lsm_v(2)%ns 4656 ENDIF 4657 IF ( ALLOCATED( var_usm_v2 ) ) THEN 4658 DO m = 1, surf_usm_v(2)%ns 4659 n_surf = n_surf + 1 4660 k = surf_usm_v(2)%k(m) 4661 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4662 + SUM ( surf_usm_v(2)%frac(m,:) * & 4663 var_usm_v2(m,:) ) * conversion_factor(k) 4664 ENDDO 4665 ELSE 4666 n_surf = n_surf + surf_usm_v(2)%ns 4667 ENDIF 4668 ! 4669 !-- Write westward-facing 4670 IF ( ALLOCATED( var_def_v3 ) ) THEN 4671 DO m = 1, surf_def_v(3)%ns 4672 n_surf = n_surf + 1 4673 k = surf_def_v(3)%k(m) 4674 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4675 + SUM ( surf_def_v(3)%frac(m,:) * & 4676 var_def_v3(m,:) ) * conversion_factor(k) 4677 ENDDO 4678 ELSE 4679 n_surf = n_surf + surf_def_v(3)%ns 4680 ENDIF 4681 IF ( ALLOCATED( var_lsm_v3 ) ) THEN 4682 DO m = 1, surf_lsm_v(3)%ns 4683 n_surf = n_surf + 1 4684 k = surf_lsm_v(3)%k(m) 4685 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4686 + SUM ( surf_lsm_v(3)%frac(m,:) * & 4687 var_lsm_v3(m,:) ) * conversion_factor(k) 4688 ENDDO 4689 ELSE 4690 n_surf = n_surf + surf_lsm_v(3)%ns 4691 ENDIF 4692 IF ( ALLOCATED( var_usm_v3 ) ) THEN 4693 DO m = 1, surf_usm_v(3)%ns 4694 n_surf = n_surf + 1 4695 k = surf_usm_v(3)%k(m) 4696 surfaces%var_av(n_surf,n_out) = surfaces%var_av(n_surf,n_out) & 4697 + SUM ( surf_usm_v(3)%frac(m,:) * & 4698 var_usm_v3(m,:) ) * conversion_factor(k) 4699 ENDDO 4700 ELSE 4701 n_surf = n_surf + surf_usm_v(3)%ns 4702 ENDIF 4703 4704 END SUBROUTINE surface_data_output_sum_up_2d 4342 4705 4343 4706 !------------------------------------------------------------------------------! … … 4346 4709 !> Collect the surface data from different types and different orientation. 4347 4710 !------------------------------------------------------------------------------! 4348 SUBROUTINE surface_data_output_collect ( var_def_h0, var_def_h1,&4711 SUBROUTINE surface_data_output_collect_1d( var_def_h0, var_def_h1, & 4349 4712 var_lsm_h, var_usm_h, & 4350 4713 var_def_v0, var_lsm_v0, var_usm_v0, & … … 4553 4916 ENDIF 4554 4917 4555 END SUBROUTINE surface_data_output_collect 4918 END SUBROUTINE surface_data_output_collect_1d 4919 4920 !------------------------------------------------------------------------------! 4921 ! Description: 4922 ! ------------ 4923 !> Collect the surface data from different types and different orientation 4924 !> for properties which are defined using tile approach. 4925 !------------------------------------------------------------------------------! 4926 SUBROUTINE surface_data_output_collect_2d( var_def_h0, var_def_h1, & 4927 var_lsm_h, var_usm_h, & 4928 var_def_v0, var_lsm_v0, var_usm_v0, & 4929 var_def_v1, var_lsm_v1, var_usm_v1, & 4930 var_def_v2, var_lsm_v2, var_usm_v2, & 4931 var_def_v3, var_lsm_v3, var_usm_v3, & 4932 fac ) 4933 4934 IMPLICIT NONE 4935 4936 INTEGER(iwp) :: k !< height index of surface element 4937 INTEGER(iwp) :: m !< running index for surface elements 4938 INTEGER(iwp) :: n_surf !< running index for surface elements 4939 4940 REAL(wp), DIMENSION(:), OPTIONAL :: fac !< passed output conversion factor for heatflux output 4941 REAL(wp), DIMENSION(nzb:nzt+1) :: conversion_factor !< effective array for output conversion factor 4942 4943 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_h0 !< output variable at upward-facing default-type surfaces 4944 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_h1 !< output variable at downward-facing default-type surfaces 4945 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_h !< output variable at upward-facing natural-type surfaces 4946 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_h !< output variable at upward-facing urban-type surfaces 4947 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v0 !< output variable at northward-facing default-type surfaces 4948 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v1 !< output variable at southward-facing default-type surfaces 4949 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v2 !< output variable at eastward-facing default-type surfaces 4950 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_def_v3 !< output variable at westward-facing default-type surfaces 4951 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v0 !< output variable at northward-facing natural-type surfaces 4952 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v1 !< output variable at southward-facing natural-type surfaces 4953 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v2 !< output variable at eastward-facing natural-type surfaces 4954 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_lsm_v3 !< output variable at westward-facing natural-type surfaces 4955 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v0 !< output variable at northward-facing urban-type surfaces 4956 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v1 !< output variable at southward-facing urban-type surfaces 4957 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v2 !< output variable at eastward-facing urban-type surfaces 4958 REAL(wp), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: var_usm_v3 !< output variable at westward-facing urban-type surfaces 4959 4960 ! 4961 !-- Set conversion factor to one if not present 4962 IF ( .NOT. PRESENT( fac ) ) THEN 4963 conversion_factor = 1.0_wp 4964 ELSE 4965 conversion_factor = fac 4966 ENDIF 4967 ! 4968 !-- Set counter variable to zero before the variable is written to 4969 !-- the output array. 4970 n_surf = 0 4971 ! 4972 !-- Write the horizontal surfaces. 4973 !-- Before each the variable is written to the output data structure, first 4974 !-- check if the variable for the respective surface type is defined. 4975 !-- If a variable is not defined, skip the block and increment the counter 4976 !-- variable by the number of surface elements of this type. Usually this 4977 !-- is zero, however, there might be the situation that e.g. urban surfaces 4978 !-- are defined but the respective variable is not allocated for this surface 4979 !-- type. To write the data on the exact position, increment the counter. 4980 IF ( ALLOCATED( var_def_h0 ) ) THEN 4981 DO m = 1, surf_def_h(0)%ns 4982 n_surf = n_surf + 1 4983 k = surf_def_h(0)%k(m) 4984 surfaces%var_out(n_surf) = SUM ( surf_def_h(0)%frac(m,:) * & 4985 var_def_h0(m,:) ) * conversion_factor(k) 4986 ENDDO 4987 ELSE 4988 n_surf = n_surf + surf_def_h(0)%ns 4989 ENDIF 4990 IF ( ALLOCATED( var_def_h1 ) ) THEN 4991 DO m = 1, surf_def_h(1)%ns 4992 n_surf = n_surf + 1 4993 k = surf_def_h(1)%k(m) 4994 surfaces%var_out(n_surf) = SUM ( surf_def_h(1)%frac(m,:) * & 4995 var_def_h1(m,:) ) * conversion_factor(k) 4996 ENDDO 4997 ELSE 4998 n_surf = n_surf + surf_def_h(1)%ns 4999 ENDIF 5000 IF ( ALLOCATED( var_lsm_h ) ) THEN 5001 DO m = 1, surf_lsm_h%ns 5002 n_surf = n_surf + 1 5003 k = surf_lsm_h%k(m) 5004 surfaces%var_out(n_surf) = SUM ( surf_lsm_h%frac(m,:) * & 5005 var_lsm_h(m,:) ) * conversion_factor(k) 5006 ENDDO 5007 ELSE 5008 n_surf = n_surf + surf_lsm_h%ns 5009 ENDIF 5010 IF ( ALLOCATED( var_usm_h ) ) THEN 5011 DO m = 1, surf_usm_h%ns 5012 n_surf = n_surf + 1 5013 k = surf_usm_h%k(m) 5014 surfaces%var_out(n_surf) = SUM ( surf_usm_h%frac(m,:) * & 5015 var_usm_h(m,:) ) * conversion_factor(k) 5016 ENDDO 5017 ELSE 5018 n_surf = n_surf + surf_usm_h%ns 5019 ENDIF 5020 ! 5021 !-- Write northward-facing 5022 IF ( ALLOCATED( var_def_v0 ) ) THEN 5023 DO m = 1, surf_def_v(0)%ns 5024 n_surf = n_surf + 1 5025 k = surf_def_v(0)%k(m) 5026 surfaces%var_out(n_surf) = SUM ( surf_def_v(0)%frac(m,:) * & 5027 var_def_v0(m,:) ) * conversion_factor(k) 5028 ENDDO 5029 ELSE 5030 n_surf = n_surf + surf_def_v(0)%ns 5031 ENDIF 5032 IF ( ALLOCATED( var_lsm_v0 ) ) THEN 5033 DO m = 1, surf_lsm_v(0)%ns 5034 n_surf = n_surf + 1 5035 k = surf_lsm_v(0)%k(m) 5036 surfaces%var_out(n_surf) = SUM ( surf_lsm_v(0)%frac(m,:) * & 5037 var_lsm_v0(m,:) ) * conversion_factor(k) 5038 ENDDO 5039 ELSE 5040 n_surf = n_surf + surf_lsm_v(0)%ns 5041 ENDIF 5042 IF ( ALLOCATED( var_usm_v0 ) ) THEN 5043 DO m = 1, surf_usm_v(0)%ns 5044 n_surf = n_surf + 1 5045 k = surf_usm_v(0)%k(m) 5046 surfaces%var_out(n_surf) = SUM ( surf_usm_v(0)%frac(m,:) * & 5047 var_usm_v0(m,:) ) * conversion_factor(k) 5048 ENDDO 5049 ELSE 5050 n_surf = n_surf + surf_usm_v(0)%ns 5051 ENDIF 5052 ! 5053 !-- Write southward-facing 5054 IF ( ALLOCATED( var_def_v1 ) ) THEN 5055 DO m = 1, surf_def_v(1)%ns 5056 n_surf = n_surf + 1 5057 k = surf_def_v(1)%k(m) 5058 surfaces%var_out(n_surf) = SUM ( surf_def_v(1)%frac(m,:) * & 5059 var_def_v1(m,:) ) * conversion_factor(k) 5060 ENDDO 5061 ELSE 5062 n_surf = n_surf + surf_def_v(1)%ns 5063 ENDIF 5064 IF ( ALLOCATED( var_lsm_v1 ) ) THEN 5065 DO m = 1, surf_lsm_v(1)%ns 5066 n_surf = n_surf + 1 5067 k = surf_lsm_v(1)%k(m) 5068 surfaces%var_out(n_surf) = SUM ( surf_lsm_v(1)%frac(m,:) * & 5069 var_lsm_v1(m,:) ) * conversion_factor(k) 5070 ENDDO 5071 ELSE 5072 n_surf = n_surf + surf_lsm_v(1)%ns 5073 ENDIF 5074 IF ( ALLOCATED( var_usm_v1 ) ) THEN 5075 DO m = 1, surf_usm_v(1)%ns 5076 n_surf = n_surf + 1 5077 k = surf_usm_v(1)%k(m) 5078 surfaces%var_out(n_surf) = SUM ( surf_usm_v(1)%frac(m,:) * & 5079 var_usm_v1(m,:) ) * conversion_factor(k) 5080 ENDDO 5081 ELSE 5082 n_surf = n_surf + surf_usm_v(1)%ns 5083 ENDIF 5084 ! 5085 !-- Write eastward-facing 5086 IF ( ALLOCATED( var_def_v2 ) ) THEN 5087 DO m = 1, surf_def_v(2)%ns 5088 n_surf = n_surf + 1 5089 k = surf_def_v(2)%k(m) 5090 surfaces%var_out(n_surf) = SUM ( surf_def_v(2)%frac(m,:) * & 5091 var_def_v2(m,:) ) * conversion_factor(k) 5092 ENDDO 5093 ELSE 5094 n_surf = n_surf + surf_def_v(2)%ns 5095 ENDIF 5096 IF ( ALLOCATED( var_lsm_v2 ) ) THEN 5097 DO m = 1, surf_lsm_v(2)%ns 5098 n_surf = n_surf + 1 5099 k = surf_lsm_v(2)%k(m) 5100 surfaces%var_out(n_surf) = SUM ( surf_lsm_v(2)%frac(m,:) * & 5101 var_lsm_v2(m,:) ) * conversion_factor(k) 5102 ENDDO 5103 ELSE 5104 n_surf = n_surf + surf_lsm_v(2)%ns 5105 ENDIF 5106 IF ( ALLOCATED( var_usm_v2 ) ) THEN 5107 DO m = 1, surf_usm_v(2)%ns 5108 n_surf = n_surf + 1 5109 k = surf_usm_v(2)%k(m) 5110 surfaces%var_out(n_surf) = SUM ( surf_usm_v(2)%frac(m,:) * & 5111 var_usm_v2(m,:) ) * conversion_factor(k) 5112 ENDDO 5113 ELSE 5114 n_surf = n_surf + surf_usm_v(2)%ns 5115 ENDIF 5116 ! 5117 !-- Write westward-facing 5118 IF ( ALLOCATED( var_def_v3 ) ) THEN 5119 DO m = 1, surf_def_v(3)%ns 5120 n_surf = n_surf + 1 5121 k = surf_def_v(3)%k(m) 5122 surfaces%var_out(n_surf) = SUM ( surf_def_v(3)%frac(m,:) * & 5123 var_def_v3(m,:) ) * conversion_factor(k) 5124 ENDDO 5125 ELSE 5126 n_surf = n_surf + surf_def_v(3)%ns 5127 ENDIF 5128 IF ( ALLOCATED( var_lsm_v3 ) ) THEN 5129 DO m = 1, surf_lsm_v(3)%ns 5130 n_surf = n_surf + 1 5131 k = surf_lsm_v(3)%k(m) 5132 surfaces%var_out(n_surf) = SUM ( surf_lsm_v(3)%frac(m,:) * & 5133 var_lsm_v3(m,:) ) * conversion_factor(k) 5134 ENDDO 5135 ELSE 5136 n_surf = n_surf + surf_lsm_v(3)%ns 5137 ENDIF 5138 IF ( ALLOCATED( var_usm_v3 ) ) THEN 5139 DO m = 1, surf_usm_v(3)%ns 5140 n_surf = n_surf + 1 5141 k = surf_usm_v(3)%k(m) 5142 surfaces%var_out(n_surf) = SUM ( surf_usm_v(3)%frac(m,:) * & 5143 var_usm_v3(m,:) ) * conversion_factor(k) 5144 ENDDO 5145 ELSE 5146 n_surf = n_surf + surf_usm_v(3)%ns 5147 ENDIF 5148 5149 END SUBROUTINE surface_data_output_collect_2d 4556 5150 4557 5151 !------------------------------------------------------------------------------! … … 4785 5379 unit = 'W/m2' 4786 5380 5381 CASE ( 'albedo', 'emissivity' ) 5382 unit = '1' 5383 4787 5384 CASE DEFAULT 4788 5385 message_string = TRIM( trimvar ) // &
Note: See TracChangeset
for help on using the changeset viewer.
