Changeset 7481 for branches/ORCHIDEE_2_2/ORCHIDEE
- Timestamp:
- 2022-02-17T13:07:27+01:00 (2 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/routing_simple.f90
r7254 r7481 287 287 LOGICAL,SAVE,ALLOCATABLE :: coast_mask(:) !! is a coast point - (local native grid) 288 288 !$OMP THREADPRIVATE(coast_mask) 289 INTEGER,SAVE :: total_coast_points !! global number of coast point - (local native grid) 290 !$OMP THREADPRIVATE(total_coast_points) 289 291 INTEGER,SAVE :: nbpt_r !! number of point in local routing grid 290 292 !$OMP THREADPRIVATE(nbpt_r) … … 308 310 !$OMP THREADPRIVATE(split_routing) 309 311 312 REAL(r_std), SAVE :: max_lake_reservoir !! Maximum limit of water in lake_reservoir [kg/m2] 313 !$OMP THREADPRIVATE(max_lake_reservoir) 314 310 315 311 316 INTEGER(i_std), PARAMETER :: nb_stations=14 … … 405 410 REAL(r_std) :: area_mpi(nbp_mpi) 406 411 INTEGER :: basins_count_mpi 412 INTEGER :: nb_coast_points 407 413 INTEGER :: ierr 408 414 LOGICAL :: file_exists … … 415 421 CALL gather_omp(contfrac,contfrac_mpi) 416 422 CALL gather_omp(area, area_mpi) 417 423 418 424 IF (is_omp_root) THEN 419 425 … … 445 451 coast_mask=.FALSE. 446 452 WHERE( contfrac_mpi(:)< 1.-1.e-5) coast_mask(:)=.TRUE. ! create mask for coastal cells on native grid 447 453 448 454 INQUIRE(FILE="routing_start.nc", EXIST=file_exists) 449 455 … … 485 491 frac_routing_r(:)=0 486 492 WHERE( .NOT. coast_mask(:)) mask_native(:)=1 493 494 nb_coast_points=SUM(1-mask_native) 495 CALL reduce_sum_mpi(nb_coast_points, total_coast_points) 496 CALL bcast_mpi(total_coast_points) 497 487 498 CALL xios_send_field("mask_native_lake",mask_native) ! send full land point to XIOS (native grid) 488 499 CALL xios_recv_field("frac_routing_lake_r",frac_routing_r) ! receive fraction of intersected cell by full land, on routing grid … … 734 745 735 746 USE xios 736 USE grid, ONLY : area 747 USE grid, ONLY : area 737 748 IMPLICIT NONE 738 749 INCLUDE "mpif.h" … … 779 790 REAL(r_std) :: slow_diag_mpi(nbp_mpi) 780 791 REAL(r_std) :: stream_diag_mpi(nbp_mpi) 792 REAL(r_std) :: area_mpi(nbp_mpi) ! cell area 793 REAL(r_std) :: lake_reservoir_mpi(nbp_mpi) ! cell area 781 794 782 795 ! from input model -> routing_grid … … 848 861 REAL(r_std) :: basins_riverflow_mpi(0:basins_count) 849 862 REAL(r_std) :: basins_riverflow(0:basins_count) 850 863 REAL(r_std) :: lake_overflow,sum_lake_overflow, total_lake_overflow 851 864 INTEGER :: ierr 852 865 … … 873 886 CALL gather_omp(runoff_omp,runoff) 874 887 CALL gather_omp(drainage_omp, drainage) 888 CALL gather_omp(area, area_mpi) 889 CALL gather_omp(lake_reservoir, lake_reservoir_mpi) 875 890 876 891 IF (is_omp_root) THEN … … 1128 1143 " ; delta : ", 100*(water_balance_after-water_balance_before)/(0.5*(water_balance_after+water_balance_before)),"%" 1129 1144 1130 1145 1146 !! Remove water from lake reservoir if it exceeds the maximum limit and distribute it 1147 !! uniformly over all possible the coastflow gridcells 1148 1149 ! Calculate lake_overflow and remove it from lake_reservoir 1150 sum_lake_overflow=0 1151 DO ig=1,nbp_mpi 1152 lake_overflow = MAX(0., lake_reservoir_mpi(ig) - max_lake_reservoir*area_mpi(ig)) 1153 lake_reservoir_mpi(ig) = lake_reservoir_mpi(ig) - lake_overflow 1154 sum_lake_overflow = sum_lake_overflow+lake_overflow 1155 END DO 1156 1157 ! Calculate the sum of the lake_overflow and distribute it uniformly over all gridboxes 1158 CALL reduce_sum_mpi(sum_lake_overflow,total_lake_overflow) 1159 CALL bcast_mpi(total_lake_overflow) 1160 1161 WHERE(coast_mask) coastalflow = coastalflow + total_lake_overflow/total_coast_points 1131 1162 1132 1163 ENDIF ! is_omp_root … … 1135 1166 CALL scatter_omp(coastalflow,coastalflow_omp) 1136 1167 CALL scatter_omp(lakeinflow,lakeinflow_omp) 1168 CALL scatter_omp(lake_reservoir_mpi,lake_reservoir) 1137 1169 CALL scatter_omp(fast_diag_mpi,fast_diag) 1138 1170 CALL scatter_omp(slow_diag_mpi,slow_diag) … … 1166 1198 pond_diag(:) = zero 1167 1199 irrigation(:) = zero 1200 1168 1201 1169 1202 … … 1733 1766 ENDIF 1734 1767 1768 ! 1769 ! Write restart variables 1770 ! 1771 tmp_day(1) = time_counter 1772 IF (is_root_prc) CALL restput (rest_id, 'routingcounter', 1, 1, 1, kjit, tmp_day) 1773 1774 CALL restput_p (rest_id, 'routingarea', nbp_glo, nbasmax, 1, kjit, routing_area, 'scatter', nbp_glo, index_g) 1775 CALL restput_p (rest_id, 'routetogrid', nbp_glo, nbasmax, 1, kjit, REAL(route_togrid,r_std), 'scatter', & 1776 nbp_glo, index_g) 1777 CALL restput_p (rest_id, 'routetobasin', nbp_glo, nbasmax, 1, kjit, REAL(route_tobasin,r_std), 'scatter', & 1778 nbp_glo, index_g) 1779 CALL restput_p (rest_id, 'basinid', nbp_glo, nbasmax, 1, kjit, REAL(global_basinid,r_std), 'scatter', & 1780 nbp_glo, index_g) 1781 CALL restput_p (rest_id, 'topoindex', nbp_glo, nbasmax, 1, kjit, topo_resid, 'scatter', nbp_glo, index_g) 1782 CALL restput_p (rest_id, 'fastres', nbp_glo, nbasmax, 1, kjit, fast_reservoir, 'scatter', nbp_glo, index_g) 1783 CALL restput_p (rest_id, 'slowres', nbp_glo, nbasmax, 1, kjit, slow_reservoir, 'scatter', nbp_glo, index_g) 1784 CALL restput_p (rest_id, 'streamres', nbp_glo, nbasmax, 1, kjit, stream_reservoir, 'scatter',nbp_glo,index_g) 1785 CALL restput_p (rest_id, 'floodres', nbp_glo, nbasmax, 1, kjit, flood_reservoir, 'scatter', nbp_glo, index_g) 1786 CALL restput_p (rest_id, 'floodh', nbp_glo, 1, 1, kjit, flood_height, 'scatter', nbp_glo, index_g) 1787 CALL restput_p (rest_id, 'flood_frac_bas', nbp_glo, nbasmax, 1, kjit, flood_frac_bas, 'scatter', nbp_glo, index_g) 1788 CALL restput_p (rest_id, 'pond_frac', nbp_glo, 1, 1, kjit, pond_frac, 'scatter', nbp_glo, index_g) 1789 CALL restput_p (rest_id, 'flood_frac', nbp_glo, 1, 1, kjit, flood_frac, 'scatter', nbp_glo, index_g) 1790 CALL restput_p (rest_id, 'flood_res', nbp_glo, 1, 1, kjit, flood_res, 'scatter', nbp_glo, index_g) 1791 1792 CALL restput_p (rest_id, 'lakeres', nbp_glo, 1, 1, kjit, lake_reservoir, 'scatter', nbp_glo, index_g) 1793 CALL restput_p (rest_id, 'pondres', nbp_glo, 1, 1, kjit, pond_reservoir, 'scatter', nbp_glo, index_g) 1794 1795 CALL restput_p (rest_id, 'lakeinflow', nbp_glo, 1, 1, kjit, lakeinflow_mean, 'scatter', nbp_glo, index_g) 1796 CALL restput_p (rest_id, 'returnflow', nbp_glo, 1, 1, kjit, returnflow_mean, 'scatter', nbp_glo, index_g) 1797 CALL restput_p (rest_id, 'reinfiltration', nbp_glo, 1, 1, kjit, reinfiltration_mean, 'scatter', nbp_glo, index_g) 1798 CALL restput_p (rest_id, 'riverflow', nbp_glo, 1, 1, kjit, riverflow_mean, 'scatter', nbp_glo, index_g) 1799 CALL restput_p (rest_id, 'coastalflow', nbp_glo, 1, 1, kjit, coastalflow_mean, 'scatter', nbp_glo, index_g) 1800 CALL restput_p (rest_id, 'hydrographs', nbp_glo, 1, 1, kjit, hydrographs, 'scatter', nbp_glo, index_g) 1801 CALL restput_p (rest_id, 'slowflow_diag', nbp_glo, 1, 1, kjit, slowflow_diag, 'scatter', nbp_glo, index_g) 1802 ! 1803 ! Keep track of the accumulated variables 1804 ! 1805 CALL restput_p (rest_id, 'floodout_route', nbp_glo, 1, 1, kjit, floodout_mean, 'scatter', nbp_glo, index_g) 1806 CALL restput_p (rest_id, 'runoff_route', nbp_glo, 1, 1, kjit, runoff_mean, 'scatter', nbp_glo, index_g) 1807 CALL restput_p (rest_id, 'drainage_route', nbp_glo, 1, 1, kjit, drainage_mean, 'scatter', nbp_glo, index_g) 1808 CALL restput_p (rest_id, 'transpot_route', nbp_glo, 1, 1, kjit, transpot_mean, 'scatter', nbp_glo, index_g) 1809 CALL restput_p (rest_id, 'precip_route', nbp_glo, 1, 1, kjit, precip_mean, 'scatter', nbp_glo, index_g) 1810 CALL restput_p (rest_id, 'humrel_route', nbp_glo, 1, 1, kjit, humrel_mean, 'scatter', nbp_glo, index_g) 1811 CALL restput_p (rest_id, 'totnobio_route', nbp_glo, 1, 1, kjit, totnobio_mean, 'scatter', nbp_glo, index_g) 1812 CALL restput_p (rest_id, 'k_litt_route', nbp_glo, 1, 1, kjit, k_litt_mean, 'scatter', nbp_glo, index_g) 1813 CALL restput_p (rest_id, 'vegtot_route', nbp_glo, 1, 1, kjit, vegtot_mean, 'scatter', nbp_glo, index_g) 1814 1815 IF ( do_irrigation ) THEN 1816 CALL restput_p (rest_id, 'irrigated', nbp_glo, 1, 1, kjit, irrigated, 'scatter', nbp_glo, index_g) 1817 CALL restput_p (rest_id, 'irrigation', nbp_glo, 1, 1, kjit, irrigation_mean, 'scatter', nbp_glo, index_g) 1818 ENDIF 1819 1820 IF ( do_floodplains ) THEN 1821 CALL restput_p (rest_id, 'floodplains', nbp_glo, 1, 1, kjit, floodplains, 'scatter', nbp_glo, index_g) 1822 ENDIF 1823 IF ( doswamps ) THEN 1824 CALL restput_p (rest_id, 'swamp', nbp_glo, 1, 1, kjit, swamp, 'scatter', nbp_glo, index_g) 1825 ENDIF 1826 1827 1828 1735 1829 END SUBROUTINE routing_simple_finalize 1736 1830 … … 1950 2044 CALL getin_p("POND_CRI", pondcri) 1951 2045 2046 !Config Key = MAX_LAKE_RESERVOIR 2047 !Config Desc = Maximum limit of water in lake_reservoir 2048 !Config If = RIVER_ROUTING 2049 !Config Def = 7000 2050 !Config Help = 2051 !Config Units = [kg/m2(routing area)] 2052 max_lake_reservoir = 7000 2053 CALL getin_p("MAX_LAKE_RESERVOIR", max_lake_reservoir) 1952 2054 1953 2055 ! In order to simplify the time cascade check that dt_routing
Note: See TracChangeset
for help on using the changeset viewer.
