#define VERIFY_(A) IF(A/=0)THEN;PRINT *,'ERROR AT LINE ', __LINE__;STOP;ENDIF #define ASSERT_(A) if(.not.A)then;print *,'Error:',__FILE__,__LINE__;stop;endif PROGRAM calIrrigMethod implicit none !A. For each model grid pixel: !1. Determine the vegetation/crop types of the tiles (LANDCOVER) CROPTYPE == LANDCOVER (21:46) !2. Assign each pixel to a county, based on whatever county makes up the highest fractional area of the pixel (COUNTY). !B. For each county **** Should this be for each LIS grid pixel? !1. Calculate the fraction of each irrigation type (IRRITYPE). !2. Start with the least common irrigation type !3. If that irrigation type covers less than 10% of the area of the county divided by the number of pixels in the county, then ignore it (for example, county area = 6000 km2, drip fraction = 0.008, number of pixels in county = 10; then threshold = 6000 km2 * 10% / 10 pixels = 60 km2; drip area = 0.008 * 6000 km2 = 48 km2; therefore ignore drip) (LDT). !4. For the least common irrigation type that passes the test (#2): !5. Use the data in the attached spreadsheet to determine the crop with the highest Crop Rank corresponding to that irrigation type that also exists in the county (after tiles have been assigned). !6. Does the area of the largest tile of that crop type in the county exceed the area of that irrigation type in the county by more than 2% of the county area? If no, then assign that irrigation type to the tile and, if not within 2% (county area) of the irrigation type area target, repeat with the next largest tile of that type. If yes, then go to the second largest tile of that crop type in the county and repeat the test. Continue until the assigned area of that irrigation t1ype is within +- 2% of the desired fractional area. If that target cannot be achieved with the tile of this crop type, then go to the next highest ranked (Crop Rank) tile for the irrigation type and repeat this step (5). !7. If all tiles in the county are tested before the +-2% goal is achieved for the irrigation type, then move to step 7, keeping any tile assignments that were made in step 5. !8. Move to the second most common irrigation type in the county and repeat step 5, being sure not to re-use any tiles already assigned. !9. All remaining tiles in the county are assigned to the most common irrigation type for that crop type (Irr Rank in spreadsheet). !10. Return to step 1 for the next county. INCLUDE 'netcdf.inc' integer, parameter :: sfctypes = 46, croptypes = 26, irrigtypes = 3, east_west = 1440, north_south = 600 integer :: status, NCFLIS, i, j, NT real :: COUNTRY,itype_thres real, allocatable, dimension (:,:) :: COUNTY real, allocatable, dimension (:) :: SURFACETYPE, IRRIGTYPE, LANDCOVER allocate (SURFACETYPE (1: sfctypes)) allocate (LANDCOVER (1: sfctypes)) allocate (IRRIGTYPE (1: irrigtypes)) allocate (IRRIGCROP (1: croptypes)) allocate (CROPTYPE (1: croptypes)) allocate (COUNTY (1: east_west, 1: north_south)) status = NF_OPEN ('lis_input_noah33_gldas025_modisigbp_mirca_gripc2_gia_aquastatusgs.nc',NF_NOWRITE, NCFLIS) ; VERIFY_(STATUS) status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'COUNTY') ,(/1,1/),(/east_west,north_south/), COUNTY) ; VERIFY_(STATUS) do j = 373, 373 !1, north_south do i = 392, 392 ! 1, east_west status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'COUNTRY' ) ,(/i,j/),(/1,1/), COUNTRY ) ; VERIFY_(STATUS) if (COUNTRY == 243) then NT = COUNT (COUNTY, mask = (COUNTY == COUNTY(i,j))) itype_thres = 0.1 / real(NT) status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'SURFACETYPE') ,(/i,j,1/),(/1,1,sfctypes /),SURFACETYPE) ; VERIFY_(STATUS) status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'LANDCOVER' ) ,(/i,j,1/),(/1,1,sfctypes /), LANDCOVER) ; VERIFY_(STATUS) status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'IRRIGTYPE' ) ,(/i,j,1/),(/1,1,irrigtypes/), IRRIGTYPE) ; VERIFY_(STATUS) status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'IRRIGCROP' ) ,(/i,j,1/),(/1,1,croptypes /), IRRIGCROP) ; VERIFY_(STATUS) status = NF_GET_VARA_REAL(NCFLIS,VarID(NCFLIS,'CROPTYPE' ) ,(/i,j,1/),(/1,1,croptypes /), CROPTYPE) ; VERIFY_(STATUS) endif end do end do contains ! ---------------------------------------------------------------------- integer function VarID (NCFID, VNAME) integer, intent (in) :: NCFID character(*), intent (in) :: VNAME integer :: status STATUS = NF_INQ_VARID (NCFID, trim(VNAME) ,VarID) ; VERIFY_(STATUS) end function VarID ! ---------------------------------------------------------------------- integer function getIrrigMethod (itype, thres) real, dimension (croptypes, irrigtypes),target :: crop_rank, irr_rank real, dimension (:), pointer :: crank, subset DATA crop_rank (:,1) / 7, 5,26,11,12,13, 6,15,16, 2, 4,17, 3,22,10, 1, 8,25,21,19,14,24,23,20,18, 9/ DATA crop_rank (:,2) /17,18,26,23,21,22,16,24, 9,13,15,10,14, 4,20,25,11, 7, 3, 1,12, 6, 5, 2,19, 8/ DATA crop_rank (:,3) /12,14, 1, 8, 9, 7,13, 5, 4,26,24, 3,25,18,10,23,11,15,19,21, 6,16,17,20, 2,22/ DATA irr_rank (:,1) / 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 2, 2, 2, 2, 1/ DATA irr_rank (:,2) / 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 3, 3, 3, 1, 1, 1, 3, 1, 1, 1, 3, 2/ DATA irr_rank (:,3) / 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, 3, 3, 3, 2, 3, 3, 3, 1, 2/ crank => crop_rank (:, least_common_type(itype, thres)) subset = pack (crank, mask = (croptype > 0.)) end function getIrrigMethod ! ---------------------------------------------------------------------- integer function least_common_type (itype, thres) real, intent (in) :: itype(3), thres real :: min_frac integer :: i ! irrig type: 1: sprinkler; 2: drip; 3: flood min_frac = 1. do i = 1,3 if((itype(i)- thres >= 0.) .and. (min_frac > itype(i)))then min_frac = itype(i) least_common_type = i endif end do end function least_common_type ! ---------------------------------------------------------------------- END PROGRAM calIrrigMethod ! Wheat, 20.787229160,12, 2, 0.9,17, 3,78.31277084, 7, 1, ! Maize, 16.525825160,14, 2, 0.5,18, 3,82.97798365, 5, 1, ! Rice/Paddy, 99.552763940, 1, 1, 0.0,26, 3, 0.44723606,26, 2, ! Barley, 30.460328430, 8, 2, 0.3,23, 3,69.23967157,11, 1, ! Rye, 30.460328430, 9, 2, 0.3,21, 3,69.23967157,12, 1, ! Millet, 30.460328430, 7, 2, 0.3,22, 3,69.23967157,13, 1, ! Sorghum, 20.447549420,13, 2, 0.9,16, 3,78.65245058, 6, 1, ! Soybeans, 45.262604610, 5, 2, 0.2,24, 3,54.53739539,15, 1, ! Sunflower, 45.770400800, 4, 2, 5.5, 9, 3,48.72959920,16, 1, ! Potatoes, 2.236323255,26, 2, 0.9,13, 3,96.86367674, 2, 1, ! Cassava, 2.236323255,24, 2, 0.9,15, 3,96.86367674, 4, 1, ! Sugar cane, 45.770400800, 3, 2, 5.5,10, 3,48.72959920,17, 1, ! Sugar beet, 2.236323255,25, 2, 0.9,14, 3,96.86367674, 3, 1, ! Oil palm, 7.303031148,18, 3,78.5, 4, 2,14.19696885,22, 2, ! Rape seed/Canola, 30.460328430,10, 2, 0.3,20, 3,69.23967157,10, 1, ! Groundnuts/Peanuts, 2.644978323,23, 2, 0.1,25, 3,97.25502168, 1, 1, ! Pulses, 21.228348950,11, 2, 4.3,11, 3,74.47165105, 8, 1, ! Citrus, 7.303031148,15, 3,78.5, 7, 1,14.19696885,25, 2, ! Date palm, 7.303031148,19, 3,78.5, 3, 1,14.19696885,21, 2, ! Grapes/Vine, 7.303031148,21, 3,78.5, 1, 1,14.19696885,19, 2, ! Cotton, 37.094645710, 6, 2, 2.7,12, 3,60.20535429,14, 1, ! Cocoa, 7.303031148,16, 3,78.5, 6, 1,14.19696885,24, 2, ! Coffee, 7.303031148,17, 3,78.5, 5, 1,14.19696885,23, 2, ! Others perennial, 7.303031148,20, 3,78.5, 2, 1,14.19696885,20, 2, ! Fodder grasses, 55.332090340, 2, 1, 0.4,19, 3,44.23574473,18, 2, ! Others annual, 7.215741937,22, 2,19.6, 8, 2,73.18425806, 9, 1,