Changeset 4795 for palm/trunk/SOURCE/virtual_measurement_mod.f90
- Timestamp:
- Nov 25, 2020 3:55:14 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/virtual_measurement_mod.f90
r4764 r4795 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - Add control flags 28 ! 29 ! 4764 2020-10-30 12:50:36Z suehring 27 30 ! Missing variable declaration and directives for netcdf4 added 28 31 ! … … 206 209 end_time, & 207 210 humidity, & 211 land_surface, & 208 212 message_string, & 209 213 neutral, & … … 2426 2430 2427 2431 CASE ( 'utheta' ) 2428 DO m = 1, vmea(l)%ns 2429 k = vmea(l)%k(m) 2430 j = vmea(l)%j(m) 2431 i = vmea(l)%i(m) 2432 vmea(l)%measured_vars(m,n) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) * pt(k,j,i) 2433 ENDDO 2432 IF ( .NOT. neutral ) THEN 2433 DO m = 1, vmea(l)%ns 2434 k = vmea(l)%k(m) 2435 j = vmea(l)%j(m) 2436 i = vmea(l)%i(m) 2437 vmea(l)%measured_vars(m,n) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) * pt(k,j,i) 2438 ENDDO 2439 ENDIF 2434 2440 2435 2441 CASE ( 'vtheta' ) 2436 DO m = 1, vmea(l)%ns 2437 k = vmea(l)%k(m) 2438 j = vmea(l)%j(m) 2439 i = vmea(l)%i(m) 2440 vmea(l)%measured_vars(m,n) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) * pt(k,j,i) 2441 ENDDO 2442 IF ( .NOT. neutral ) THEN 2443 DO m = 1, vmea(l)%ns 2444 k = vmea(l)%k(m) 2445 j = vmea(l)%j(m) 2446 i = vmea(l)%i(m) 2447 vmea(l)%measured_vars(m,n) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) * pt(k,j,i) 2448 ENDDO 2449 ENDIF 2442 2450 2443 2451 CASE ( 'wtheta' ) 2444 DO m = 1, vmea(l)%ns 2445 k = MAX ( 1, vmea(l)%k(m) ) 2446 j = vmea(l)%j(m) 2447 i = vmea(l)%i(m) 2448 vmea(l)%measured_vars(m,n) = 0.5_wp * ( w(k-1,j,i) + w(k,j,i) ) * pt(k,j,i) 2449 ENDDO 2452 IF ( .NOT. neutral ) THEN 2453 DO m = 1, vmea(l)%ns 2454 k = MAX ( 1, vmea(l)%k(m) ) 2455 j = vmea(l)%j(m) 2456 i = vmea(l)%i(m) 2457 vmea(l)%measured_vars(m,n) = 0.5_wp * ( w(k-1,j,i) + w(k,j,i) ) * pt(k,j,i) 2458 ENDDO 2459 ENDIF 2450 2460 2451 2461 CASE ( 'uqv' ) … … 2555 2565 2556 2566 CASE ( 'thetas' ) ! scaling parameter temperature 2557 DO m = 1, vmea(l)%ns 2558 ! 2559 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2560 !- limit the indices. 2561 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2562 j = MERGE( j , nyn, j < nyn ) 2563 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2564 i = MERGE( i , nxr, i < nxr ) 2565 2566 DO mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i) 2567 vmea(l)%measured_vars(m,n) = surf_def_h(0)%ts(mm) 2568 ENDDO 2569 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2570 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%ts(mm) 2571 ENDDO 2572 DO mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 2573 vmea(l)%measured_vars(m,n) = surf_usm_h(0)%ts(mm) 2574 ENDDO 2575 ENDDO 2567 IF ( .NOT. neutral ) THEN 2568 DO m = 1, vmea(l)%ns 2569 ! 2570 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2571 !- limit the indices. 2572 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2573 j = MERGE( j , nyn, j < nyn ) 2574 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2575 i = MERGE( i , nxr, i < nxr ) 2576 2577 DO mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i) 2578 vmea(l)%measured_vars(m,n) = surf_def_h(0)%ts(mm) 2579 ENDDO 2580 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2581 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%ts(mm) 2582 ENDDO 2583 DO mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 2584 vmea(l)%measured_vars(m,n) = surf_usm_h(0)%ts(mm) 2585 ENDDO 2586 ENDDO 2587 ENDIF 2576 2588 2577 2589 CASE ( 'hfls' ) ! surface latent heat flux 2578 DO m = 1, vmea(l)%ns 2579 ! 2580 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2581 !-- limit the indices. 2582 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2583 j = MERGE( j , nyn, j < nyn ) 2584 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2585 i = MERGE( i , nxr, i < nxr ) 2586 2587 DO mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i) 2588 vmea(l)%measured_vars(m,n) = surf_def_h(0)%qsws(mm) 2589 ENDDO 2590 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2591 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%qsws(mm) 2592 ENDDO 2593 DO mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 2594 vmea(l)%measured_vars(m,n) = surf_usm_h(0)%qsws(mm) 2595 ENDDO 2596 ENDDO 2590 IF ( humidity ) THEN 2591 DO m = 1, vmea(l)%ns 2592 ! 2593 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2594 !-- limit the indices. 2595 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2596 j = MERGE( j , nyn, j < nyn ) 2597 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2598 i = MERGE( i , nxr, i < nxr ) 2599 2600 DO mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i) 2601 vmea(l)%measured_vars(m,n) = surf_def_h(0)%qsws(mm) 2602 ENDDO 2603 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2604 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%qsws(mm) 2605 ENDDO 2606 DO mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 2607 vmea(l)%measured_vars(m,n) = surf_usm_h(0)%qsws(mm) 2608 ENDDO 2609 ENDDO 2610 ENDIF 2597 2611 2598 2612 CASE ( 'hfss' ) ! surface sensible heat flux 2599 DO m = 1, vmea(l)%ns 2600 ! 2601 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2602 !-- limit the indices. 2603 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2604 j = MERGE( j , nyn, j < nyn ) 2605 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2606 i = MERGE( i , nxr, i < nxr ) 2607 2608 DO mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i) 2609 vmea(l)%measured_vars(m,n) = surf_def_h(0)%shf(mm) 2610 ENDDO 2611 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2612 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%shf(mm) 2613 ENDDO 2614 DO mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 2615 vmea(l)%measured_vars(m,n) = surf_usm_h(0)%shf(mm) 2616 ENDDO 2617 ENDDO 2613 IF ( .NOT. neutral ) THEN 2614 DO m = 1, vmea(l)%ns 2615 ! 2616 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2617 !-- limit the indices. 2618 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2619 j = MERGE( j , nyn, j < nyn ) 2620 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2621 i = MERGE( i , nxr, i < nxr ) 2622 2623 DO mm = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i) 2624 vmea(l)%measured_vars(m,n) = surf_def_h(0)%shf(mm) 2625 ENDDO 2626 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2627 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%shf(mm) 2628 ENDDO 2629 DO mm = surf_usm_h(0)%start_index(j,i), surf_usm_h(0)%end_index(j,i) 2630 vmea(l)%measured_vars(m,n) = surf_usm_h(0)%shf(mm) 2631 ENDDO 2632 ENDDO 2633 ENDIF 2618 2634 2619 2635 CASE ( 'hfdg' ) ! ground heat flux 2620 DO m = 1, vmea(l)%ns 2621 ! 2622 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2623 !-- limit the indices. 2624 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2625 j = MERGE( j , nyn, j < nyn ) 2626 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2627 i = MERGE( i , nxr, i < nxr ) 2628 2629 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2630 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%ghf(mm) 2631 ENDDO 2632 ENDDO 2636 IF ( land_surface ) THEN 2637 DO m = 1, vmea(l)%ns 2638 ! 2639 !-- Surface data is only available on inner subdomains, not on ghost points. Hence, 2640 !-- limit the indices. 2641 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2642 j = MERGE( j , nyn, j < nyn ) 2643 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2644 i = MERGE( i , nxr, i < nxr ) 2645 2646 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2647 vmea(l)%measured_vars(m,n) = surf_lsm_h(0)%ghf(mm) 2648 ENDDO 2649 ENDDO 2650 ENDIF 2633 2651 2634 2652 CASE ( 'rnds' ) ! surface net radiation … … 2847 2865 2848 2866 CASE ( 'm_soil', 'lwcs' ) ! soil moisture 2849 DO m = 1, vmea(l)%ns_soil 2850 j = MERGE( vmea(l)%j_soil(m), nys, vmea(l)%j_soil(m) > nys ) 2851 j = MERGE( j , nyn, j < nyn ) 2852 i = MERGE( vmea(l)%i_soil(m), nxl, vmea(l)%i_soil(m) > nxl ) 2853 i = MERGE( i , nxr, i < nxr ) 2854 k = vmea(l)%k_soil(m) 2855 2856 match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i) 2857 2858 IF ( match_lsm ) THEN 2859 mm = surf_lsm_h(0)%start_index(j,i) 2860 vmea(l)%measured_vars_soil(m,n) = m_soil_h(0)%var_2d(k,mm) 2861 ENDIF 2862 2863 ENDDO 2867 IF ( land_surface ) THEN 2868 DO m = 1, vmea(l)%ns_soil 2869 j = MERGE( vmea(l)%j_soil(m), nys, vmea(l)%j_soil(m) > nys ) 2870 j = MERGE( j , nyn, j < nyn ) 2871 i = MERGE( vmea(l)%i_soil(m), nxl, vmea(l)%i_soil(m) > nxl ) 2872 i = MERGE( i , nxr, i < nxr ) 2873 k = vmea(l)%k_soil(m) 2874 2875 match_lsm = surf_lsm_h(0)%start_index(j,i) <= surf_lsm_h(0)%end_index(j,i) 2876 2877 IF ( match_lsm ) THEN 2878 mm = surf_lsm_h(0)%start_index(j,i) 2879 vmea(l)%measured_vars_soil(m,n) = m_soil_h(0)%var_2d(k,mm) 2880 ENDIF 2881 2882 ENDDO 2883 ENDIF 2864 2884 2865 2885 CASE ( 'ts', 'tb' ) ! surface temperature and brighness temperature … … 2899 2919 2900 2920 CASE ( 't_lw' ) ! water temperature 2901 DO m = 1, vmea(l)%ns 2902 ! 2903 !-- Surface data is only available on inner subdomains, not 2904 !-- on ghost points. Hence, limit the indices. 2905 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2906 j = MERGE( j , nyn, j < nyn ) 2907 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2908 i = MERGE( i , nxr, i < nxr ) 2909 2910 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2911 IF ( surf_lsm_h(0)%water_surface(m) ) & 2912 vmea(l)%measured_vars(m,n) = t_soil_h(0)%var_2d(nzt,m) 2913 ENDDO 2914 2915 ENDDO 2921 IF ( land_surface ) THEN 2922 DO m = 1, vmea(l)%ns 2923 ! 2924 !-- Surface data is only available on inner subdomains, not 2925 !-- on ghost points. Hence, limit the indices. 2926 j = MERGE( vmea(l)%j(m), nys, vmea(l)%j(m) > nys ) 2927 j = MERGE( j , nyn, j < nyn ) 2928 i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2929 i = MERGE( i , nxr, i < nxr ) 2930 2931 DO mm = surf_lsm_h(0)%start_index(j,i), surf_lsm_h(0)%end_index(j,i) 2932 IF ( surf_lsm_h(0)%water_surface(m) ) & 2933 vmea(l)%measured_vars(m,n) = t_soil_h(0)%var_2d(nzt,m) 2934 ENDDO 2935 2936 ENDDO 2937 ENDIF 2916 2938 ! 2917 2939 !-- No match found - just set a fill value
Note: See TracChangeset
for help on using the changeset viewer.