Changeset 4312
- Timestamp:
- Nov 27, 2019 2:06:25 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
land_surface_model_mod.f90 (modified) (4 diffs)
-
netcdf_data_input_mod.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r4296 r4312 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Initialization of relative surface fractions revised 23 23 ! 24 24 ! Former revisions: … … 2656 2656 soil_type_f%var_2d(j,i) = 1 2657 2657 ! 2658 !-- Set surface_fraction if provided in static input, 2659 !-- else, in case no tiles are used, this will be done 2660 !-- on basis of the prescribed types (vegetation/pavement/ 2661 !-- water_type). 2658 !-- If surface_fraction is provided in static input, 2659 !-- set fraction for vegetation to one at building-covered 2660 !-- surfaces. 2662 2661 IF ( surface_fraction_f%from_file ) THEN 2663 2662 surface_fraction_f%frac(ind_veg_wall,j,i) = 1.0_wp … … 2708 2707 j = surf_lsm_h%j(m) 2709 2708 ! 2710 !-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction 2711 surf_lsm_h%frac(ind_veg_wall,m) = & 2712 surface_fraction_f%frac(ind_veg_wall,j,i) 2713 surf_lsm_h%frac(ind_pav_green,m) = & 2714 surface_fraction_f%frac(ind_pav_green,j,i) 2715 surf_lsm_h%frac(ind_wat_win,m) = & 2709 !-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction 2710 IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= & 2711 surface_fraction_f%fill ) THEN 2712 surf_lsm_h%frac(ind_veg_wall,m) = & 2713 surface_fraction_f%frac(ind_veg_wall,j,i) 2714 ENDIF 2715 IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= & 2716 surface_fraction_f%fill ) THEN 2717 surf_lsm_h%frac(ind_pav_green,m) = & 2718 surface_fraction_f%frac(ind_pav_green,j,i) 2719 ENDIF 2720 IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= & 2721 surface_fraction_f%fill ) THEN 2722 surf_lsm_h%frac(ind_wat_win,m) = & 2716 2723 surface_fraction_f%frac(ind_wat_win,j,i) 2724 ENDIF 2725 ! 2726 !-- Check if sum of relative fractions is zero. This case, give an 2727 !-- error message. 2728 IF ( SUM ( surf_lsm_h%frac(:,m) ) == 0.0_wp ) THEN 2729 WRITE( message_string, * ) & 2730 'surface fractions at grid point (j,i) = (', & 2731 j, i, ') are all zero.' 2732 CALL message( 'land_surface_model_mod', 'PA0688', & 2733 2, 2, myid, 6, 0 ) 2734 ENDIF 2735 ! 2736 !-- In case the sum of all surfaces is not 1, which may happen 2737 !-- due to rounding errors or type conversions, normalize the 2738 !-- fractions to one. Note, at the moment no tile approach is 2739 !-- implemented, so that relative fractions are either 1 or zero. 2740 IF ( SUM ( surf_lsm_h%frac(:,m) ) > 1.0_wp .OR. & 2741 SUM ( surf_lsm_h%frac(:,m) ) < 1.0_wp ) THEN 2742 surf_lsm_h%frac(:,m) = surf_lsm_h%frac(:,m) / & 2743 SUM ( surf_lsm_h%frac(:,m) ) 2744 2745 ENDIF 2717 2746 2718 2747 ENDDO … … 2725 2754 ! 2726 2755 !-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction 2727 surf_lsm_v(l)%frac(ind_veg_wall,m) = & 2728 surface_fraction_f%frac(ind_veg_wall,j,i) 2729 surf_lsm_v(l)%frac(ind_pav_green,m) = & 2730 surface_fraction_f%frac(ind_pav_green,j,i) 2731 surf_lsm_v(l)%frac(ind_wat_win,m) = & 2756 IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= & 2757 surface_fraction_f%fill ) THEN 2758 surf_lsm_v(l)%frac(ind_veg_wall,m) = & 2759 surface_fraction_f%frac(ind_veg_wall,j,i) 2760 ENDIF 2761 IF ( surface_fraction_f%frac(ind_pav_green,j,i) /= & 2762 surface_fraction_f%fill ) THEN 2763 surf_lsm_v(l)%frac(ind_pav_green,m) = & 2764 surface_fraction_f%frac(ind_pav_green,j,i) 2765 ENDIF 2766 IF ( surface_fraction_f%frac(ind_wat_win,j,i) /= & 2767 surface_fraction_f%fill ) THEN 2768 surf_lsm_v(l)%frac(ind_wat_win,m) = & 2732 2769 surface_fraction_f%frac(ind_wat_win,j,i) 2733 2770 ENDIF 2771 ! 2772 !-- Check if sum of relative fractions is zero. This case, give an 2773 !-- error message. 2774 IF ( SUM ( surf_lsm_v(l)%frac(:,m) ) == 0.0_wp ) THEN 2775 WRITE( message_string, * ) & 2776 'surface fractions at grid point (j,i) = (', & 2777 j, i, ') are all zero.' 2778 CALL message( 'land_surface_model_mod', 'PA0688', & 2779 2, 2, myid, 6, 0 ) 2780 ENDIF 2781 ! 2782 !-- In case the sum of all surfaces is not 1, which may happen 2783 !-- due to rounding errors or type conversions, normalize the 2784 !-- fractions to one. Note, at the moment no tile approach is 2785 !-- implemented, so that relative fractions are either 1 or zero. 2786 IF ( SUM ( surf_lsm_v(l)%frac(:,m) ) > 1.0_wp .OR. & 2787 SUM ( surf_lsm_v(l)%frac(:,m) ) < 1.0_wp ) THEN 2788 surf_lsm_v(l)%frac(:,m) = surf_lsm_v(l)%frac(:,m) / & 2789 SUM ( surf_lsm_v(l)%frac(:,m) ) 2790 2791 ENDIF 2734 2792 ENDDO 2735 2793 ENDDO -
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r4298 r4312 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Checks for surface fractions revised 23 23 ! 24 24 ! Former revisions: … … 3643 3643 2, 2, myid, 6, 0 ) 3644 3644 ENDIF 3645 ENDIF 3646 ! 3647 !-- Check for consistency of surface fraction. If more than one type 3648 !-- is set, surface fraction need to be given and the sum must not 3649 !-- be larger than 1. 3645 ENDIF 3646 ! 3647 !-- Check for consistency of given types. At the moment, only one 3648 !-- of vegetation, pavement, or water-type can be set. This is 3649 !-- because no tile approach is yet implemented in the land-surface 3650 !-- model. Later, when this is possible, surface fraction need to be 3651 !-- given and the sum must not be larger than 1. Please note, in case 3652 !-- more than one type is given at a pixel, an error message will be 3653 !-- given. 3650 3654 n_surf = 0 3651 3655 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & … … 3657 3661 3658 3662 IF ( n_surf > 1 ) THEN 3659 IF ( .NOT. surface_fraction_f%from_file ) THEN 3660 message_string = 'If more than one surface type is ' // & 3661 'given at a location, surface_fraction ' // & 3662 'must be provided.' 3663 CALL message( 'netcdf_data_input_mod', 'PA0565', & 3664 2, 2, myid, 6, 0 ) 3665 ELSEIF ( ANY ( surface_fraction_f%frac(:,j,i) == & 3666 surface_fraction_f%fill ) ) THEN 3667 message_string = 'If more than one surface type is ' // & 3668 'given at a location, surface_fraction ' // & 3669 'must be provided.' 3670 CALL message( 'netcdf_data_input_mod', 'PA0565', & 3671 2, 2, myid, 6, 0 ) 3672 ENDIF 3663 WRITE( message_string, * ) & 3664 'More than one surface type (vegetation, '// & 3665 'pavement, water) is given at a location. '// & 3666 'Please note, this is not possible at ' // & 3667 'the moment as no tile approach has been ' // & 3668 'yet implemented. (i,j) = ', i, j 3669 CALL message( 'netcdf_data_input_mod', 'PA0565', & 3670 2, 2, myid, 6, 0 ) 3671 3672 ! IF ( .NOT. surface_fraction_f%from_file ) THEN 3673 ! message_string = 'More than one surface type (vegetation '//& 3674 ! 'pavement, water) is given at a location. '// & 3675 ! 'Please note, this is not possible at ' // & 3676 ! 'the moment as no tile approach is yet ' // & 3677 ! 'implemented.' 3678 ! message_string = 'If more than one surface type is ' // & 3679 ! 'given at a location, surface_fraction ' // & 3680 ! 'must be provided.' 3681 ! CALL message( 'netcdf_data_input_mod', 'PA0565', & 3682 ! 2, 2, myid, 6, 0 ) 3683 ! ELSEIF ( ANY ( surface_fraction_f%frac(:,j,i) == & 3684 ! surface_fraction_f%fill ) ) THEN 3685 ! message_string = 'If more than one surface type is ' // & 3686 ! 'given at a location, surface_fraction ' // & 3687 ! 'must be provided.' 3688 ! CALL message( 'netcdf_data_input_mod', 'PA0565', & 3689 ! 2, 2, myid, 6, 0 ) 3690 ! ENDIF 3673 3691 ENDIF 3674 3692 ! … … 3678 3696 IF ( surface_fraction_f%from_file ) THEN 3679 3697 ! 3680 !-- Sum of relative fractions must not exceed 1. 3681 IF ( SUM ( surface_fraction_f%frac(0:2,j,i) ) > 1.0_wp ) THEN 3682 message_string = 'surface_fraction must not exceed 1' 3683 CALL message( 'netcdf_data_input_mod', 'PA0566', & 3698 !-- If surface fractions is given, also check that only one type 3699 !-- is given. 3700 IF ( SUM( MERGE( 1, 0, surface_fraction_f%frac(:,j,i) /= 0.0_wp& 3701 .AND. surface_fraction_f%frac(:,j,i) /= & 3702 surface_fraction_f%fill ) ) > 1 ) THEN 3703 WRITE( message_string, * ) & 3704 'surface_fraction is given for more ' // & 3705 'than one type. ' // & 3706 'Please note, this is not possible at ' // & 3707 'the moment as no tile approach has '// & 3708 'yet been implemented. (i, j) = ', i, j 3709 CALL message( 'netcdf_data_input_mod', 'PA0676', & 3684 3710 2, 2, myid, 6, 0 ) 3711 ENDIF 3712 ! 3713 !-- Sum of relative fractions must be 1. Note, due to type 3714 !-- type conversions due to reading, the sum of surface fractions 3715 !-- might be not exactly 1. Hence, the sum is check with a 3716 !-- tolerance. Later, in the land-surface model, the relative 3717 !-- fractions are normalized to one. 3718 IF ( ANY( surface_fraction_f%frac(:,j,i) /= & 3719 surface_fraction_f%fill ) ) THEN 3720 IF ( SUM ( surface_fraction_f%frac(0:2,j,i) ) > & 3721 1.0_wp + 1E-8_wp .OR. & 3722 SUM ( surface_fraction_f%frac(0:2,j,i) ) < & 3723 1.0_wp - 1E-8_wp ) THEN 3724 WRITE( message_string, * ) & 3725 'The sum of all land-surface fractions ' //& 3726 'must equal 1. ', i, j 3727 CALL message( 'netcdf_data_input_mod', 'PA0566', & 3728 2, 2, myid, 6, 0 ) 3729 ENDIF 3685 3730 ENDIF 3686 3731 !
Note: See TracChangeset
for help on using the changeset viewer.
