Changeset 366
- Timestamp:
- 2011-08-01T11:23:28+02:00 (13 years ago)
- Location:
- branches/ORCHIDEE_EXT/ORCHIDEE
- Files:
-
- 3 edited
-
src_parameters/constantes.f90 (modified) (1 diff)
-
src_sechiba/intersurf.f90 (modified) (11 diffs)
-
src_stomate/stomate.f90 (modified) (42 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_EXT/ORCHIDEE/src_parameters/constantes.f90
r360 r366 1751 1751 CALL getin_p('MIN_VEGFRAC',min_vegfrac) 1752 1752 ! 1753 !Config Key = STEMPDIAG_BID 1754 !Config Desc = only needed for an initial LAI if there is no restart file 1755 !Config If = OK_SECHIBA 1756 !Config Def = 280. 1757 !Config Help = 1758 !Config Units = 1759 CALL getin_p('STEMPDIAG_BID',stempdiag_bid) 1760 ! 1753 1761 !Config Key = SOILTYPE_DEFAULT 1754 1762 !Config Desc = Default soil texture distribution in the following order : sand, loam and clay -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/intersurf.f90
r354 r366 36 36 37 37 PRIVATE 38 PUBLIC :: intersurf_main, stom_define_history, intsurf_time38 PUBLIC :: intersurf_main, stom_define_history, stom_IPCC_define_history, intsurf_time 39 39 40 40 INTERFACE intersurf_main … … 63 63 REAL(r_std) :: julian0 64 64 ! 65 LOGICAL :: check_INPUTS = .FALSE. !! (very) long print of INPUTs in intersurf65 LOGICAL, PARAMETER :: check_INPUTS = .FALSE. !! (very) long print of INPUTs in intersurf 66 66 LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE. 67 LOGICAL, SAVE :: check_time = .FALSE. 68 PUBLIC check_time, l_first_intersurf 67 69 ! 68 70 !!$ DS : ajout du flag IMPOSE_PARAM … … 2650 2652 REAL(r_std), INTENT(in) :: dt !! Time step 2651 2653 ! 2652 ! LOCAL2653 LOGICAL :: check=.FALSE.2654 2654 2655 2655 IF (l_first_intersurf) THEN … … 2663 2663 ENDIF 2664 2664 2665 IF (check ) THEN2665 IF (check_time) THEN 2666 2666 write(numout,*) "calendar_str =",calendar_str 2667 2667 write(numout,*) "one_year=",one_year,", one_day=",one_day … … 2671 2671 2672 2672 ! 2673 IF (check ) &2673 IF (check_time) & 2674 2674 WRITE(numout,*) "---" 2675 2675 ! Dans diffuco (ie date0 == date0_shift !!) … … 2685 2685 !!$ julian_diff = in_julian 2686 2686 !!$ month_len = ioget_mon_len (year,month) 2687 !!$ IF (check ) THEN2687 !!$ IF (check_time) THEN 2688 2688 !!$ write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff 2689 2689 !!$ write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp … … 2697 2697 sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day) 2698 2698 month_len = ioget_mon_len (year,month) 2699 IF (check ) THEN2699 IF (check_time) THEN 2700 2700 write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff 2701 2701 write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp … … 2707 2707 !!$ julian_diff = in_julian 2708 2708 !!$ month_len = ioget_mon_len (year,month) 2709 !!$ IF (check ) THEN2709 !!$ IF (check_time) THEN 2710 2710 !!$ write(numout,*) "in_julian=",in_julian, jur, julian_diff 2711 2711 !!$ write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp … … 2719 2719 !!$ sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day) 2720 2720 !!$ month_len = ioget_mon_len (year,month) 2721 !!$ IF (check ) THEN2721 !!$ IF (check_time) THEN 2722 2722 !!$ write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff 2723 2723 !!$ write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp … … 2725 2725 2726 2726 2727 !!$ IF (check ) &2727 !!$ IF (check_time) & 2728 2728 !!$ WRITE(numout,*) "-" 2729 2729 … … 2736 2736 julian_diff = in_julian 2737 2737 month_len = ioget_mon_len (year,month) 2738 IF (check ) THEN2738 IF (check_time) THEN 2739 2739 write(numout,*) "in_julian=",in_julian, julian0, julian_diff 2740 2740 write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp 2741 2741 ENDIF 2742 2742 ENDIF 2743 !!$ IF (check ) &2743 !!$ IF (check_time) & 2744 2744 !!$ WRITE(numout,*) "---" 2745 2745 -
branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate.f90
r335 r366 28 28 IMPLICIT NONE 29 29 PRIVATE 30 PUBLIC stomate_main,stomate_clear 30 PUBLIC stomate_main,stomate_clear,init_forcing,forcing_read 31 31 ! 32 32 INTEGER,PARAMETER :: r_typ =nf90_real4 … … 262 262 REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: precip_fm 263 263 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: gpp_daily_fm 264 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: resp_maint_part_fm265 264 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_fm 266 265 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_max_fm 267 266 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: lai_fm 267 PUBLIC clay_fm, humrel_daily_fm, litterhum_daily_fm, t2m_daily_fm, t2m_min_daily_fm, tsurf_daily_fm, tsoil_daily_fm, & 268 soilhum_daily_fm, precip_fm, gpp_daily_fm, veget_fm, veget_max_fm, lai_fm 268 269 269 270 REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: clay_fm_g … … 277 278 REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: precip_fm_g 278 279 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: gpp_daily_fm_g 279 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: resp_maint_part_fm_g280 280 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_fm_g 281 281 REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:) :: veget_max_fm_g … … 285 285 LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:) :: nf_written 286 286 INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: nf_cumul 287 PUBLIC isf, nf_written 288 287 289 ! first call 288 290 LOGICAL,SAVE :: l_first_stomate = .TRUE. … … 493 495 ! for forcing file: "daily" gpp 494 496 REAL(r_std),DIMENSION(kjpindex,nvm) :: gpp_daily_x 495 ! for forcing file: "daily" auto resp496 REAL(r_std),DIMENSION(kjpindex,nvm,nparts) :: resp_maint_part_x497 497 ! total "vegetation" cover 498 498 REAL(r_std),DIMENSION(kjpindex) :: cvegtot … … 514 514 INTEGER(i_std),SAVE :: nparan ! Number of time steps per year for carbon spinup 515 515 INTEGER(i_std),SAVE :: nbyear 516 INTEGER(i_std),PARAMETER :: nparanmax=36 516 INTEGER(i_std),PARAMETER :: nparanmax=366 ! Number max of time steps per year for carbon spinup 517 517 REAL(r_std) :: sf_time 518 INTEGER(i_std),SAVE :: iatt =1518 INTEGER(i_std),SAVE :: iatt 519 519 INTEGER(i_std),SAVE :: iatt_old=1 520 520 INTEGER(i_std) :: max_totsize, totsize_1step,totsize_tmp … … 587 587 rest_id_stom, hist_id_stom, hist_id_stom_IPCC) 588 588 589 co2_flux_monthly(:,:) = zero590 589 ! 591 590 ! 1.2 read PFT data … … 725 724 & +SIZE(precip_daily)*KIND(precip_daily) & 726 725 & +SIZE(gpp_daily_x)*KIND(gpp_daily_x) & 727 & +SIZE(resp_maint_part_x)*KIND(resp_maint_part_x) &728 726 & +SIZE(veget)*KIND(veget) & 729 727 & +SIZE(veget_max)*KIND(veget_max) & … … 812 810 ier = NF90_DEF_VAR (forcing_id,'lai', & 813 811 & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) 814 ier = NF90_DEF_VAR (forcing_id,'resp_maint_part', &815 & r_typ,(/ d_id(1),d_id(3),d_id(7),d_id(6) /),vid)816 812 ier = NF90_ENDDEF (forcing_id) 817 813 !- … … 866 862 !Config Key = FORCESOIL_STEP_PER_YEAR 867 863 !Config Desc = Number of time steps per year for carbon spinup. 868 !Config Def = 12864 !Config Def = 365 869 865 !Config Help = Number of time steps per year for carbon spinup. 870 nparan = 12866 nparan = 365 871 867 CALL getin_p('FORCESOIL_STEP_PER_YEAR', nparan) 872 868 … … 1403 1399 ENDDO 1404 1400 sf_time = MODULO(REAL(date,r_std)-1,one_year*REAL(nbyear,r_std)) 1405 iatt=FLOOR(sf_time/dt_forcesoil)+1 1406 IF ((iatt < 1) .OR. (iatt > nparan*nbyear)) THEN 1407 WRITE(numout,*) 'Error with iatt=',iatt 1408 CALL ipslerr (3,'stomate', & 1409 & 'Error with iatt.', '', & 1410 & '(Problem with dt_forcesoil ?)') 1411 ENDIF 1401 iatt=FLOOR(sf_time/dt_forcesoil) 1402 IF (iatt == 0) iatt = iatt_old + 1 1412 1403 1413 1404 IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN 1414 1405 nforce(:)=0 1415 soilcarbon_input(:,:,:,:) = 01416 control_moist(:,:,:) = 01417 control_temp(:,:,:) = 01418 npp_equil(:,:) = 01406 soilcarbon_input(:,:,:,:) = zero 1407 control_moist(:,:,:) = zero 1408 control_temp(:,:,:) = zero 1409 npp_equil(:,:) = zero 1419 1410 ENDIF 1420 1411 iatt_old=iatt … … 1443 1434 1444 1435 gpp_daily_x(:,:) = zero 1445 resp_maint_part_x(:,:,:) = zero1446 1436 !gpp needs to be multiplied by coverage for forcing (see above) 1447 1437 DO j = 2, nvm 1448 1438 gpp_daily_x(:,j) = gpp_daily_x(:,j) + & 1449 1439 & gpp_daily(:,j) * dt_slow / one_day * veget_cov_max(:,j) 1450 resp_maint_part_x(:,j,:) = resp_maint_part_x(:,j,:) + &1451 & resp_maint_part(:,j,:) * dt_slow / one_day1452 1440 ENDDO 1453 1441 ! … … 1485 1473 gpp_daily_fm(:,:,iisf) = & 1486 1474 & (xn*gpp_daily_fm(:,:,iisf) + gpp_daily_x(:,:))/(xn+1.) 1487 resp_maint_part_fm(:,:,:,iisf) = &1488 & ( xn*resp_maint_part_fm(:,:,:,iisf) &1489 & +resp_maint_part_x(:,:,:) )/(xn+1.)1490 1475 veget_fm(:,:,iisf) = & 1491 1476 & (xn*veget_fm(:,:,iisf) + veget(:,:) )/(xn+1.) … … 1497 1482 clay_fm(:,iisf) = clay(:) 1498 1483 humrel_daily_fm(:,:,iisf) = humrel_daily(:,:) 1499 litterhum_daily_fm(:,iisf) = +litterhum_daily(:)1484 litterhum_daily_fm(:,iisf) = litterhum_daily(:) 1500 1485 t2m_daily_fm(:,iisf) = t2m_daily(:) 1501 1486 t2m_min_daily_fm(:,iisf) =t2m_min_daily(:) … … 1505 1490 precip_fm(:,iisf) = precip_daily(:) 1506 1491 gpp_daily_fm(:,:,iisf) =gpp_daily_x(:,:) 1507 resp_maint_part_fm(:,:,:,iisf) = resp_maint_part_x(:,:,:)1508 1492 veget_fm(:,:,iisf) = veget(:,:) 1509 1493 veget_max_fm(:,:,iisf) =veget_max(:,:) … … 2181 2165 IF (ALLOCATED(precip_fm)) DEALLOCATE(precip_fm) 2182 2166 IF (ALLOCATED(gpp_daily_fm)) DEALLOCATE(gpp_daily_fm) 2183 IF (ALLOCATED(resp_maint_part_fm)) DEALLOCATE(resp_maint_part_fm)2184 2167 IF (ALLOCATED(veget_fm)) DEALLOCATE(veget_fm) 2185 2168 IF (ALLOCATED(veget_max_fm)) DEALLOCATE(veget_max_fm) … … 2197 2180 IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g) 2198 2181 IF (ALLOCATED(gpp_daily_fm_g)) DEALLOCATE(gpp_daily_fm_g) 2199 IF (ALLOCATED(resp_maint_part_fm_g)) DEALLOCATE(resp_maint_part_fm_g)2200 2182 IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g) 2201 2183 IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g) … … 2439 2421 ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier) 2440 2422 l_error = l_error .OR. (ier /= 0) 2441 ALLOCATE(resp_maint_part_fm(kjpindex,nvm,nparts,nsfm),stat=ier)2442 l_error = l_error .OR. (ier /= 0)2443 2423 ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier) 2444 2424 l_error = l_error .OR. (ier /= 0) … … 2453 2433 ALLOCATE(nf_cumul(nsft),stat=ier) 2454 2434 l_error = l_error .OR. (ier /= 0) 2435 IF (l_error) THEN 2436 WRITE(numout,*) 'Problem with memory allocation: forcing variables' 2437 STOP 'init_forcing' 2438 ENDIF 2455 2439 2456 2440 IF (is_root_prc) THEN … … 2475 2459 ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier) 2476 2460 l_error = l_error .OR. (ier /= 0) 2477 ALLOCATE(resp_maint_part_fm_g(nbp_glo,nvm,nparts,nsfm),stat=ier)2478 l_error = l_error .OR. (ier /= 0)2479 2461 ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier) 2480 2462 l_error = l_error .OR. (ier /= 0) … … 2483 2465 ALLOCATE(lai_fm_g(nbp_glo,nvm,nsfm),stat=ier) 2484 2466 l_error = l_error .OR. (ier /= 0) 2467 IF (l_error) THEN 2468 WRITE(numout,*) 'Problem with memory allocation: forcing variables' 2469 STOP 'init_forcing' 2470 ENDIF 2485 2471 ELSE 2486 2472 ALLOCATE(clay_fm_g(0,nsfm),stat=ier) … … 2494 2480 ALLOCATE(precip_fm_g(0,nsfm),stat=ier) 2495 2481 ALLOCATE(gpp_daily_fm_g(0,nvm,nsfm),stat=ier) 2496 ALLOCATE(resp_maint_part_fm_g(0,nvm,nparts,nsfm),stat=ier)2497 2482 ALLOCATE(veget_fm_g(0,nvm,nsfm),stat=ier) 2498 2483 ALLOCATE(veget_max_fm_g(0,nvm,nsfm),stat=ier) … … 2523 2508 precip_fm(:,:) = zero 2524 2509 gpp_daily_fm(:,:,:) = zero 2525 resp_maint_part_fm(:,:,:,:)=zero2526 2510 veget_fm(:,:,:) = zero 2527 2511 veget_max_fm(:,:,:) = zero … … 2575 2559 CALL gather(precip_fm,precip_fm_g) 2576 2560 CALL gather(gpp_daily_fm,gpp_daily_fm_g) 2577 CALL gather(resp_maint_part_fm,resp_maint_part_fm_g)2578 2561 CALL gather(veget_fm,veget_fm_g) 2579 2562 CALL gather(veget_max_fm,veget_max_fm_g) … … 2662 2645 & gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2663 2646 & start=start(1:ndim), count=count_force(1:ndim)) 2664 ndim = 4;2665 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));2666 count_force(1:ndim)=SHAPE(resp_maint_part_fm_g)2667 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+12668 ier = NF90_INQ_VARID (forcing_id,'resp_maint_part',vid)2669 ier = NF90_PUT_VAR (forcing_id,vid, &2670 & resp_maint_part_fm_g(:,:,:,ifirst(iblocks):ilast(iblocks)), &2671 & start=start(1:ndim), count=count_force(1:ndim))2672 2647 ndim = 3; 2673 2648 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2710 2685 INTEGER(i_std) :: iisf, iblocks, nblocks 2711 2686 INTEGER(i_std) :: ier 2687 LOGICAL :: a_er 2712 2688 INTEGER(i_std),DIMENSION(0:2) :: ifirst, ilast 2713 2689 INTEGER(i_std),PARAMETER :: ndm = 10 2714 2690 INTEGER(i_std),DIMENSION(ndm) :: start, count_force 2715 2691 INTEGER(i_std) :: ndim, vid 2692 2693 LOGICAL, PARAMETER :: check=.FALSE. 2694 2695 IF (check) WRITE(numout,*) "forcing_read " 2716 2696 !--------------------------------------------------------------------- 2717 2697 ! … … 2731 2711 precip_fm(:,iisf) = zero 2732 2712 gpp_daily_fm(:,:,iisf) = zero 2733 resp_maint_part_fm(:,:,:,iisf) = zero2734 2713 veget_fm(:,:,iisf) = zero 2735 2714 veget_max_fm(:,:,iisf) = zero … … 2760 2739 ENDIF 2761 2740 ENDDO 2741 IF (check) WRITE(numout,*) "forcing_read nblocks, ifirst, ilast",nblocks, ifirst, ilast 2762 2742 ! 2763 2743 IF (is_root_prc) THEN 2764 2744 DO iblocks = 1, nblocks 2745 IF (check) WRITE(numout,*) "forcing_read iblocks, ifirst(iblocks), ilast(iblocks)",iblocks, & 2746 ifirst(iblocks), ilast(iblocks) 2765 2747 IF (ifirst(iblocks) /= ilast(iblocks)) THEN 2748 a_er=.FALSE. 2766 2749 ndim = 2; 2767 2750 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2769 2752 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2770 2753 ier = NF90_INQ_VARID (forcing_id,'clay',vid) 2754 a_er = a_er.OR.(ier.NE.0) 2771 2755 ier = NF90_GET_VAR (forcing_id, vid, & 2772 2756 & clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 2773 2757 & start=start(1:ndim), count=count_force(1:ndim)) 2758 a_er = a_er.OR.(ier.NE.0) 2759 !--------- 2774 2760 ndim = 3; 2775 2761 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2777 2763 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2778 2764 ier = NF90_INQ_VARID (forcing_id,'humrel',vid) 2765 a_er = a_er.OR.(ier.NE.0) 2779 2766 ier = NF90_GET_VAR (forcing_id, vid, & 2780 2767 & humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2781 2768 & start=start(1:ndim), count=count_force(1:ndim)) 2769 a_er = a_er.OR.(ier.NE.0) 2770 !--------- 2782 2771 ndim = 2; 2783 2772 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2785 2774 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2786 2775 ier = NF90_INQ_VARID (forcing_id,'litterhum',vid) 2776 a_er = a_er.OR.(ier.NE.0) 2787 2777 ier = NF90_GET_VAR (forcing_id, vid, & 2788 2778 & litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 2789 2779 & start=start(1:ndim), count=count_force(1:ndim)) 2780 a_er = a_er.OR.(ier.NE.0) 2781 !--------- 2790 2782 ndim = 2; 2791 2783 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2793 2785 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2794 2786 ier = NF90_INQ_VARID (forcing_id,'t2m',vid) 2787 a_er = a_er.OR.(ier.NE.0) 2795 2788 ier = NF90_GET_VAR (forcing_id, vid, & 2796 2789 & t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 2797 2790 & start=start(1:ndim), count=count_force(1:ndim)) 2791 a_er = a_er.OR.(ier.NE.0) 2792 !--------- 2798 2793 ndim = 2; 2799 2794 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2801 2796 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2802 2797 ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid) 2798 a_er = a_er.OR.(ier.NE.0) 2803 2799 ier = NF90_GET_VAR (forcing_id, vid, & 2804 2800 & t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 2805 2801 & start=start(1:ndim), count=count_force(1:ndim)) 2802 a_er = a_er.OR.(ier.NE.0) 2803 !--------- 2806 2804 ndim = 2; 2807 2805 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2809 2807 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2810 2808 ier = NF90_INQ_VARID (forcing_id,'tsurf',vid) 2809 a_er = a_er.OR.(ier.NE.0) 2811 2810 ier = NF90_GET_VAR (forcing_id, vid, & 2812 2811 & tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 2813 2812 & start=start(1:ndim), count=count_force(1:ndim)) 2813 a_er = a_er.OR.(ier.NE.0) 2814 !--------- 2814 2815 ndim = 3; 2815 2816 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2817 2818 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2818 2819 ier = NF90_INQ_VARID (forcing_id,'tsoil',vid) 2820 a_er = a_er.OR.(ier.NE.0) 2819 2821 ier = NF90_GET_VAR (forcing_id, vid, & 2820 2822 & tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2821 2823 & start=start(1:ndim), count=count_force(1:ndim)) 2824 a_er = a_er.OR.(ier.NE.0) 2825 !--------- 2822 2826 ndim = 3; 2823 2827 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2825 2829 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2826 2830 ier = NF90_INQ_VARID (forcing_id,'soilhum',vid) 2831 a_er = a_er.OR.(ier.NE.0) 2827 2832 ier = NF90_GET_VAR (forcing_id, vid, & 2828 2833 & soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2829 2834 & start=start(1:ndim), count=count_force(1:ndim)) 2835 a_er = a_er.OR.(ier.NE.0) 2836 !--------- 2830 2837 ndim = 2; 2831 2838 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2833 2840 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2834 2841 ier = NF90_INQ_VARID (forcing_id,'precip',vid) 2842 a_er = a_er.OR.(ier.NE.0) 2835 2843 ier = NF90_GET_VAR (forcing_id, vid, & 2836 2844 & precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 2837 2845 & start=start(1:ndim), count=count_force(1:ndim)) 2846 a_er = a_er.OR.(ier.NE.0) 2847 !--------- 2838 2848 ndim = 3; 2839 2849 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2841 2851 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2842 2852 ier = NF90_INQ_VARID (forcing_id,'gpp',vid) 2853 a_er = a_er.OR.(ier.NE.0) 2843 2854 ier = NF90_GET_VAR (forcing_id, vid, & 2844 2855 & gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2845 2856 & start=start(1:ndim), count=count_force(1:ndim)) 2846 ndim = 4; 2847 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 2848 count_force(1:ndim)=SHAPE(resp_maint_part_fm_g) 2849 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2850 ier = NF90_INQ_VARID (forcing_id,'resp_maint_part',vid) 2851 ier = NF90_GET_VAR (forcing_id,vid, & 2852 & resp_maint_part_fm_g(:,:,:,ifirst(iblocks):ilast(iblocks)), & 2853 & start=start(1:ndim), count=count_force(1:ndim)) 2857 a_er = a_er.OR.(ier.NE.0) 2858 !--------- 2854 2859 ndim = 3; 2855 2860 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2857 2862 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2858 2863 ier = NF90_INQ_VARID (forcing_id,'veget',vid) 2864 a_er = a_er.OR.(ier.NE.0) 2859 2865 ier = NF90_GET_VAR (forcing_id, vid, & 2860 2866 & veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2861 2867 & start=start(1:ndim), count=count_force(1:ndim)) 2868 a_er = a_er.OR.(ier.NE.0) 2869 !--------- 2862 2870 ndim = 3; 2863 2871 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2865 2873 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2866 2874 ier = NF90_INQ_VARID (forcing_id,'veget_max',vid) 2875 a_er = a_er.OR.(ier.NE.0) 2867 2876 ier = NF90_GET_VAR (forcing_id, vid, & 2868 2877 & veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2869 2878 & start=start(1:ndim), count=count_force(1:ndim)) 2879 a_er = a_er.OR.(ier.NE.0) 2880 !--------- 2870 2881 ndim = 3; 2871 2882 start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); … … 2873 2884 count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 2874 2885 ier = NF90_INQ_VARID (forcing_id,'lai',vid) 2886 a_er = a_er.OR.(ier.NE.0) 2875 2887 ier = NF90_GET_VAR (forcing_id, vid, & 2876 2888 & lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 2877 2889 & start=start(1:ndim), count=count_force(1:ndim)) 2890 a_er = a_er.OR.(ier.NE.0) 2891 IF (a_er) THEN 2892 CALL ipslerr (3,'forcing_read', & 2893 & 'PROBLEM when read forcing file', & 2894 & '','') 2895 ENDIF 2878 2896 ENDIF 2879 2897 ENDDO … … 2889 2907 CALL scatter(precip_fm_g,precip_fm) 2890 2908 CALL scatter(gpp_daily_fm_g,gpp_daily_fm) 2891 CALL scatter(resp_maint_part_fm_g,resp_maint_part_fm)2892 2909 CALL scatter(veget_fm_g,veget_fm) 2893 2910 CALL scatter(veget_max_fm_g,veget_max_fm) 2894 CALL scatter(lai_fm_g,lai_fm _g)2911 CALL scatter(lai_fm_g,lai_fm) 2895 2912 !-------------------------- 2896 2913 END SUBROUTINE forcing_read
Note: See TracChangeset
for help on using the changeset viewer.
