Ignore:
Timestamp:
2011-06-17T14:02:17+02:00 (13 years ago)
Author:
didier.solyga
Message:

Externalized version merged with the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate.f90

    r64 r257  
    227227  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: nforce 
    228228 
     229  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: harvest_above_monthly, cflux_prod_monthly 
     230 
     231  ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground  
     232  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)              :: fpc_max 
     233 
    229234  ! Date and EndOfYear, intialize and update in slowproc 
    230235  ! (Now managed in slowproc for land_use) 
    231236  ! time step of STOMATE in days 
    232   REAL(r_std),SAVE                              :: dt_days=0.           ! Time step in days for stomate 
     237  REAL(r_std),SAVE                              :: dt_days=zero           ! Time step in days for stomate 
    233238  ! to check 
    234   REAL(r_std),SAVE                              :: day_counter=0.       ! count each sechiba (dtradia) time step each day 
     239  REAL(r_std),SAVE                              :: day_counter=zero       ! count each sechiba (dtradia) time step each day 
    235240  ! date (d) 
    236241  INTEGER(i_std),SAVE                          :: date=0 
    … …  
    242247  ! Land cover change flag 
    243248  LOGICAL,SAVE                                 :: lcchange=.FALSE. 
     249  ! Do update of monthly variables ? 
     250  ! This variable must be .TRUE. once a month 
     251  LOGICAL, SAVE                                :: EndOfMonth=.FALSE. 
    244252  PUBLIC  dt_days, day_counter, date, do_slow, EndOfYear, lcchange 
    245253 
    … …  
    554562 
    555563    REAL(r_std), DIMENSION(kjpindex)                                   :: vartmp 
     564    REAL(r_std)      :: net_cflux_prod_monthly_sum   , net_cflux_prod_monthly_tot 
     565    REAL(r_std)      :: net_harvest_above_monthly_sum, net_harvest_above_monthly_tot 
     566    REAL(r_std)      :: net_biosp_prod_monthly_sum   , net_biosp_prod_monthly_tot 
    556567    !--------------------------------------------------------------------- 
    557568    ! first of all: store time step in common value 
    558569    itime = kjit 
    559570 
    560     z_soil(0) = 0. 
     571    z_soil(0) = zero 
    561572    z_soil(1:nbdl) = diaglev(1:nbdl) 
    562573    DO j=1,nvm 
    … …  
    877888             ENDIF 
    878889 
    879              dt_forcesoil = 0. 
     890             dt_forcesoil = zero 
    880891             nparan = nparan+1 
    881892             DO WHILE (dt_forcesoil < dt_slow/one_day) 
    … …  
    951962       l_first_stomate = .FALSE. 
    952963       ! 
    953        ! 1.11 retu n 
     964       ! 1.11 return 
    954965       ! 
    955966       RETURN 
    … …  
    11581169    ENDDO 
    11591170 
     1171    IF ( day == 1 .AND. sec .LT. dtradia ) THEN 
     1172       EndOfMonth=.TRUE. 
     1173    ELSE 
     1174       EndOfMonth=.FALSE. 
     1175    ENDIF 
    11601176    ! 
    11611177    ! 5 "daily" variables 
    … …  
    12931309 
    12941310          CALL StomateLpj & 
    1295                &            (kjpindex, dt_days, EndOfYear, & 
     1311               &            (kjpindex, dt_days, EndOfYear, EndOfMonth, & 
    12961312               &             neighbours, resolution, & 
    12971313               &             clay, herbivores, & 
    … …  
    13181334               &             t_photo_min, t_photo_opt, t_photo_max,bm_to_litter,& 
    13191335               &             prod10, prod100, flux10, flux100, veget_cov_max_new,& 
    1320                &             convflux, cflux_prod10, cflux_prod100, harvest_above, lcchange) 
     1336               &             convflux, cflux_prod10, cflux_prod100, harvest_above, lcchange,& 
     1337               &             fpc_max) 
    13211338 
    13221339          ! 
    … …  
    15341551       ! 
    15351552       co2_flux_monthly(:,:) = co2_flux_monthly(:,:) + co2_flux_daily(:,:) 
    1536        IF ( day == 1 .AND. sec .LT. dtradia ) THEN 
     1553!      Monthly Cumulative fluxes of fluc and harvest 
     1554       harvest_above_monthly(:) = harvest_above_monthly(:) + harvest_above(:) 
     1555       cflux_prod_monthly(:) = cflux_prod_monthly(:) + convflux(:) + cflux_prod10(:) + cflux_prod100(:) 
     1556       IF ( EndOfMonth ) THEN 
    15371557          IF ( control%ok_stomate ) THEN 
    1538              CALL histwrite (hist_id_stomate, 'CO2FLUX_MONTHLY', itime, & 
     1558             CALL histwrite (hist_id_stomate, 'CO2FLUX', itime, & 
    15391559                  co2_flux_monthly, kjpindex*nvm, horipft_index) 
    15401560          ENDIF 
    15411561!MM 
    15421562! Si on supprimer le cumul par mois,  
    1543 ! il ne faut pas oublié cette modif resolution(:,1)*resolution(:,2)*contfrac(:)  
     1563! il ne faut pas oublier cette modif resolution(:,1)*resolution(:,2)*contfrac(:)  
    15441564          DO j=2, nvm 
    15451565             co2_flux_monthly(:,j) = co2_flux_monthly(:,j)* & 
    … …  
    15511571             DO j=2,nvm 
    15521572                net_co2_flux_monthly = net_co2_flux_monthly + & 
    1553                      &  co2_flux_monthly(ji,j)*veget_max(ji,j) 
     1573                     &  co2_flux_monthly(ji,j)*veget_cov_max(ji,j) 
    15541574             ENDDO 
    15551575          ENDDO 
     1576!         Total ( land) Cumulative fluxes of fluc and harvest 
     1577          net_cflux_prod_monthly_sum=& 
     1578              &  SUM(cflux_prod_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15 
     1579          CALL reduce_sum(net_cflux_prod_monthly_sum,net_cflux_prod_monthly_tot) 
     1580          CALL bcast(net_cflux_prod_monthly_tot) 
     1581 
     1582          net_harvest_above_monthly_sum=& 
     1583             &   SUM(harvest_above_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15 
     1584          CALL reduce_sum(net_harvest_above_monthly_sum,net_harvest_above_monthly_tot) 
     1585          CALL bcast(net_harvest_above_monthly_tot) 
     1586 
    15561587          net_co2_flux_monthly = net_co2_flux_monthly*1e-15 
    1557           WRITE(numout,*) 'net_co2_flux_monthly (Peta gC/month)  = ',net_co2_flux_monthly 
    1558  
    15591588          CALL reduce_sum(net_co2_flux_monthly,net_co2_flux_monthly_sum) 
    1560           IF ( control%ok_stomate ) THEN 
    1561              CALL histwrite (hist_id_stomate, 'CO2FLUX_MONTHLY_SUM', itime, & 
    1562                   (/ net_co2_flux_monthly /), 1, (/ 1 /) ) 
    1563           ENDIF 
     1589          CALL bcast(net_co2_flux_monthly_sum) 
     1590 
     1591          WRITE(numout,9010) 'GLOBAL net_cflux_prod_monthly    (Peta gC/month)  = ',net_cflux_prod_monthly_tot 
     1592          WRITE(numout,9010) 'GLOBAL net_harvest_above_monthly (Peta gC/month)  = ',net_harvest_above_monthly_tot 
     1593          WRITE(numout,9010) 'GLOBAL net_co2_flux_monthly      (Peta gC/month)  = ',net_co2_flux_monthly_sum 
     1594 
     1595!         Calculation of net biospheric production 
     1596          net_biosp_prod_monthly_tot =  & 
     1597             &    ( net_co2_flux_monthly_sum + net_cflux_prod_monthly_tot + net_harvest_above_monthly_tot ) 
     1598          WRITE(numout,9010) 'GLOBAL net_biosp_prod_monthly    (Peta gC/month)  = ',net_biosp_prod_monthly_tot 
     1599 
     16009010  FORMAT(A52,F17.14) 
     1601!!$          IF ( control%ok_stomate ) THEN 
     1602!!$             vartmp(:)=net_co2_flux_monthly_sum 
     1603!!$             CALL histwrite (hist_id_stomate, 'CO2FLUX_MONTHLY_SUM', itime, & 
     1604!!$                  vartmp, kjpindex, hori_index ) 
     1605!!$          ENDIF 
    15641606!!$          IF (is_root_prc) THEN 
    15651607!!$             OPEN( unit=39,              & 
    … …  
    15791621!!$          ENDIF 
    15801622          co2_flux_monthly(:,:) = zero 
     1623          harvest_above_monthly(:) = zero 
     1624          cflux_prod_monthly(:)    = zero 
    15811625       ENDIF 
    15821626       ! 
    … …  
    15991643 
    16001644    ENDIF  ! daily processes? 
    1601     ! CO2FLUX Daily values are saved each dtradia, 
    1602     ! then the value is wrong for the first day without restart. 
    1603     IF ( hist_id > 0 ) THEN 
    1604        CALL histwrite (hist_id, 'CO2FLUX', itime, & 
    1605             co2_flux_daily, kjpindex*nvm, horipft_index) 
    1606     ENDIF 
    1607     IF ( hist2_id > 0 ) THEN 
    1608        CALL histwrite (hist2_id, 'CO2FLUX', itime, & 
    1609             co2_flux_daily, kjpindex*nvm, horipft_index) 
    1610     ENDIF 
    1611  
    16121645    ! 
    16131646    ! 7 Outputs from Stomate 
    … …  
    19071940    ALLOCATE(co2_flux_monthly(kjpindex,nvm),stat=ier) 
    19081941    l_error = l_error .OR. (ier /= 0) 
     1942    ALLOCATE (cflux_prod_monthly(kjpindex), stat=ier) 
     1943    l_error = l_error .OR. (ier.NE.0) 
     1944    ALLOCATE (harvest_above_monthly(kjpindex), stat=ier) 
     1945    l_error = l_error .OR. (ier.NE.0) 
    19091946    ALLOCATE(bm_to_litter(kjpindex,nvm,nparts),stat=ier) 
    19101947    l_error = l_error .OR. (ier /= 0) 
    … …  
    19551992    l_error = l_error .OR. (ier.NE.0) 
    19561993    ! 
     1994    ALLOCATE (fpc_max(kjpindex,nvm), stat=ier) 
     1995    l_error = l_error .OR. (ier.NE.0) 
     1996    ! 
    19571997    IF (l_error) THEN 
    19581998       STOP 'stomate_init: error in memory allocation' 
    … …  
    20282068    WRITE(numout,*) & 
    20292069         &  'expansion across a grid cell is treated: ',treat_expansion 
     2070 
     2071    !Config Key  = LPJ_GAP_CONST_MORT 
     2072    !Config Desc = prescribe mortality if not using DGVM? 
     2073    !Config Def  = y 
     2074    !Config Help = set to TRUE if constant mortality is to be activated 
     2075    !              ignored if DGVM=true! 
     2076    ! 
     2077    lpj_gap_const_mort=.TRUE. 
     2078    CALL getin('LPJ_GAP_CONST_MORT', lpj_gap_const_mort) 
     2079    WRITE(numout,*) 'LPJ GAP: constant mortality:', lpj_gap_const_mort 
    20302080 
    20312081    !Config  Key  = HARVEST_AGRI 
    … …  
    20462096    co2_flux_daily(:,:) = zero 
    20472097    co2_flux_monthly(:,:) = zero 
    2048  
     2098    cflux_prod_monthly(:) = zero 
     2099    harvest_above_monthly(:) = zero 
     2100    control_moist_daily(:,:) = zero 
     2101    control_temp_daily(:,:) = zero 
     2102    soilcarbon_input_daily(:,:,:) = zero 
    20492103 
    20502104    ! initialisation of land cover change variables 
    … …  
    20562110    cflux_prod10(:) = zero 
    20572111    cflux_prod100(:)= zero 
     2112 
     2113    fpc_max(:,:)=zero 
    20582114    !-------------------------- 
    20592115  END SUBROUTINE stomate_init 
    … …  
    21412197    IF (ALLOCATED(co2_flux_daily)) DEALLOCATE(co2_flux_daily) 
    21422198    IF (ALLOCATED(co2_flux_monthly)) DEALLOCATE(co2_flux_monthly) 
     2199    IF (ALLOCATED(harvest_above_monthly)) DEALLOCATE (harvest_above_monthly) 
     2200    IF (ALLOCATED(cflux_prod_monthly)) DEALLOCATE (cflux_prod_monthly) 
    21432201    IF (ALLOCATED(bm_to_litter)) DEALLOCATE(bm_to_litter) 
    21442202    IF (ALLOCATED(bm_to_littercalc)) DEALLOCATE(bm_to_littercalc) 
    … …  
    22032261    IF ( ALLOCATED (control_temp_daily)) DEALLOCATE (control_temp_daily) 
    22042262    IF ( ALLOCATED (control_moist_daily)) DEALLOCATE (control_moist_daily) 
     2263 
     2264    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max) 
    22052265 
    22062266    ! 2. reset l_first 
    … …  
    22652325    !- 
    22662326    ! dummy time step, must be zero 
    2267     REAL(r_std),PARAMETER                        :: dt_0 = 0. 
     2327    REAL(r_std),PARAMETER                        :: dt_0 = zero 
    22682328    REAL(r_std),DIMENSION(kjpindex,nvm)          :: vcmax 
    22692329    REAL(r_std),DIMENSION(kjpindex,nvm)          :: vjmax 
Note: See TracChangeset for help on using the changeset viewer.