Changeset 101 for branches


Ignore:
Timestamp:
2011-02-11T15:13:52+01:00 (13 years ago)
Author:
didier.solyga
Message:

Correct the updating of 2D parameters

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_parameters/pft_parameters.f90

    r72 r101  
    386386 SUBROUTINE pft_main  
    387387   
     388   IMPLICIT NONE 
     389 
    388390   ! Local   
    389391    INTEGER(i_std) :: i 
    390  
    391  
    392392 
    393393   !---------------------- 
    … …  
    461461      !- pheno_gdd_crit 
    462462      pheno_gdd_crit(:,:) = zero  
    463       pheno_gdd_crit(:,1) = pheno_gdd_crit_c 
    464       pheno_gdd_crit(:,2) = pheno_gdd_crit_b          
    465       pheno_gdd_crit(:,3) = pheno_gdd_crit_a  
     463!!$      pheno_gdd_crit(:,1) = pheno_gdd_crit_c(:) 
     464!!$      pheno_gdd_crit(:,2) = pheno_gdd_crit_b(:)          
     465!!$      pheno_gdd_crit(:,3) = pheno_gdd_crit_a(:)  
    466466      ! 
    467467      !- senescence_temp 
    468468      senescence_temp(:,:) = zero 
    469       senescence_temp(:,1) = senescence_temp_c 
    470       senescence_temp(:,2) = senescence_temp_b 
    471       senescence_temp(:,3) = senescence_temp_a 
     469!!$      senescence_temp(:,1) = senescence_temp_c(:) 
     470!!$      senescence_temp(:,2) = senescence_temp_b(:) 
     471!!$      senescence_temp(:,3) = senescence_temp_a(:) 
    472472      ! 
    473473      !- maint_resp_slope 
    474474      maint_resp_slope(:,:) = zero 
    475       maint_resp_slope(:,1)= maint_resp_slope_c               
    476       maint_resp_slope(:,2) = maint_resp_slope_b 
    477       maint_resp_slope(:,3) = maint_resp_slope_a 
     475!!$      maint_resp_slope(:,1)= maint_resp_slope_c(:)               
     476!!$      maint_resp_slope(:,2) = maint_resp_slope_b(:) 
     477!!$      maint_resp_slope(:,3) = maint_resp_slope_a(:) 
    478478      ! 
    479479      !-coeff_maint_zero 
    480       coeff_maint_zero (:,:) = zero 
    481       coeff_maint_zero(:,ileaf) = cm_zero_leaf 
    482       coeff_maint_zero(:,isapabove) = cm_zero_sapabove 
    483       coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow 
    484       coeff_maint_zero(:,iheartabove) = cm_zero_heartabove 
    485       coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow 
    486       coeff_maint_zero(:,iroot) = cm_zero_root 
    487       coeff_maint_zero(:,ifruit) = cm_zero_fruit 
    488       coeff_maint_zero(:,icarbres) = cm_zero_carbres 
     480      coeff_maint_zero(:,:) = zero 
     481!!$      coeff_maint_zero(:,ileaf) = cm_zero_leaf(:) 
     482!!$      coeff_maint_zero(:,isapabove) = cm_zero_sapabove(:) 
     483!!$      coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow(:) 
     484!!$      coeff_maint_zero(:,iheartabove) = cm_zero_heartabove(:) 
     485!!$      coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow(:) 
     486!!$      coeff_maint_zero(:,iroot) = cm_zero_root(:) 
     487!!$      coeff_maint_zero(:,ifruit) = cm_zero_fruit(:) 
     488!!$      coeff_maint_zero(:,icarbres) = cm_zero_carbres(:) 
    489489      ! 
    490490      !-alb_leaf 
    491       alb_leaf(1:nvm) = alb_leaf_vis(1:nvm) 
    492       DO i = nvm+1, 2*nvm 
    493          alb_leaf(i) = alb_leaf_nir(i-nvm) 
    494       ENDDO 
     491      alb_leaf(:) = zero 
     492!!$      alb_leaf(1:nvm) = alb_leaf_vis(1:nvm) 
     493!!$      DO i = nvm+1, 2*nvm 
     494!!$         alb_leaf(i) = alb_leaf_nir(i-nvm) 
     495!!$      ENDDO 
    495496      !- pref_soil_veg (see slowproc) 
    496  
    497497 
    498498   ELSE  
    … …  
    503503 
    504504   ENDIF 
    505  
    506  
    507  
    508505 
    509506 END SUBROUTINE pft_main 
    … …  
    513510 SUBROUTINE pft_init 
    514511   
     512   IMPLICIT NONE 
     513    
    515514   !------------ 
    516515   ! local 
    … …  
    526525   ! 1 .Sechiba 
    527526   !- 
    528    veget_ori_fixed_test_1 = zero 
     527   veget_ori_fixed_test_1(:) = zero 
    529528   llaimax(:) = zero 
    530529   llaimin(:) = zero 
    … …  
    657656   alb_leaf_vis(:) = zero 
    658657   alb_leaf_nir(:) = zero 
    659    alb_leaf(:) = zero 
    660658   !------------------------ 
    661659   !   Soil - vegetation 
    … …  
    739737      ! Respiration - stomate 
    740738      !---------------------- 
    741       maint_resp_slope_c = maint_resp_slope_c_mtc(pft_to_mtc(j))                
    742       maint_resp_slope_b = maint_resp_slope_b_mtc(pft_to_mtc(j)) 
    743       maint_resp_slope_a = maint_resp_slope_a_mtc(pft_to_mtc(j)) 
     739      maint_resp_slope_c(j) = maint_resp_slope_c_mtc(pft_to_mtc(j))                
     740      maint_resp_slope_b(j) = maint_resp_slope_b_mtc(pft_to_mtc(j)) 
     741      maint_resp_slope_a(j) = maint_resp_slope_a_mtc(pft_to_mtc(j)) 
    744742      cm_zero_leaf(j)= cm_zero_leaf_mtc(pft_to_mtc(j)) 
    745743      cm_zero_sapabove(j) = cm_zero_sapabove_mtc(pft_to_mtc(j)) 
    … …  
    747745      cm_zero_heartabove(j) = cm_zero_heartabove_mtc(pft_to_mtc(j))  
    748746      cm_zero_heartbelow(j) = cm_zero_heartbelow_mtc(pft_to_mtc(j)) 
    749       cm_zero_root(j) =cm_zero_root_mtc(pft_to_mtc(j)) 
    750       cm_zero_fruit(j) =cm_zero_fruit_mtc(pft_to_mtc(j)) 
     747      cm_zero_root(j) = cm_zero_root_mtc(pft_to_mtc(j)) 
     748      cm_zero_fruit(j) = cm_zero_fruit_mtc(pft_to_mtc(j)) 
    751749      cm_zero_carbres(j) = cm_zero_carbres_mtc(pft_to_mtc(j)) 
    752750      !---------------- 
    … …  
    841839      rveg_pft(j) = rveg_mtc(pft_to_mtc(j)) 
    842840 
    843  
     841  ! end loop over nvm     
    844842   ENDDO 
    845  
    846843 
    847844 END SUBROUTINE pft_init 
    … …  
    851848 SUBROUTINE pft_alloc 
    852849 
     850   IMPLICIT NONE 
    853851   !------------------ 
    854852   ! local 
    … …  
    10831081   ALLOCATE (rveg_pft(nvm),stat=ier) 
    10841082   l_error = l_error .OR. (ier .NE. 0)  
    1085  
    1086  
    1087  
     1083   ! 
    10881084   IF (l_error) THEN 
    10891085       STOP 'pft _alloc : error in memory allocation' 
    … …  
    12211217   IF (ALLOCATED(rveg_pft))DEALLOCATE(rveg_pft) 
    12221218 
    1223  
    12241219 END SUBROUTINE pft_clear 
    1225  
     1220! 
     1221!= 
     1222! 
    12261223 SUBROUTINE getin_sechiba_pft_parameters 
     1224 
     1225   IMPLICIT NONE 
    12271226   
    1228   LOGICAL, SAVE ::  first_call = .TRUE. 
     1227   LOGICAL, SAVE ::  first_call = .TRUE. 
    12291228 
    12301229  IF(first_call) THEN 
    … …  
    12541253     CALL getin('CO2_TMAX_FIX',co2_tmax_fix) 
    12551254     CALL getin('EXT_COEFF',ext_coeff) 
    1256       
    12571255     !------------------------------- 
    12581256     ! Evapotranspiration -  sechiba 
    … …  
    12611259     CALL getin('RSTRUCT_CONST',rstruct_const) 
    12621260     CALL getin('KZERO',kzero) 
    1263       
     1261     CALL getin('RVEG_PFT', rveg_pft)     
    12641262     !------------------- 
    12651263     ! Water - sechiba 
    … …  
    12671265     ! 
    12681266     CALL getin('WMAX_VEG',wmax_veg) 
     1267     CALL getin("HYDROL_HUMCSTE", humcste) 
    12691268     ! humcste is called in slowproc.f90 (problem with the flag) 
    1270       
    12711269     !------------------ 
    12721270     ! Albedo - sechiba 
    … …  
    12861284     CALL getin('PREF_SOIL_VEG_CLAY',pref_soil_veg_clay) 
    12871285 
     1286     first_call = .FALSE. 
     1287 
    12881288  ENDIF 
    12891289 
    12901290END SUBROUTINE getin_sechiba_pft_parameters 
    1291  
    1292  
     1291! 
     1292!= 
     1293! 
    12931294SUBROUTINE getin_stomate_pft_parameters 
     1295 
     1296  IMPLICIT NONE 
    12941297 
    12951298  LOGICAL, SAVE ::  first_call = .TRUE. 
    … …  
    13041307     CALL getin('SLA',sla) 
    13051308     CALL getin('NATURAL',natural) 
    1306       
    13071309     !----------------- 
    13081310     ! Photosynthesis 
    … …  
    13201322     CALL getin('TPHOTO_MAX_B',tphoto_max_b) 
    13211323     CALL getin('TPHOTO_MAX_C',tphoto_max_c) 
    1322       
    13231324     !---------------------- 
    13241325     ! Respiration - stomate 
    … …  
    13431344     CALL getin('FLAM',flam) 
    13441345     CALL getin('RESIST',resist) 
    1345       
    13461346     !---------------- 
    13471347     ! Flux - LUC 
    … …  
    13921392     CALL getin('SENESCENCE_TEMP_B',senescence_temp_b) 
    13931393     CALL getin('SENESCENCE_TEMP_A',senescence_temp_a) 
    1394       
    13951394     !----------- 
    13961395     ! DGVM 
    … …  
    13991398     CALL getin('TMIN_CRIT',tmin_crit) 
    14001399     CALL getin('TCM_CRIT',tcm_crit) 
     1400 
     1401     first_call = .FALSE. 
    14011402        
    14021403  ENDIF 
    14031404   
    1404   END SUBROUTINE getin_stomate_pft_parameters 
     1405END SUBROUTINE getin_stomate_pft_parameters 
    14051406 
    14061407END MODULE pft_parameters 
Note: See TracChangeset for help on using the changeset viewer.