Changeset 3435 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Oct 26, 2018 6:25:44 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3424 r3435 28 28 ! ----------------- 29 29 ! $Id$ 30 ! - workaround: return unit=illegal in check_data_output for certain variables 31 ! when check called from init_masks 32 ! - Use pointer in masked output to reduce code redundancies 33 ! - Add terrain-following masked output 34 ! 35 ! 3424 2018-10-25 07:29:10Z gronemeier 30 36 ! bugfix: add rad_lw_in, rad_lw_out, rad_sw_out to radiation_check_data_output 31 37 ! … … 1250 1256 'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*', & 1251 1257 'rad_sw_out*') 1258 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1259 ! Workaround for masked output (calls with i=ilen=k=0) 1260 unit = 'illegal' 1261 RETURN 1262 ENDIF 1252 1263 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 1253 1264 message_string = 'illegal value for data_output: "' // & … … 1281 1292 1282 1293 CASE ( 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw' ) 1294 1295 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1296 ! Workaround for masked output (calls with i=ilen=k=0) 1297 unit = 'illegal' 1298 RETURN 1299 ENDIF 1300 1283 1301 IF ( .NOT. radiation ) THEN 1284 1302 message_string = 'output of "' // TRIM( var ) // '" require'& … … 8890 8908 found = .TRUE. 8891 8909 8892 8893 8910 ! 8894 8911 !-- Check for the grid … … 9634 9651 CHARACTER (LEN=*) :: variable !< 9635 9652 9636 INTEGER(iwp) :: av !< 9637 INTEGER(iwp) :: i !< 9638 INTEGER(iwp) :: j !< 9639 INTEGER(iwp) :: k !< 9640 9641 LOGICAL :: found !< 9653 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids 9654 9655 INTEGER(iwp) :: av !< 9656 INTEGER(iwp) :: i !< 9657 INTEGER(iwp) :: j !< 9658 INTEGER(iwp) :: k !< 9659 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 9660 9661 LOGICAL :: found !< true if output array was found 9662 LOGICAL :: resorted !< true if array is resorted 9663 9642 9664 9643 9665 REAL(wp), & … … 9645 9667 local_pf !< 9646 9668 9647 9648 found = .TRUE. 9669 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 9670 9671 9672 found = .TRUE. 9673 grid = 's' 9674 resorted = .FALSE. 9649 9675 9650 9676 SELECT CASE ( TRIM( variable ) ) … … 9653 9679 CASE ( 'rad_lw_in' ) 9654 9680 IF ( av == 0 ) THEN 9655 DO i = 1, mask_size_l(mid,1) 9656 DO j = 1, mask_size_l(mid,2) 9657 DO k = 1, mask_size_l(mid,3) 9658 local_pf(i,j,k) = rad_lw_in(mask_k(mid,k), & 9659 mask_j(mid,j),mask_i(mid,i)) 9660 ENDDO 9661 ENDDO 9662 ENDDO 9681 to_be_resorted => rad_lw_in 9663 9682 ELSE 9664 DO i = 1, mask_size_l(mid,1) 9665 DO j = 1, mask_size_l(mid,2) 9666 DO k = 1, mask_size_l(mid,3) 9667 local_pf(i,j,k) = rad_lw_in_av(mask_k(mid,k), & 9668 mask_j(mid,j),mask_i(mid,i)) 9669 ENDDO 9683 to_be_resorted => rad_lw_in_av 9684 ENDIF 9685 9686 CASE ( 'rad_lw_out' ) 9687 IF ( av == 0 ) THEN 9688 to_be_resorted => rad_lw_out 9689 ELSE 9690 to_be_resorted => rad_lw_out_av 9691 ENDIF 9692 9693 CASE ( 'rad_lw_cs_hr' ) 9694 IF ( av == 0 ) THEN 9695 to_be_resorted => rad_lw_cs_hr 9696 ELSE 9697 to_be_resorted => rad_lw_cs_hr_av 9698 ENDIF 9699 9700 CASE ( 'rad_lw_hr' ) 9701 IF ( av == 0 ) THEN 9702 to_be_resorted => rad_lw_hr 9703 ELSE 9704 to_be_resorted => rad_lw_hr_av 9705 ENDIF 9706 9707 CASE ( 'rad_sw_in' ) 9708 IF ( av == 0 ) THEN 9709 to_be_resorted => rad_sw_in 9710 ELSE 9711 to_be_resorted => rad_sw_in_av 9712 ENDIF 9713 9714 CASE ( 'rad_sw_out' ) 9715 IF ( av == 0 ) THEN 9716 to_be_resorted => rad_sw_out 9717 ELSE 9718 to_be_resorted => rad_sw_out_av 9719 ENDIF 9720 9721 CASE ( 'rad_sw_cs_hr' ) 9722 IF ( av == 0 ) THEN 9723 to_be_resorted => rad_sw_cs_hr 9724 ELSE 9725 to_be_resorted => rad_sw_cs_hr_av 9726 ENDIF 9727 9728 CASE ( 'rad_sw_hr' ) 9729 IF ( av == 0 ) THEN 9730 to_be_resorted => rad_sw_hr 9731 ELSE 9732 to_be_resorted => rad_sw_hr_av 9733 ENDIF 9734 9735 CASE DEFAULT 9736 found = .FALSE. 9737 9738 END SELECT 9739 9740 ! 9741 !-- Resort the array to be output, if not done above 9742 IF ( .NOT. resorted ) THEN 9743 IF ( .NOT. mask_surface(mid) ) THEN 9744 ! 9745 !-- Default masked output 9746 DO i = 1, mask_size_l(mid,1) 9747 DO j = 1, mask_size_l(mid,2) 9748 DO k = 1, mask_size_l(mid,3) 9749 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 9750 mask_j(mid,j),mask_i(mid,i)) 9670 9751 ENDDO 9671 9752 ENDDO 9672 ENDIF 9673 9674 CASE ( 'rad_lw_out' ) 9675 IF ( av == 0 ) THEN 9676 DO i = 1, mask_size_l(mid,1) 9677 DO j = 1, mask_size_l(mid,2) 9678 DO k = 1, mask_size_l(mid,3) 9679 local_pf(i,j,k) = rad_lw_out(mask_k(mid,k), & 9680 mask_j(mid,j),mask_i(mid,i)) 9681 ENDDO 9682 ENDDO 9683 ENDDO 9684 ELSE 9685 DO i = 1, mask_size_l(mid,1) 9686 DO j = 1, mask_size_l(mid,2) 9687 DO k = 1, mask_size_l(mid,3) 9688 local_pf(i,j,k) = rad_lw_out_av(mask_k(mid,k), & 9689 mask_j(mid,j),mask_i(mid,i)) 9690 ENDDO 9753 ENDDO 9754 9755 ELSE 9756 ! 9757 !-- Terrain-following masked output 9758 DO i = 1, mask_size_l(mid,1) 9759 DO j = 1, mask_size_l(mid,2) 9760 ! 9761 !-- Get k index of highest horizontal surface 9762 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), & 9763 mask_i(mid,i), & 9764 grid ) 9765 ! 9766 !-- Save output array 9767 DO k = 1, mask_size_l(mid,3) 9768 local_pf(i,j,k) = to_be_resorted( & 9769 MIN( topo_top_ind+mask_k(mid,k), & 9770 nzt+1 ), & 9771 mask_j(mid,j), & 9772 mask_i(mid,i) ) 9691 9773 ENDDO 9692 9774 ENDDO 9693 ENDIF 9694 9695 CASE ( 'rad_lw_cs_hr' ) 9696 IF ( av == 0 ) THEN 9697 DO i = 1, mask_size_l(mid,1) 9698 DO j = 1, mask_size_l(mid,2) 9699 DO k = 1, mask_size_l(mid,3) 9700 local_pf(i,j,k) = rad_lw_cs_hr(mask_k(mid,k), & 9701 mask_j(mid,j),mask_i(mid,i)) 9702 ENDDO 9703 ENDDO 9704 ENDDO 9705 ELSE 9706 DO i = 1, mask_size_l(mid,1) 9707 DO j = 1, mask_size_l(mid,2) 9708 DO k = 1, mask_size_l(mid,3) 9709 local_pf(i,j,k) = rad_lw_cs_hr_av(mask_k(mid,k), & 9710 mask_j(mid,j),mask_i(mid,i)) 9711 ENDDO 9712 ENDDO 9713 ENDDO 9714 ENDIF 9715 9716 CASE ( 'rad_lw_hr' ) 9717 IF ( av == 0 ) THEN 9718 DO i = 1, mask_size_l(mid,1) 9719 DO j = 1, mask_size_l(mid,2) 9720 DO k = 1, mask_size_l(mid,3) 9721 local_pf(i,j,k) = rad_lw_hr(mask_k(mid,k), & 9722 mask_j(mid,j),mask_i(mid,i)) 9723 ENDDO 9724 ENDDO 9725 ENDDO 9726 ELSE 9727 DO i = 1, mask_size_l(mid,1) 9728 DO j = 1, mask_size_l(mid,2) 9729 DO k = 1, mask_size_l(mid,3) 9730 local_pf(i,j,k) = rad_lw_hr_av(mask_k(mid,k), & 9731 mask_j(mid,j),mask_i(mid,i)) 9732 ENDDO 9733 ENDDO 9734 ENDDO 9735 ENDIF 9736 9737 CASE ( 'rad_sw_in' ) 9738 IF ( av == 0 ) THEN 9739 DO i = 1, mask_size_l(mid,1) 9740 DO j = 1, mask_size_l(mid,2) 9741 DO k = 1, mask_size_l(mid,3) 9742 local_pf(i,j,k) = rad_sw_in(mask_k(mid,k), & 9743 mask_j(mid,j),mask_i(mid,i)) 9744 ENDDO 9745 ENDDO 9746 ENDDO 9747 ELSE 9748 DO i = 1, mask_size_l(mid,1) 9749 DO j = 1, mask_size_l(mid,2) 9750 DO k = 1, mask_size_l(mid,3) 9751 local_pf(i,j,k) = rad_sw_in_av(mask_k(mid,k), & 9752 mask_j(mid,j),mask_i(mid,i)) 9753 ENDDO 9754 ENDDO 9755 ENDDO 9756 ENDIF 9757 9758 CASE ( 'rad_sw_out' ) 9759 IF ( av == 0 ) THEN 9760 DO i = 1, mask_size_l(mid,1) 9761 DO j = 1, mask_size_l(mid,2) 9762 DO k = 1, mask_size_l(mid,3) 9763 local_pf(i,j,k) = rad_sw_out(mask_k(mid,k), & 9764 mask_j(mid,j),mask_i(mid,i)) 9765 ENDDO 9766 ENDDO 9767 ENDDO 9768 ELSE 9769 DO i = 1, mask_size_l(mid,1) 9770 DO j = 1, mask_size_l(mid,2) 9771 DO k = 1, mask_size_l(mid,3) 9772 local_pf(i,j,k) = rad_sw_out_av(mask_k(mid,k), & 9773 mask_j(mid,j),mask_i(mid,i)) 9774 ENDDO 9775 ENDDO 9776 ENDDO 9777 ENDIF 9778 9779 CASE ( 'rad_sw_cs_hr' ) 9780 IF ( av == 0 ) THEN 9781 DO i = 1, mask_size_l(mid,1) 9782 DO j = 1, mask_size_l(mid,2) 9783 DO k = 1, mask_size_l(mid,3) 9784 local_pf(i,j,k) = rad_sw_cs_hr(mask_k(mid,k), & 9785 mask_j(mid,j),mask_i(mid,i)) 9786 ENDDO 9787 ENDDO 9788 ENDDO 9789 ELSE 9790 DO i = 1, mask_size_l(mid,1) 9791 DO j = 1, mask_size_l(mid,2) 9792 DO k = 1, mask_size_l(mid,3) 9793 local_pf(i,j,k) = rad_sw_cs_hr_av(mask_k(mid,k), & 9794 mask_j(mid,j),mask_i(mid,i)) 9795 ENDDO 9796 ENDDO 9797 ENDDO 9798 ENDIF 9799 9800 CASE ( 'rad_sw_hr' ) 9801 IF ( av == 0 ) THEN 9802 DO i = 1, mask_size_l(mid,1) 9803 DO j = 1, mask_size_l(mid,2) 9804 DO k = 1, mask_size_l(mid,3) 9805 local_pf(i,j,k) = rad_sw_hr(mask_k(mid,k), & 9806 mask_j(mid,j),mask_i(mid,i)) 9807 ENDDO 9808 ENDDO 9809 ENDDO 9810 ELSE 9811 DO i = 1, mask_size_l(mid,1) 9812 DO j = 1, mask_size_l(mid,2) 9813 DO k = 1, mask_size_l(mid,3) 9814 local_pf(i,j,k) = rad_sw_hr_av(mask_k(mid,k), & 9815 mask_j(mid,j),mask_i(mid,i)) 9816 ENDDO 9817 ENDDO 9818 ENDDO 9819 ENDIF 9820 9821 CASE DEFAULT 9822 found = .FALSE. 9823 9824 END SELECT 9775 ENDDO 9776 9777 ENDIF 9778 ENDIF 9779 9825 9780 9826 9781
Note: See TracChangeset
for help on using the changeset viewer.
