Ignore:
Location:
tags/ORCHIDEE_1_9_5_2
Files:
11 added
54 edited

Legend:

Unmodified
Added
Removed

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_parallel/transfert_para.f90

    r119 r405  
    2828  END INTERFACE 
    2929 
    30   INTERFACE gather_s 
    31     MODULE PROCEDURE gather_is, & 
    32                      gather_rs, & 
    33                      gather_ls 
    34   END INTERFACE 
     30!!$  INTERFACE gather_s 
     31!!$    MODULE PROCEDURE gather_is, & 
     32!!$                     gather_rs, & 
     33!!$                  gather_ls 
     34!!$  END INTERFACE 
    3535   
    3636  INTERFACE gather 
    … …  
    196196  IMPLICIT NONE 
    197197    LOGICAL,INTENT(INOUT) :: Var 
    198     
    199 #ifndef CPP_PARA 
    200     RETURN 
    201 #else 
    202     CALL bcast_lgen(Var,1) 
     198    LOGICAL,DIMENSION(1) :: Var1 
     199#ifndef CPP_PARA 
     200    RETURN 
     201#else 
     202    IF (is_root_prc) & 
     203         Var1(1)=Var 
     204    CALL bcast_lgen(Var1,1) 
     205    Var=Var1(1) 
    203206#endif 
    204207  END SUBROUTINE bcast_l 
    … …  
    548551!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    549552 
    550   SUBROUTINE gather_is(VarIn, VarOut) 
    551     USE data_para 
    552     USE timer 
    553  
    554     IMPLICIT NONE 
    555    
    556 #ifdef CPP_PARA 
    557     INCLUDE 'mpif.h' 
    558 #endif 
    559      
    560     INTEGER,INTENT(IN) :: VarIn 
    561     INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut 
    562    
    563 #ifdef CPP_PARA 
    564     INTEGER :: nb,i,index_para,rank 
    565     INTEGER :: ierr 
    566     LOGICAL :: flag=.FALSE. 
    567     LOGICAL, PARAMETER :: check=.FALSE. 
    568 #endif 
    569  
    570 #ifndef CPP_PARA 
    571     VarOut(:)=VarIn 
    572     RETURN 
    573 #else 
    574  
    575     IF (timer_state(timer_mpi)==running) THEN 
    576       flag=.TRUE. 
    577     ELSE 
    578       flag=.FALSE. 
    579     ENDIF 
    580      
    581     IF (flag) CALL suspend_timer(timer_mpi) 
    582  
    583     IF (check) & 
    584          WRITE(numout,*) "gather_rgen VarIn=",VarIn     
    585  
    586 #ifdef CPP_PARA 
    587     CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) 
    588 #endif 
    589  
    590     IF (check) & 
    591          WRITE(numout,*) "gather_rgen VarOut=",VarOut 
    592     IF (flag) CALL resume_timer(timer_mpi) 
    593 #endif 
    594   END SUBROUTINE gather_is 
    595  
    596   SUBROUTINE gather_rs(VarIn, VarOut) 
    597     USE data_para 
    598     USE timer 
    599  
    600     IMPLICIT NONE 
    601    
    602 #ifdef CPP_PARA 
    603     INCLUDE 'mpif.h' 
    604 #endif 
    605  
    606     REAL,INTENT(IN) :: VarIn 
    607     REAL,INTENT(OUT),DIMENSION(:) :: VarOut 
    608    
    609 #ifdef CPP_PARA 
    610     INTEGER :: nb,i,index_para,rank 
    611     INTEGER :: ierr 
    612     LOGICAL :: flag=.FALSE. 
    613     LOGICAL, PARAMETER :: check=.FALSE. 
    614 #endif 
    615  
    616 #ifndef CPP_PARA 
    617     VarOut(:)=VarIn 
    618     RETURN 
    619 #else 
    620  
    621     IF (timer_state(timer_mpi)==running) THEN 
    622       flag=.TRUE. 
    623     ELSE 
    624       flag=.FALSE. 
    625     ENDIF 
    626      
    627     IF (flag) CALL suspend_timer(timer_mpi) 
    628  
    629     IF (check) & 
    630          WRITE(numout,*) "gather_rgen VarIn=",VarIn     
    631  
    632 #ifdef CPP_PARA 
    633     CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,root_prc,MPI_COMM_ORCH,ierr) 
    634 #endif 
    635  
    636     IF (check) & 
    637          WRITE(numout,*) "gather_rgen VarOut=",VarOut 
    638  
    639     IF (flag) CALL resume_timer(timer_mpi) 
    640 #endif 
    641   END SUBROUTINE gather_rs 
    642  
    643   SUBROUTINE gather_ls(VarIn, VarOut) 
    644     USE data_para 
    645     USE timer 
    646  
    647     IMPLICIT NONE 
    648    
    649 #ifdef CPP_PARA 
    650     INCLUDE 'mpif.h' 
    651 #endif 
    652      
    653     LOGICAL,INTENT(IN) :: VarIn 
    654     LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut 
    655    
    656 #ifdef CPP_PARA 
    657     INTEGER :: nb,i,index_para,rank 
    658     INTEGER :: ierr 
    659     LOGICAL :: flag=.FALSE. 
    660     LOGICAL, PARAMETER :: check=.FALSE. 
    661 #endif 
    662  
    663 #ifndef CPP_PARA 
    664     VarOut(:)=VarIn 
    665     RETURN 
    666 #else 
    667  
    668     IF (timer_state(timer_mpi)==running) THEN 
    669       flag=.TRUE. 
    670     ELSE 
    671       flag=.FALSE. 
    672     ENDIF 
    673      
    674     IF (flag) CALL suspend_timer(timer_mpi) 
    675  
    676     IF (check) & 
    677          WRITE(numout,*) "gather_rgen VarIn=",VarIn     
    678  
    679 #ifdef CPP_PARA 
    680     CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,root_prc,MPI_COMM_ORCH,ierr) 
    681 #endif 
    682  
    683     IF (check) & 
    684          WRITE(numout,*) "gather_rgen VarOut=",VarOut 
    685     IF (flag) CALL resume_timer(timer_mpi) 
    686 #endif 
    687   END SUBROUTINE gather_ls 
     553!!$  SUBROUTINE gather_is(VarIn, VarOut) 
     554!!$    USE data_para 
     555!!$    USE timer 
     556!!$ 
     557!!$    IMPLICIT NONE 
     558!!$   
     559!!$#ifdef CPP_PARA 
     560!!$    INCLUDE 'mpif.h' 
     561!!$#endif 
     562!!$     
     563!!$    INTEGER,INTENT(IN) :: VarIn 
     564!!$    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut 
     565!!$   
     566!!$#ifdef CPP_PARA 
     567!!$    INTEGER :: nb,i,index_para,rank 
     568!!$    INTEGER :: ierr 
     569!!$    LOGICAL :: flag=.FALSE. 
     570!!$    LOGICAL, PARAMETER :: check=.FALSE. 
     571!!$#endif 
     572!!$ 
     573!!$#ifndef CPP_PARA 
     574!!$    VarOut(:)=VarIn 
     575!!$    RETURN 
     576!!$#else 
     577!!$ 
     578!!$    IF (timer_state(timer_mpi)==running) THEN 
     579!!$      flag=.TRUE. 
     580!!$    ELSE 
     581!!$      flag=.FALSE. 
     582!!$    ENDIF 
     583!!$     
     584!!$    IF (flag) CALL suspend_timer(timer_mpi) 
     585!!$ 
     586!!$    IF (check) & 
     587!!$         WRITE(numout,*) "gather_rgen VarIn=",VarIn     
     588!!$ 
     589!!$#ifdef CPP_PARA 
     590!!$    CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) 
     591!!$#endif 
     592!!$ 
     593!!$    IF (check) & 
     594!!$         WRITE(numout,*) "gather_rgen VarOut=",VarOut 
     595!!$    IF (flag) CALL resume_timer(timer_mpi) 
     596!!$#endif 
     597!!$  END SUBROUTINE gather_is 
     598!!$ 
     599!!$  SUBROUTINE gather_rs(VarIn, VarOut) 
     600!!$    USE data_para 
     601!!$    USE timer 
     602!!$ 
     603!!$    IMPLICIT NONE 
     604!!$   
     605!!$#ifdef CPP_PARA 
     606!!$    INCLUDE 'mpif.h' 
     607!!$#endif 
     608!!$ 
     609!!$    REAL,INTENT(IN) :: VarIn 
     610!!$    REAL,INTENT(OUT),DIMENSION(:) :: VarOut 
     611!!$   
     612!!$#ifdef CPP_PARA 
     613!!$    INTEGER :: nb,i,index_para,rank 
     614!!$    INTEGER :: ierr 
     615!!$    LOGICAL :: flag=.FALSE. 
     616!!$    LOGICAL, PARAMETER :: check=.FALSE. 
     617!!$#endif 
     618!!$ 
     619!!$#ifndef CPP_PARA 
     620!!$    VarOut(:)=VarIn 
     621!!$    RETURN 
     622!!$#else 
     623!!$ 
     624!!$    IF (timer_state(timer_mpi)==running) THEN 
     625!!$      flag=.TRUE. 
     626!!$    ELSE 
     627!!$      flag=.FALSE. 
     628!!$    ENDIF 
     629!!$     
     630!!$    IF (flag) CALL suspend_timer(timer_mpi) 
     631!!$ 
     632!!$    IF (check) & 
     633!!$         WRITE(numout,*) "gather_rgen VarIn=",VarIn     
     634!!$ 
     635!!$#ifdef CPP_PARA 
     636!!$    CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,root_prc,MPI_COMM_ORCH,ierr) 
     637!!$#endif 
     638!!$ 
     639!!$    IF (check) & 
     640!!$         WRITE(numout,*) "gather_rgen VarOut=",VarOut 
     641!!$ 
     642!!$    IF (flag) CALL resume_timer(timer_mpi) 
     643!!$#endif 
     644!!$  END SUBROUTINE gather_rs 
     645!!$ 
     646!!$  SUBROUTINE gather_ls(VarIn, VarOut) 
     647!!$    USE data_para 
     648!!$    USE timer 
     649!!$ 
     650!!$    IMPLICIT NONE 
     651!!$   
     652!!$#ifdef CPP_PARA 
     653!!$    INCLUDE 'mpif.h' 
     654!!$#endif 
     655!!$     
     656!!$    LOGICAL,INTENT(IN) :: VarIn 
     657!!$    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut 
     658!!$   
     659!!$#ifdef CPP_PARA 
     660!!$    INTEGER :: nb,i,index_para,rank 
     661!!$    INTEGER :: ierr 
     662!!$    LOGICAL :: flag=.FALSE. 
     663!!$    LOGICAL, PARAMETER :: check=.FALSE. 
     664!!$#endif 
     665!!$ 
     666!!$#ifndef CPP_PARA 
     667!!$    VarOut(:)=VarIn 
     668!!$    RETURN 
     669!!$#else 
     670!!$ 
     671!!$    IF (timer_state(timer_mpi)==running) THEN 
     672!!$      flag=.TRUE. 
     673!!$    ELSE 
     674!!$      flag=.FALSE. 
     675!!$    ENDIF 
     676!!$     
     677!!$    IF (flag) CALL suspend_timer(timer_mpi) 
     678!!$ 
     679!!$    IF (check) & 
     680!!$         WRITE(numout,*) "gather_rgen VarIn=",VarIn     
     681!!$ 
     682!!$#ifdef CPP_PARA 
     683!!$    CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,root_prc,MPI_COMM_ORCH,ierr) 
     684!!$#endif 
     685!!$ 
     686!!$    IF (check) & 
     687!!$         WRITE(numout,*) "gather_rgen VarOut=",VarOut 
     688!!$    IF (flag) CALL resume_timer(timer_mpi) 
     689!!$#endif 
     690!!$  END SUBROUTINE gather_ls 
    688691 
    689692!!!!! --> Les entiers 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_sechiba/intersurf.f90

    r119 r405  
    3737 
    3838  PRIVATE 
    39   PUBLIC :: intersurf_main, stom_define_history, intsurf_time 
     39  PUBLIC :: intersurf_main, stom_define_history, stom_IPCC_define_history, intsurf_time 
    4040 
    4141  INTERFACE intersurf_main 
    … …  
    6464  REAL(r_std) :: julian0 
    6565  ! 
    66   LOGICAL :: check_INPUTS = .FALSE.         !! (very) long print of INPUTs in intersurf  
     66  LOGICAL, PARAMETER :: check_INPUTS = .FALSE.         !! (very) long print of INPUTs in intersurf  
    6767  LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE.  
     68  LOGICAL, SAVE :: check_time = .FALSE. 
     69  PUBLIC check_time, l_first_intersurf 
    6870  ! 
    6971CONTAINS 
    … …  
    159161    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastalflow 
    160162    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep riverflow 
     163    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     164    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    161165    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    162166    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
    … …  
    354358       & zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zpb, & 
    355359! Output : Fluxes 
    356        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     360       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    357361! Surface temperatures and surface properties 
    358362       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
    … …  
    698702    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow 
    699703    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow 
     704    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     705    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    700706    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    701707    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
    … …  
    871877       & zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zpb, & 
    872878! Output : Fluxes 
    873        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     879       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    874880! Surface temperatures and surface properties 
    875881       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
    … …  
    12081214    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow 
    12091215    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow 
     1216    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     1217    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    12101218    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    12111219    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
    … …  
    15681576       & zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, pb, & 
    15691577! Output : Fluxes 
    1570        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     1578       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    15711579! Surface temperatures and surface properties 
    15721580       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
    … …  
    18471855     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, & 
    18481856! Ajout Nathalie - passage q2m/t2m pour calcul Rveget 
    1849      & q2m, t2m)   
     1857     & q2m, t2m, & 
     1858! Add emission/deposit fields 
     1859     & field_out_names, fields_out, field_in_names, fields_in)   
    18501860#else 
    18511861  SUBROUTINE intersurf_gathered_2m (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, & 
    … …  
    18631873     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, & 
    18641874! Ajout Nathalie - passage q2m/t2m pour calcul Rveget 
    1865      & q2m, t2m)   
     1875     & q2m, t2m, & 
     1876! Add emission/deposit fields 
     1877     & field_out_names, fields_out, field_in_names, fields_in) 
    18661878#endif 
    18671879    ! routines called : sechiba_main 
    … …  
    19221934    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxlat       !! Latent chaleur flux 
    19231935    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: emis          !! Emissivity 
     1936    ! 
     1937    ! Optional arguments 
     1938    ! 
     1939    ! Names and fields for emission variables : to be transport by GCM to chemistry model. 
     1940    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names 
     1941    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_out 
     1942    ! 
     1943    ! Names and fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE. 
     1944    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names 
     1945    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in 
     1946    ! 
    19241947    ! LOCAL declaration 
    19251948    ! work arrays to scatter and/or gather information just before/after sechiba_main call's 
    … …  
    19341957    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow 
    19351958    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow 
     1959    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     1960    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    19361961    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    19371962    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
    … …  
    19451970    ! Optional arguments 
    19461971    ! 
    1947     REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN), OPTIONAL :: lon_scat_g, lat_scat_g !! The scattered values for longitude  
     1972    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g, lat_scat_g !! The scattered values for longitude  
    19481973    ! 
    19491974    INTEGER(i_std)                          :: iim,jjm                                  !! local sizes 
    … …  
    19772002    LOGICAL, SAVE                                         :: fatmco2       !! Flag to force the value of atmospheric CO2 for vegetation. 
    19782003    REAL(r_std), SAVE                                     :: atmco2        !! atmospheric CO2  
     2004    ! 
     2005    ! Number of fields to give (nb_fields_out) or get from (nb_fields_in) GCM : 
     2006    INTEGER(i_std), SAVE                                  :: nb_fields_out, nb_fields_in 
     2007    ! Id of fields to give (nb_fields_out) or get from (nb_fields_in) GCM : 
     2008    INTEGER(i_std)                                        :: i_fields_out, i_fields_in 
    19792009    ! 
    19802010    CALL ipslnlf(old_number=old_fileout) 
    … …  
    20602090       !  we have to do the work here. 
    20612091       ! 
    2062        IF ( PRESENT(lon_scat_g) .AND. PRESENT(lat_scat_g)) THEN 
     2092       IF ( .TRUE. ) THEN 
    20632093           
    20642094          lon_scat(:,:)=zero 
    … …  
    20782108             lat_g(:,:) = lat_scat_g(:,:) 
    20792109          ENDIF 
    2080  
    2081        ELSE IF ( PRESENT(lon_scat_g) .OR. PRESENT(lat_scat_g)) THEN 
    2082  
    2083           WRITE(numout,*) 'You need to provide the longitude AND latitude on the' 
    2084           WRITE(numout,*) 'gathered grid in order to start ORCHIDEE.' 
    2085           STOP 'intersurf_gathered' 
    20862110 
    20872111       ELSE 
    … …  
    21952219       ENDIF 
    21962220       ! 
     2221 
     2222       ! Prepare fieds out/in for interface with GCM. 
     2223       IF (PRESENT(field_out_names)) THEN 
     2224          nb_fields_out=SIZE(field_out_names) 
     2225       ELSE 
     2226          nb_fields_out=0 
     2227       ENDIF 
     2228       IF (PRESENT(field_in_names)) THEN 
     2229          nb_fields_in=SIZE(field_in_names) 
     2230       ELSE 
     2231          nb_fields_in=0 
     2232       ENDIF 
     2233 
    21972234       IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf' 
    21982235       ! 
    … …  
    22482285       WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac 
    22492286    ENDIF 
     2287 
     2288 
     2289    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE. 
     2290    WRITE(numout,*) "Get fields from atmosphere." 
     2291 
     2292    DO i_fields_in=1,nb_fields_in 
     2293       WRITE(numout,*) i_fields_in," Champ = ",TRIM(field_in_names(i_fields_in))  
     2294       SELECT CASE(TRIM(field_in_names(i_fields_in))) 
     2295       CASE DEFAULT  
     2296          CALL ipslerr (3,'intsurf_gathered_2m', & 
     2297            &          'You ask in GCM an unknown field '//TRIM(field_in_names(i_fields_in))//& 
     2298            &          ' to give to ORCHIDEE for this specific version.',& 
     2299            &          'This model won''t be able to continue.', & 
     2300            &          '(check your tracer parameters in GCM)') 
     2301       END SELECT 
     2302    ENDDO 
     2303     
    22502304    ! 
    22512305    ! 2. modification of co2 
    … …  
    22982352       & zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, pb, & 
    22992353! Output : Fluxes 
    2300        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     2354       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    23012355! Surface temperatures and surface properties 
    23022356       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
    … …  
    25522606    ENDDO 
    25532607    ! 
     2608    WRITE(numout,*) "Give fields to atmosphere." 
     2609     
     2610    ! Fields for emission variables : to be transport by GCM to chemistry model. 
     2611    DO i_fields_out=1,nb_fields_out 
     2612       SELECT CASE(TRIM(field_out_names(i_fields_out))) 
     2613       CASE("fCO2_land")  
     2614          fields_out(:,i_fields_out)=znetco2(:) 
     2615       CASE("fCO2_land_use") 
     2616          fields_out(:,i_fields_out)=zcarblu(:) 
     2617       CASE DEFAULT  
     2618          CALL ipslerr (3,'intsurf_gathered_2m', & 
     2619            &          'You ask from GCM an unknown field '//TRIM(field_out_names(i_fields_out))//& 
     2620            &          ' to ORCHIDEE for this specific version.',& 
     2621            &          'This model won''t be able to continue.', & 
     2622            &          '(check your tracer parameters in GCM)') 
     2623       END SELECT 
     2624    ENDDO 
     2625    ! 
    25542626    IF ( lrestart_write .AND. ok_watchout .AND. is_root_prc ) THEN 
    25552627       CALL watchout_close() 
    … …  
    25772649    REAL(r_std), INTENT(in)                     :: dt        !! Time step 
    25782650    ! 
    2579     ! LOCAL 
    2580     LOGICAL     :: check=.FALSE. 
    25812651 
    25822652    IF (l_first_intersurf) THEN 
    … …  
    25902660       ENDIF 
    25912661 
    2592        IF (check) THEN 
     2662       IF (check_time) THEN 
    25932663          write(numout,*) "calendar_str =",calendar_str 
    25942664          write(numout,*) "one_year=",one_year,", one_day=",one_day 
    … …  
    25982668 
    25992669    ! 
    2600     IF (check) & 
     2670    IF (check_time) & 
    26012671         WRITE(numout,*) "---"  
    26022672    ! Dans diffuco (ie date0 == date0_shift !!)  
    … …  
    26122682!!$       julian_diff = in_julian 
    26132683!!$       month_len = ioget_mon_len (year,month) 
    2614 !!$       IF (check) THEN 
     2684!!$       IF (check_time) THEN 
    26152685!!$          write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff 
    26162686!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp 
    … …  
    26242694       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day) 
    26252695       month_len = ioget_mon_len (year,month) 
    2626        IF (check) THEN 
     2696       IF (check_time) THEN 
    26272697          write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff 
    26282698          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp 
    … …  
    26342704!!$       julian_diff = in_julian 
    26352705!!$       month_len = ioget_mon_len (year,month) 
    2636 !!$       IF (check) THEN 
     2706!!$       IF (check_time) THEN 
    26372707!!$          write(numout,*) "in_julian=",in_julian, jur, julian_diff 
    26382708!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp 
    … …  
    26462716!!$       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day) 
    26472717!!$       month_len = ioget_mon_len (year,month) 
    2648 !!$       IF (check) THEN 
     2718!!$       IF (check_time) THEN 
    26492719!!$          write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff 
    26502720!!$          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp 
    … …  
    26522722 
    26532723 
    2654 !!$       IF (check) & 
     2724!!$       IF (check_time) & 
    26552725!!$            WRITE(numout,*) "-" 
    26562726 
    … …  
    26632733       julian_diff = in_julian 
    26642734       month_len = ioget_mon_len (year,month) 
    2665        IF (check) THEN 
     2735       IF (check_time) THEN 
    26662736          write(numout,*) "in_julian=",in_julian, julian0, julian_diff 
    26672737          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp 
    26682738       ENDIF 
    26692739    ENDIF 
    2670 !!$    IF (check) & 
     2740!!$    IF (check_time) & 
    26712741!!$         WRITE(numout,*) "---"  
    26722742 
    … …  
    26942764    long_print = .FALSE. 
    26952765    CALL getin_p('LONGPRINT',long_print) 
     2766    ! 
     2767    !Config Key  = CHECKTIME 
     2768    !Config Desc = ORCHIDEE will print messages on time 
     2769    !Config Def  = n 
     2770    !Config Help = This flag permits to print debug messages on the time. 
     2771    ! 
     2772    check_time = .FALSE. 
     2773    CALL getin_p('CHECKTIME',check_time) 
    26962774    ! 
    26972775    ! 
    … …  
    27862864    CALL getin_p('STOMATE_OK_DGVM',control_flags%ok_dgvm) 
    27872865 
    2788     IF ( control_flags%ok_dgvm ) THEN 
    2789        WRITE(numout,*) 'You try to use LPJ ',control_flags%ok_dgvm, & 
    2790             ' with this version. ' 
    2791        WRITE(numout,*) 'It is not possible because it has to be modified ', & 
    2792             ' to give correct values.' 
    2793        CALL ipslerr (3,'intsurf_config', & 
    2794          &          'Use of STOMATE_OK_DGVM not allowed with this version.',& 
    2795          &          'ORCHIDEE will stop.', & 
    2796          &          'Please disable DGVM to use this version of ORCHIDEE.') 
    2797     ENDIF 
    27982866    ! 
    27992867    ! control initialisation with sechiba 
    … …  
    44484516            & hist_pool_10axis_id, hist_pool_100axis_id, & 
    44494517            & hist_pool_11axis_id, hist_pool_101axis_id) 
    4450 ! deforestation axis added as arguments 
    44514518 
    44524519       !- end definition 
    … …  
    48004867         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt) 
    48014868 
     4869    ! Adaptation to climate 
     4870    CALL histdef (hist_id_stom, & 
     4871         &               TRIM("ADAPTATION          "), & 
     4872         &               TRIM("Adaptation to climate (DGVM)                      "), & 
     4873         &               TRIM("-                   "), iim,jjm, hist_hori_id, & 
     4874         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt) 
     4875     
     4876    ! Probability from regenerative 
     4877    CALL histdef (hist_id_stom, & 
     4878         &               TRIM("REGENERATION        "), & 
     4879         &               TRIM("Probability from regenerative (DGVM)               "), & 
     4880         &               TRIM("-                   "), iim,jjm, hist_hori_id, & 
     4881         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt) 
     4882 
     4883    ! crown area of individuals (m**2) 
     4884    CALL histdef (hist_id_stom, & 
     4885         &               TRIM("CN_IND              "), & 
     4886         &               TRIM("crown area of individuals                         "), & 
     4887         &               TRIM("m^2                 "), iim,jjm, hist_hori_id, & 
     4888         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt) 
     4889 
     4890    ! woodmass of individuals (gC) 
     4891    CALL histdef (hist_id_stom, & 
     4892         &               TRIM("WOODMASS_IND        "), & 
     4893         &               TRIM("Woodmass of individuals                           "), & 
     4894         &               TRIM("gC/pft              "), iim,jjm, hist_hori_id, & 
     4895         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt) 
     4896 
    48024897    ! total living biomass 
    48034898    CALL histdef (hist_id_stom, & 
    … …  
    50305125         &               TRIM("1/day               "), iim,jjm, hist_hori_id, & 
    50315126         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt) 
     5127 
     5128    ! Establish tree 
     5129    CALL histdef (hist_id_stom, & 
     5130         &               TRIM("ESTABTREE           "), & 
     5131         &               TRIM("Rate of tree establishement                       "), & 
     5132         &               TRIM("1/day               "), iim,jjm, hist_hori_id, & 
     5133         &               1,1,1, -99,32, ave(6), dt, hist_dt) 
     5134 
     5135    ! Establish grass 
     5136    CALL histdef (hist_id_stom, & 
     5137         &               TRIM("ESTABGRASS          "), & 
     5138         &               TRIM("Rate of grass establishement                      "), & 
     5139         &               TRIM("1/day               "), iim,jjm, hist_hori_id, & 
     5140         &               1,1,1, -99,32, ave(6), dt, hist_dt) 
    50325141 
    50335142    ! Fraction of plants that dies (light competition)   
    … …  
    52685377         &               TRIM("Carbon in Products of Land Use Change"), & 
    52695378         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, & 
     5379         &               1,1,1, -99,32, ave(1), dt, hist_dt) 
     5380    ! Carbon Mass Variation 
     5381    CALL histdef (hist_id_stom_IPCC, & 
     5382         &               TRIM("cMassVariation"), & 
     5383         &               TRIM("Terrestrial Carbon Mass Variation"), & 
     5384         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, & 
    52705385         &               1,1,1, -99,32, ave(1), dt, hist_dt) 
    52715386    ! Leaf Area Fraction 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_sechiba/routing.f90

    r119 r405  
    575575       CALL ioconf_setatt('LONG_NAME','Time counter for the routing scheme') 
    576576       CALL restget (rest_id, var_name, 1, 1, 1, kjit, .TRUE., tmp_day) 
    577        time_counter = tmp_day(1)  
     577       IF (tmp_day(1) == val_exp) THEN 
     578          time_counter = zero 
     579       ELSE 
     580          time_counter = tmp_day(1)  
     581       ENDIF 
    578582       CALL setvar (time_counter, val_exp, 'NO_KEYWORD', zero) 
    579583    ENDIF 
    … …  
    678682    CALL ioconf_setatt('LONG_NAME','Water in the lake reservoir') 
    679683    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., lake_reservoir, "gather", nbp_glo, index_g) 
    680     CALL setvar (lake_reservoir, val_exp, 'NO_KEYWORD', zero) 
     684    CALL setvar_p (lake_reservoir, val_exp, 'NO_KEYWORD', zero) 
    681685    ! 
    682686    ! Map of irrigated areas 
    … …  
    10401044!ym mais n'est pas la plus efficace 
    10411045 
    1042     IF (is_root_prc) & 
    1043          ALLOCATE( fast_flow_g(nbp_glo, nbasmax), slow_flow_g(nbp_glo, nbasmax), & 
    1044           stream_flow_g(nbp_glo, nbasmax), floods_g(nbp_glo, nbasmax), wdelay_g(nbp_glo, nbasmax) ) 
     1046    IF (is_root_prc)  THEN 
     1047       ALLOCATE( fast_flow_g(nbp_glo, nbasmax), slow_flow_g(nbp_glo, nbasmax), & 
     1048            stream_flow_g(nbp_glo, nbasmax), floods_g(nbp_glo, nbasmax),  & 
     1049            wdelay_g(nbp_glo, nbasmax) ) 
     1050    ELSE 
     1051       ALLOCATE( fast_flow_g(1,1), slow_flow_g(1,1), & 
     1052            stream_flow_g(1, 1), floods_g(1,1),  & 
     1053            wdelay_g(1,1) ) 
     1054    ENDIF 
    10451055     
    10461056        
    … …  
    10641074    ENDIF 
    10651075 
    1066     IF (is_root_prc) & 
    1067          DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g, floods_g, wdelay_g ) 
     1076    DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g, floods_g, wdelay_g ) 
    10681077    
    10691078    CALL scatter(transport_glo,transport) 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_sechiba/sechiba.f90

    r119 r405  
    187187    & precip_rain, precip_snow, lwdown, swnet, swdown, pb, & 
    188188         ! Output : Fluxes 
    189     & vevapp, fluxsens, fluxlat, coastalflow, riverflow, & 
     189    & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2flux, fco2_lu, & 
    190190         ! Surface temperatures and surface properties 
    191191    & tsol_rad, temp_sol_new, qsurf_out, albedo_out, emis_out, z0_out, & 
    … …  
    250250    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat          !! Latent chaleur flux 
    251251    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: emis_out         !! Emissivity 
    252  
     252    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: netco2flux       !! Sum CO2 flux over PFTs (gC/m**2 of average ground/s) 
     253    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fco2_lu          !! Land Cover Change CO2 flux (gC/m**2 of average ground/s) 
     254 
     255    ! local declaration 
     256    INTEGER(i_std)                                :: jv 
    253257    REAL(r_std), ALLOCATABLE, DIMENSION (:)                  :: runoff1,drainage1, soilcap1,soilflx1 
    254258    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)                :: shumdiag1 
    … …  
    318322            lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    319323            rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    320             co2_flux) 
     324            co2_flux, fco2_lu) 
     325       netco2flux(:) = zero 
     326       DO jv = 2,nvm 
     327          netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv) 
     328       ENDDO 
    321329       !  
    322330       ! computes initialisation of diffusion coeff 
    … …  
    566574         lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    567575         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    568          co2_flux) 
    569  
     576         co2_flux, fco2_lu) 
     577    ! 
     578    ! Compute global CO2 flux 
     579    ! 
     580    netco2flux(:) = zero 
     581    DO jv = 2,nvm 
     582       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv) 
     583    ENDDO 
    570584    ! 
    571585    ! call swap from new computed variables   
    … …  
    809823            lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    810824            rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    811             co2_flux) 
    812  
     825            co2_flux, fco2_lu) 
     826       netco2flux(:) = zero 
     827       DO jv = 2,nvm 
     828          netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv) 
     829       ENDDO 
    813830 
    814831       var_name= 'shumdiag'   

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_sechiba/slowproc.f90

    r119 r405  
    8181       lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    8282       rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    83        co2_flux) 
     83       co2_flux, fco2_lu) 
    8484 
    8585 
    … …  
    120120    ! output fields 
    121121    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)      :: co2_flux         !! CO2 flux in gC/m**2 of average ground/second 
     122    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: fco2_lu          !! Land Cover Change CO2 flux (gC/m**2 of average ground/s) 
    122123    ! modified scalar 
    123124    ! modified fields 
    … …  
    193194               veget_nextyear, totfrac_nobio_nextyear, & 
    194195               hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    195                co2_flux,resp_maint,resp_hetero,resp_growth) 
     196               co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    196197          ! 
    197198       ENDIF 
    … …  
    289290               veget_nextyear, totfrac_nobio_nextyear, & 
    290291               hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    291                co2_flux,resp_maint,resp_hetero,resp_growth) 
     292               co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    292293       ENDIF 
    293294 
    … …  
    387388            veget_nextyear, totfrac_nobio_nextyear, & 
    388389            hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    389             co2_flux,resp_maint,resp_hetero,resp_growth) 
     390            co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    390391       IF ( control%ok_stomate .AND. control%ok_sechiba ) THEN 
    391392          CALL histwrite(hist_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg) 
    … …  
    775776       ! to be in sechiba when teststomate will have disapeared. 
    776777!MM Problem here with dpu which depends on soil type 
    777     DO jv = 1, nbdl-1 
     778    DO l = 1, nbdl-1 
    778779       ! first 2.0 is dpu  
    779780       ! second 2.0 is average 
    780        diaglev(jv) = dpu_cste/(2**(nbdl-1) -1) * ( ( 2**(jv-1) -1) + ( 2**(jv) -1) ) / 2.0 
     781       diaglev(l) = dpu_cste/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0 
    781782    ENDDO 
    782783    diaglev(nbdl) = dpu_cste 
    … …  
    26792680          !    et PFT naturel / (somme des vegets - somme des vegets anthropiques) 
    26802681          !       est conservee. 
    2681           ! Sum veget_next = old (sum veget_next Naturel) + (sum veget_next Anthropic)  
    2682           !           = new (sum veget_next Naturel) + (sum veget_next Anthropic) 
    2683           !    a / (S-A) = e / (S-B) ; b/(S-A) = f/(S-B) 
     2682          ! Modification de Nathalie :  
     2683          ! Si les PFTs anthropique diminue, on les remplace plutôt par du sol nu. 
     2684          ! Le DGVM est chargé de ré-introduire les PFTs naturels. 
    26842685          IF (sumf > min_sechiba) THEN 
    26852686             sumvAnthro_old = zero 
    … …  
    26882689                IF ( .NOT. natural(jv) ) THEN 
    26892690                   veget_next(ib,jv) = veget_next(ib,jv) / sumf 
    2690                    sumvAnthro = sumvAnthro + veget_last(ib,jv) 
     2691                   sumvAnthro = sumvAnthro + veget_next(ib,jv) 
    26912692                   sumvAnthro_old = sumvAnthro_old + veget_last(ib,jv) 
    26922693                ENDIF 
    26932694             ENDDO 
    2694              ! conservation : 
    2695              rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old ) 
    2696              veget_next(ib,1) = veget_last(ib,1) * rapport 
    2697              DO jv = 2, nvm 
    2698                 IF ( .NOT. natural(jv) ) THEN 
    2699                    veget_next(ib,jv) = veget_last(ib,jv) * rapport 
    2700                 ENDIF 
    2701              ENDDO 
     2695 
     2696             IF ( sumvAnthro_old < sumvAnthro ) THEN 
     2697                ! deforestation 
     2698                ! conservation : 
     2699                rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old ) 
     2700                DO jv = 1, nvm 
     2701                   IF ( natural(jv) ) THEN 
     2702                      veget_next(ib,jv) = veget_last(ib,jv) * rapport 
     2703                   ENDIF 
     2704                ENDDO 
     2705             ELSE 
     2706                ! reforestation 
     2707                DO jv = 1, nvm 
     2708                   IF ( natural(jv) ) THEN 
     2709                      veget_next(ib,jv) = veget_last(ib,jv) 
     2710                   ENDIF 
     2711                ENDDO 
     2712                veget_next(ib,1) = veget_next(ib,1) + sumvAnthro_old - sumvAnthro 
     2713             ENDIF 
     2714 
    27022715             ! test 
    2703              IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > EPSILON(un) ) THEN 
     2716             IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > 10*EPSILON(un) ) THEN 
    27042717                WRITE(numout,*) "No conservation of sum of veget for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")"  
    27052718                WRITE(numout,*) "last sum of veget ",sum_veg," new sum of veget ",SUM(veget_next(ib,:))," error : ",& 
    27062719                     &                         SUM(veget_next(ib,:)) - sum_veg 
    2707                 WRITE(numout,*) "Anthropic modificaztions : last ",sumvAnthro_old," new ",sumvAnthro                 
     2720                WRITE(numout,*) "Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro                 
    27082721                CALL ipslerr (3,'slowproc_update', & 
    27092722                     &          'No conservation of sum of veget_next', & 
    … …  
    28892902    ! 
    28902903    IF (MAXVAL(vegmap) .LT. nolson) THEN 
    2891       WRITE(*,*) 'WARNING -- WARNING' 
    2892       WRITE(*,*) 'The vegetation map has to few vegetation types.' 
    2893       WRITE(*,*) 'If you are lucky it will work but please check' 
     2904       WRITE(numout,*) 'WARNING -- WARNING' 
     2905       WRITE(numout,*) 'The vegetation map has to few vegetation types.' 
     2906       WRITE(numout,*) 'If you are lucky it will work but please check' 
    28942907    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN 
    2895       WRITE(*,*) 'More vegetation types in file than the code can' 
    2896       WRITE(*,*) 'deal with.: ',  MAXVAL(vegmap),  nolson 
    2897       STOP 'slowproc_interpol' 
     2908       WRITE(numout,*) 'More vegetation types in file than the code can' 
     2909       WRITE(numout,*) 'deal with.: ',  MAXVAL(vegmap),  nolson 
     2910       STOP 'slowproc_interpol' 
    28982911    ENDIF 
    28992912    ! 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_constraints.f90

    r119 r405  
    147147          IF ( tree(j) .AND. ( pheno_crit%pheno_model(j) .NE. 'none' ) ) THEN 
    148148 
    149              WHERE ( when_growthinit(:,j) .GT. too_long*one_year ) 
     149             WHERE ( when_growthinit(:,j) .GT. too_long*one_year .AND. when_growthinit(:,j).LT. large_value) 
    150150                adapted(:,j) = zero 
    151151             ENDWHERE 
    … …  
    199199    ENDDO 
    200200 
     201    CALL histwrite (hist_id_stomate, 'ADAPTATION', itime, & 
     202         adapted, npts*nvm, horipft_index) 
     203    CALL histwrite (hist_id_stomate, 'REGENERATION', itime, & 
     204         regenerate, npts*nvm, horipft_index) 
     205 
    201206    IF (bavard.GE.4) WRITE(numout,*) 'Leaving constraints' 
    202207 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_cover.f90

    r119 r405  
    2323 
    2424  SUBROUTINE cover (npts, cn_ind, ind, biomass, & 
    25        veget_max, veget_max_old, veget, lai, litter, carbon) 
     25       veget_max, veget_max_old, veget, lai, litter, carbon, turnover_daily, bm_to_litter) 
    2626 
    2727    ! 
    … …  
    3737    ! density of individuals (1/(m**2 of ground)) 
    3838    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)          :: ind 
     39    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground at beginning of time step 
    3940    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)          :: veget_max_old 
    4041 
    … …  
    4445    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground 
    4546    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)       :: veget_max 
     47    ! Turnover rates (gC/(m**2 of ground)/day) 
     48    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)          :: turnover_daily 
     49    ! conversion of biomass to litter (g/m**2 / day 
     50    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)          :: bm_to_litter 
    4651 
    4752    ! 0.3 output 
    … …  
    5055    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)       :: veget 
    5156    ! leaf area index OF AN INDIVIDUAL PLANT 
    52     REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: lai 
     57    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: lai 
    5358 
    5459    ! metabolic and structural litter, above and below ground (gC/(m**2 of ground)) 
    … …  
    6065 
    6166    ! index 
    62     INTEGER(i_std)                                         :: i,j 
     67    INTEGER(i_std)                                         :: i,j,k,m 
    6368 
    6469    ! Litter dilution (gC/m²) 
    … …  
    6873 
    6974    ! conversion vectors 
    70     REAL(r_std),DIMENSION(nvm)                                         :: delta_veg 
     75    REAL(r_std),DIMENSION(nvm)                                         :: delta_veg,reduct 
    7176    ! vecteur de conversion 
    72     REAL(r_std)                                                        :: delta_veg_sum 
     77    REAL(r_std)                                                        :: delta_veg_sum,diff,sr 
     78    REAL(r_std), DIMENSION(npts)                                       :: frac_nat,sum_vegettree,sum_vegetgrass 
     79    REAL(r_std), DIMENSION(npts)                                       :: sum_veget_natveg 
    7380 
    7481    ! ========================================================================= 
    … …  
    8188    IF ( control%ok_dgvm ) THEN 
    8289 
    83        veget_max(:,ibare_sechiba) = 1. 
     90       ! some initialisations 
     91       frac_nat(:) = un 
     92       sum_veget_natveg(:) = zero 
     93       sum_vegettree(:) = zero 
     94       sum_vegetgrass(:) = zero 
     95 
     96       veget_max(:,ibare_sechiba) = un 
    8497 
    8598       DO j = 2,nvm 
    … …  
    88101 
    89102             veget_max(:,j) = ind(:,j) * cn_ind(:,j) 
    90  
    91           ENDIF 
    92  
     103             sum_veget_natveg(:) = sum_veget_natveg(:) + veget_max(:,j) 
     104 
     105          ELSE 
     106             !fraction occupied by agriculture needs to be substracted for the DGVM 
     107             !this is used below to constrain veget for natural vegetation, see below 
     108             frac_nat(:) = frac_nat(:) - veget_max(:,j) 
     109 
     110          ENDIF 
     111 
     112       ENDDO 
     113 
     114       DO i = 1, npts  
     115 
     116          IF (sum_veget_natveg(i) .GT. frac_nat(i) .AND. frac_nat(i) .GT. min_stomate) THEN 
     117 
     118             DO j = 2,nvm 
     119                IF( natural(j) ) THEN 
     120                   veget_max(i,j) =  veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i) 
     121                ENDIF 
     122             ENDDO 
     123 
     124          ENDIF 
     125       ENDDO 
     126 
     127       DO j = 2,nvm 
    93128          veget_max(:,ibare_sechiba) = veget_max(:,ibare_sechiba) - veget_max(:,j) 
    94  
    95        ENDDO 
    96  
     129       ENDDO 
    97130       veget_max(:,ibare_sechiba) = MAX( veget_max(:,ibare_sechiba), zero ) 
    98131 
     132       ! 1.3 calculate carbon fluxes between PFTs to maintain mass balance 
     133       ! 
     134 
     135       DO i = 1, npts          
     136          ! Generation of the conversion vector 
     137 
     138          delta_veg(:) = veget_max(i,:)-veget_max_old(i,:) 
     139          delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero) 
     140 
     141          dilu_lit(i,:,:) = zero 
     142          dilu_soil_carbon(i,:) = zero 
     143          DO j=1, nvm 
     144             IF ( delta_veg(j) < -min_stomate ) THEN  
     145                dilu_lit(i,:,:)=  dilu_lit(i,:,:) + delta_veg(j)*litter(i,:,j,:) / delta_veg_sum 
     146                dilu_soil_carbon(i,:)=  dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum 
     147             ENDIF 
     148          ENDDO 
     149 
     150          DO j=1, nvm 
     151             IF ( delta_veg(j) > min_stomate) THEN 
     152 
     153                ! Dilution of reservoirs 
     154 
     155                ! Litter 
     156                litter(i,:,j,:)=(litter(i,:,j,:) * veget_max_old(i,j) + dilu_lit(i,:,:) * delta_veg(j)) / veget_max(i,j) 
     157 
     158                ! Soil carbon 
     159                carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max(i,j) 
     160 
     161             ENDIF 
     162 
     163             IF(j.GE.2.AND.veget_max_old(i,j).GT.min_stomate.AND.veget_max(i,j).GT.min_stomate) THEN 
     164 
     165                ! Correct biomass densities (i.e. also litter fall) to conserve mass  
     166                ! since it's defined on veget_max 
     167 
     168                biomass(i,j,:)=biomass(i,j,:)*veget_max_old(i,j)/veget_max(i,j) 
     169                turnover_daily(i,j,:)=turnover_daily(i,j,:)*veget_max_old(i,j)/veget_max(i,j) 
     170                bm_to_litter(i,j,:)=bm_to_litter(i,j,:)*veget_max_old(i,j)/veget_max(i,j) 
     171 
     172             ENDIF 
     173 
     174          ENDDO 
     175       ENDDO 
    99176    ENDIF 
    100  
    101     DO i = 1, npts          
    102        ! Generation of the conversion vector 
    103  
    104        delta_veg(:) = veget_max(i,:)-veget_max_old(i,:) 
    105        delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero) 
    106  
    107        dilu_lit(i,:,:) = zero 
    108        dilu_soil_carbon(i,:) = zero 
    109        DO j=1, nvm 
    110           IF ( delta_veg(j) < -min_stomate ) THEN  
    111              dilu_lit(i,:,:)=  dilu_lit(i,:,:) - delta_veg(j)*litter(i,:,j,:) / delta_veg_sum 
    112              dilu_soil_carbon(i,:)=  dilu_soil_carbon(i,:) - delta_veg(j) * carbon(i,:,j) / delta_veg_sum 
    113           ENDIF 
    114        ENDDO 
    115  
    116        DO j=1, nvm 
    117           IF ( delta_veg(j) > min_stomate) THEN 
    118  
    119              ! Dilution of reservoirs 
    120  
    121              ! Litter 
    122              litter(i,:,j,:)=(litter(i,:,j,:) * veget_max_old(i,j) + dilu_lit(i,:,:) * delta_veg(j)) / veget_max(i,j) 
    123  
    124              ! Soil carbon 
    125              carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max(i,j) 
    126  
    127           ENDIF 
    128           !SZ correct biomass to conserve mass since it's defined on veget_max 
    129           IF(j.GE.2.AND.veget_max_old(i,j).GT.min_stomate.AND.veget_max(i,j).GT.min_stomate) THEN 
    130              biomass(i,j,:)=biomass(i,j,:)*veget_max_old(i,j)/veget_max(i,j) 
    131           ENDIF 
    132  
    133        ENDDO 
    134     ENDDO 
    135177 
    136178    ! 
    … …  
    140182    ! 
    141183    !MM in Soenke code but not in merge version ; must keep that ?? 
     184!NV, MM : we keep those comments for compatibility with CMIP5 computations. 
     185!! They have to be uncommented avec CMIP5 versions in the trunk ! 
    142186!!$    DO j = 2,nvm 
    143187!!$       lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j) 
    … …  
    153197             veget(i,j) = veget_max(i,j) 
    154198          ELSE 
    155              veget(i,j) = veget_max(i,j) * ( un - exp( - lai(i,j) * ext_coeff(j) ) ) 
     199             IF ( control%ok_dgvm ) THEN 
     200!!$SZneed to check this - this formulation will cause 100% veget, otherwise there will always  
     201!!$ be some percent bare ground 
     202                veget(i,j) = ind(i,j) * cn_ind(i,j)  * ( un - EXP( - lai(i,j) * ext_coeff(j) ) ) 
     203             ELSE 
     204                veget(i,j) = veget_max(i,j) * ( un - EXP( - lai(i,j) * ext_coeff(j) ) ) 
     205             ENDIF 
     206          ENDIF 
     207 
     208          ! check sums of fpc for natural vegetation (see correction below!) in dynamic mode 
     209          IF ( control%ok_dgvm ) THEN 
     210 
     211             IF(natural(j))THEN 
     212                IF(tree(j)) THEN 
     213                   sum_vegettree(i)=sum_vegettree(i)+veget(i,j) 
     214                ELSE  
     215                   sum_vegetgrass(i)=sum_vegetgrass(i)+veget(i,j) 
     216                ENDIF 
     217             ENDIF 
     218 
    156219          ENDIF 
    157220       ENDDO 
    158221    ENDDO 
    159     ! 
     222 
     223 
     224    ! 3.1 correct gridscale fpc for dynamic vegetation 
     225!!$SZ, this part should be obsolete now that veget_max is forced to 1.0 
     226!!$ nevertheless maintained just for savety. Whoever wants to test 
     227!!$ whether this works without is invited to do so. 
     228 
     229    ! in the DGVM mode, we can arrive at a sum of veget slighly exceeding 1.0, 
     230    ! because mainly of grass dynamics... 
     231    ! In this case, we devide the fpar over natural vegetation first such that  
     232    ! grasses are shadowed by trees, and in the theoretically impossible case that 
     233    ! this is not sufficient, reduce proportionally all veget's. 
     234    ! 
     235    IF ( control%ok_dgvm ) THEN 
     236 
     237       DO i = 1,npts 
     238 
     239          diff=sum_vegettree(i)+sum_vegetgrass(i)-frac_nat(i) 
     240          reduct(:) = 0. 
     241          ! ordinary case, the reason too much grasses  
     242          ! reduce grass veget to match the maximum 
     243          IF (diff .GT. 0. ) THEN 
     244 
     245             IF (sum_vegetgrass(i).GT.min_stomate) THEN 
     246                sr=0. 
     247                DO j=2,nvm 
     248                   IF(natural(j).AND..NOT.tree(j)) THEN 
     249                      reduct(j)=-MIN(diff,sum_vegetgrass(i))*veget(i,j)/sum_vegetgrass(i) 
     250                      sr=sr+reduct(j) 
     251                   ENDIF 
     252                ENDDO 
     253                diff=diff+sr 
     254             ENDIF 
     255 
     256          ENDIF 
     257 
     258          ! this is theoretically impossible, since trees can only occupy 95%, 
     259          ! but better be save than sorry 
     260          IF (diff .GT. min_stomate ) THEN 
     261 
     262             IF (sum_vegettree(i).GT.min_stomate) THEN 
     263                sr=0. 
     264                DO j=2,nvm 
     265                   IF(natural(j).AND.tree(j)) THEN 
     266                      reduct(j)=-MIN(diff,sum_vegettree(i))*veget(i,j)/sum_vegettree(i) 
     267                      sr=sr+reduct(j) 
     268                   ENDIF 
     269                ENDDO 
     270                diff=diff+sr  
     271             ENDIF 
     272 
     273          ENDIF 
     274 
     275!!$          ! tell user if the problem could not be resolved 
     276!!$          ! in theory the model should stop here! 
     277!!$          IF (diff .GT. min_stomate ) THEN 
     278!!$ 
     279!!$             write(numout,*) 'ATT, DGVM!: veget exceeds bareground without vegetation left' 
     280!!$             write(numout,*) 'ATT, DGVM!: is this a bug? cell: ',i 
     281!!$             write(numout,*) 'ATT, DGVM!: veget ',veget(i,:) 
     282!!$ 
     283!!$          ENDIF 
     284 
     285          ! finally, implement the reduction. (reduc is negative!) 
     286          veget(i,:)=veget(i,:)+reduct(:) 
     287 
     288       ENDDO 
     289 
     290    ENDIF 
     291 
    160292    veget(:,ibare_sechiba) = un 
    161293    DO j = 2,nvm 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_crown.f90

    r119 r405  
    66  !--------------------------------------------------------------------- 
    77  !- calculate individual crown area from stem mass. 
     8  !- SZ, I've put the woodmass calculation out of this routine 
     9  !      because after the very first establishment, woodmass 
     10  !      could not be calculated here as veget_max = zero and  
     11  !      d_ind not known... 
    812  !--------------------------------------------------------------------- 
    913  USE ioipsl 
    … …  
    2327  !- 
    2428  SUBROUTINE crown & 
    25        &  (npts, PFTpresent, ind, biomass, veget_max, cn_ind, height) 
     29       &  (npts, PFTpresent, ind, biomass, woodmass_ind, veget_max, cn_ind, height) 
    2630    !--------------------------------------------------------------------- 
    2731    ! 0 declarations 
    … …  
    3741    ! biomass (gC/(m**2 of ground)) 
    3842    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: biomass 
     43    ! woodmass of the individual, needed to calculate crownarea in lpj_crownarea 
     44    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: woodmass_ind 
    3945    !- 
    4046    ! 0.2 modified fields 
    … …  
    5864    ! wood mass of an individual 
    5965    !- 
    60     REAL(r_std),DIMENSION(npts) :: woodmass 
     66!!$    REAL(r_std),DIMENSION(npts) :: woodmass 
    6167    !- 
    6268    ! index 
    … …  
    7480    ! 1.1 check if DGVM activated 
    7581    !- 
    76     IF (.NOT.control%ok_dgvm) THEN 
     82    IF (.NOT.control%ok_dgvm .AND. lpj_gap_const_mort) THEN 
    7783       STOP 'crown: not to be called with static vegetation.' 
    7884    ENDIF 
    … …  
    9399          IF (natural(j)) THEN 
    94100             !------ 2.1.1 natural 
    95              WHERE (PFTpresent(:,j) .AND.ind(:,j).GT.min_stomate) 
    96                 !-------- 2.1.1.1 calculate individual wood mass 
    97                 woodmass(:) = & 
    98                      &         (biomass(:,j,isapabove)+biomass(:,j,isapbelow) & 
    99                      &         +biomass(:,j,iheartabove)+biomass(:,j,iheartbelow))/ind(:,j) 
     101             !WHERE (PFTpresent(:,j) .AND.ind(:,j).GT.min_stomate) 
     102             WHERE (PFTpresent(:,j) .AND.woodmass_ind(:,j).GT.min_stomate) 
     103!!$SZ note that woodmass_ind needs to be defined on the individual, hence 
     104!!$ biomass*veget_max/ind, not as stated here, correction MERGE 
     105!!$!-------- 2.1.1.1 calculate individual wood mass 
     106!!$          woodmass(:) = & 
     107!!$ &         (biomass(:,j,isapabove)+biomass(:,j,isapbelow) & 
     108!!$ &         +biomass(:,j,iheartabove)+biomass(:,j,iheartbelow))/ind(:,j) 
    100109                !-------- 2.1.1.2 stem diameter (pipe model) 
    101                 dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) & 
     110!!$          dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) & 
     111                dia(:) = (woodmass_ind(:,j)/(pipe_density*pi/4.*pipe_tune2)) & 
    102112                     &                **(1./(2.+pipe_tune3)) 
    103113                !-------- 2.1.1.3 height 
    104114                height(:,j) = pipe_tune2*(dia(:)**pipe_tune3) 
    105                 WHERE (height(:,j) > height_presc_12(j)) 
    106                    dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3) 
    107                    height(:,j) = height_presc_12(j) 
    108                 ENDWHERE 
     115!!$SZ: The constraint on height has nothing to do with LPJ (for that purpose there's dia_max 
     116!!$ cannot see why this is necessary - it also blurrs the output, hence I leave it commented 
     117!!$                WHERE (height(:,j) > height_presc_12(j)) 
     118!!$                   dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3) 
     119!!$                   height(:,j) = height_presc_12(j) 
     120!!$                ENDWHERE 
    109121                !-------- 2.1.1.4 crown area: for large truncs, crown area cannot 
    110122                !--------         exceed a certain value, prescribed through maxdia. 
    … …  
    128140       !       ind and cn_ind are 0 if not present 
    129141       !--- 
    130        !SZ isn't this physically inconsistent with the assumptions of sechiba?? 
    131        ! the actual LPJ formulation calculates fpc from maximum LAI, and fpar from actual LAI=veget 
    132        IF (natural(j).AND.control%ok_dgvm) THEN 
    133           veget_max(:,j) = ind(:,j) * cn_ind(:,j) 
    134        ENDIF 
     142!!$SZ: since now all state variables are defined on veget_max it is very 
     143!!$ dangerous to change this several times in stomate_lpj, as then GPP, turnover and allocated  
     144!!$ biomass are not defined on the same space! Hence, veget_max is now kept constant 
     145!!$ and updated at the end of stomate_lpj in lpj_cover.f90 
     146!!$ Eventually, this routine should only be called once at the beginning and the end of stomate_lpj 
     147!!$ or prefereably cn_ind made a saved state variable! 
     148!!$    IF (natural(j).AND.control%ok_dgvm) THEN 
     149!!$      veget_max(:,j) = ind(:,j) * cn_ind(:,j) 
     150!!$    ENDIF 
    135151    ENDDO 
    136152    !------------------- 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_establish.f90

    r119 r405  
    3333       neighbours, resolution, need_adjacent, herbivores, & 
    3434       precip_annual, gdd0, lm_lastyearmax, & 
    35        cn_ind, lai, avail_tree, avail_grass, & 
     35       cn_ind, lai, avail_tree, avail_grass,  npp_longterm, & 
    3636       leaf_age, leaf_frac, & 
    37        ind, biomass, age, everywhere, co2_to_bm,veget_max) 
    38  
     37       ind, biomass, age, everywhere, co2_to_bm,veget_max, woodmass_ind) 
    3938    ! 
    4039    ! 0 declarations 
    … …  
    7473    ! space availability for grasses 
    7574    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: avail_grass 
     75    ! longterm NPP, for each PFT (gC/(m**2 of ground)) 
     76    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: npp_longterm 
    7677    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground  
    7778    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_max 
    … …  
    9495    !NV passage 2D 
    9596    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                 :: co2_to_bm 
     97    ! woodmass of the individual, needed to calculate crownarea in lpj_crownarea 
     98    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                 :: woodmass_ind 
    9699 
    97100    ! 0.3 local 
    … …  
    111114    ! total natural fpc 
    112115    REAL(r_std), DIMENSION(npts)                                :: sumfpc 
     116    ! total fraction occupied by natural vegetation 
     117    REAL(r_std), DIMENSION(npts)                                :: fracnat 
    113118    ! total woody fpc 
    114119    REAL(r_std), DIMENSION(npts)                                :: sumfpc_wood 
    … …  
    129134    ! woodmass of an individual 
    130135    REAL(r_std), DIMENSION(npts)                                :: woodmass 
     136    ! carbon mass in youngest leaf age class (gC/m**2 PFT) 
     137    REAL(r_std), DIMENSION(npts)                                :: leaf_mass_young 
    131138    ! ratio of hw(above) to total hw, sm(above) to total sm 
    132139    REAL(r_std), DIMENSION(npts)                                :: sm_at 
    133140    ! reduction factor for establishment if many trees or grasses are present 
    134141    REAL(r_std), DIMENSION(npts)                                :: factor 
     142    ! Total carbon mass for all pools 
     143    REAL(r_std), DIMENSION(npts)                                :: total_bm_c 
     144    ! Total sappling biomass for all pools 
     145    REAL(r_std), DIMENSION(npts)                                :: total_bm_sapl 
    135146    ! from how many sides is the grid box invaded 
    136147    INTEGER(i_std)                                              :: nfrontx 
    137148    INTEGER(i_std)                                              :: nfronty 
    138149    ! daily establishment rate is large compared to present number of individuals 
    139     LOGICAL, DIMENSION(npts)                                   :: many_new 
     150    !LOGICAL, DIMENSION(npts)                                   :: many_new 
     151    ! flow due to new individuals 
     152    !   veget_max after establishment, to get a proper estimate of carbon and nitrogen  
     153    REAL(r_std), DIMENSION(npts)                                 :: vn 
     154    !   lai on each PFT surface  
     155    REAL(r_std), DIMENSION(npts)                                 :: lai_ind 
     156 
    140157    ! indices 
    141158    INTEGER(i_std)                                              :: i,j,k,m 
    … …  
    161178    ENDIF 
    162179 
    163     ! 
    164     ! 2 recalculate fpc 
    165     ! 
    166  
    167     ! 
    168     ! 2.1 Only natural part of the grid cell 
    169     ! 
    170  
    171     DO j = 2,nvm 
    172  
    173        IF ( natural(j) ) THEN 
    174           DO i = 1, npts 
    175              IF (lai(i,j) == val_exp) THEN                
    176                 fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 
    177              ELSE 
    178                 fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * ( un - exp( -lai(i,j) * ext_coeff(j) ) ) 
    179              ENDIF 
    180           ENDDO 
    181        ELSE 
    182  
    183           fpc_nat(:,j) = zero 
    184  
    185        ENDIF 
    186  
    187     ENDDO 
    188  
    189     ! 
    190     ! 2.2 total natural fpc on grid 
    191     ! 
    192  
    193     sumfpc(:) = SUM( fpc_nat(:,:), DIM=2 ) 
    194  
    195     ! 
    196     ! 2.3 total woody fpc on grid and number of regenerative tree pfts 
    197     ! 
    198  
    199     sumfpc_wood(:) = zero 
    200     spacefight_tree(:) = zero 
    201  
    202     DO j = 2,nvm 
    203  
    204        IF ( tree(j) .AND. natural(j) ) THEN 
    205  
    206           ! total woody fpc 
    207  
    208           WHERE ( PFTpresent(:,j) ) 
    209              sumfpc_wood(:) = sumfpc_wood(:) + fpc_nat(:,j) 
    210           ENDWHERE 
    211  
    212           ! how many trees are competing? Count a PFT fully only if it is present 
    213           !   on the whole grid box. 
    214  
    215           WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) ) 
    216              spacefight_tree(:) = spacefight_tree(:) + everywhere(:,j) 
    217           ENDWHERE 
    218  
    219        ENDIF 
    220  
    221     ENDDO 
    222  
    223     ! 
    224     ! 2.4 number of natural grasses 
    225     ! 
    226  
    227     spacefight_grass(:) = zero 
    228  
    229     DO j = 2,nvm 
    230  
    231        IF ( .NOT. tree(j) .AND. natural(j) ) THEN 
    232  
    233           ! how many grasses are competing? Count a PFT fully only if it is present 
    234           !   on the whole grid box. 
    235  
    236           WHERE ( PFTpresent(:,j) ) 
    237              spacefight_grass(:) = spacefight_grass(:) + everywhere(:,j) 
    238           ENDWHERE 
    239  
    240        ENDIF 
    241  
    242     ENDDO 
    243  
    244     ! 
    245     ! 3 establishment rate 
    246     ! 
    247  
    248     ! 
    249     ! 3.1 maximum establishment rate, based on climate only 
    250     ! 
    251  
    252     WHERE ( ( precip_annual(:) .GE. precip_crit ) .AND. ( gdd0(:) .GE. gdd_crit ) ) 
    253  
    254        estab_rate_max_climate_tree(:) = estab_max_tree 
    255        estab_rate_max_climate_grass(:) = estab_max_grass 
    256  
    257     ELSEWHERE 
    258  
    259        estab_rate_max_climate_tree(:) = zero 
    260        estab_rate_max_climate_grass(:) = zero 
    261  
    262     ENDWHERE 
    263  
    264     ! 
    265     ! 3.2 reduce maximum tree establishment rate if many trees present. 
    266     !     In the original DGVM, this is done using a step function which yields a 
    267     !     reduction by factor 4 if sumfpc_wood(i) .GT.  fpc_crit - 0.05. 
    268     !     This can lead to small oscillations (without consequences however). 
    269     !     Here, a steady linear transition is used between fpc_crit-0.075 and 
    270     !     fpc_crit-0.025. 
    271     ! 
    272  
    273     factor(:) = un - 15. * ( sumfpc_wood(:) - (fpc_crit-.075) ) 
    274     factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:) ) ) 
    275  
    276     estab_rate_max_tree(:) = estab_rate_max_climate_tree(:) * factor(:) 
    277  
    278     ! 
    279     ! 3.3 Modulate grass establishment rate. 
    280     !     If canopy is not closed (fpc < fpc_crit-0.05), normal establishment. 
    281     !     If canopy is closed, establishment is reduced by a factor 4. 
    282     !     Factor is linear between these two bounds. 
    283     !     This is different from the original DGVM where a step function is 
    284     !     used at fpc_crit-0.05 (This can lead to small oscillations, 
    285     !     without consequences however). 
    286     ! 
    287  
    288     factor(:) = un - 15. * ( sumfpc(:) - (fpc_crit-.05) ) 
    289     factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:) ) ) 
    290  
    291     estab_rate_max_grass(:) = estab_rate_max_climate_grass(:) * factor(:) 
    292  
    293     ! 
    294     ! 4 do establishment for natural PFTs 
    295     ! 
    296  
    297     d_ind(:,:) = zero 
    298  
    299     DO j = 2,nvm 
    300  
    301        ! only for natural PFTs 
    302  
    303        IF ( natural(j) ) THEN 
    304  
    305           ! 
    306           ! 4.1 PFT expansion across the grid box. Not to be confused with areal 
    307           !     coverage. 
    308           ! 
    309  
    310           IF ( treat_expansion ) THEN 
    311  
    312              ! only treat plants that are regenerative and present and still can expand 
    313  
    314              DO i = 1, npts 
    315  
    316                 IF ( PFTpresent(i,j) .AND. & 
    317                      ( everywhere(i,j) .LT. un ) .AND. & 
    318                      ( regenerate(i,j) .GT. regenerate_crit ) ) THEN 
    319  
    320                    ! from how many sides is the grid box invaded (separate x and y directions 
    321                    ! because resolution may be strongly anisotropic) 
    322                    ! 
    323                    ! For the moment we only look into 4 direction but that can be extanded (JP)  
    324                    ! 
    325                    nfrontx = 0 
    326                    IF ( neighbours(i,3) .GT. 0 ) THEN 
    327                       IF ( everywhere(neighbours(i,3),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1 
    328                    ENDIF 
    329                    IF ( neighbours(i,7) .GT. 0 ) THEN 
    330                       IF ( everywhere(neighbours(i,7),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1 
    331                    ENDIF 
    332  
    333                    nfronty = 0 
    334                    IF ( neighbours(i,1) .GT. 0 ) THEN 
    335                       IF ( everywhere(neighbours(i,1),j) .GT. 1.-min_stomate ) nfronty = nfronty+1 
    336                    ENDIF 
    337                    IF ( neighbours(i,5) .GT. 0 ) THEN 
    338                       IF ( everywhere(neighbours(i,5),j) .GT. 1.-min_stomate ) nfronty = nfronty+1 
    339                    ENDIF 
    340  
    341                    everywhere(i,j) = & 
    342                         everywhere(i,j) + migrate(j) * dt/one_year * & 
    343                         ( nfrontx / resolution(i,1) + nfronty / resolution(i,2) ) 
    344  
    345                    IF ( .NOT. need_adjacent(i,j) ) THEN 
    346  
    347                       ! in that case, we also assume that the PFT expands from places within 
    348                       ! the grid box (e.g., oasis). 
     180 
     181    IF (control%ok_dgvm) THEN 
     182       ! 
     183       ! 2 recalculate fpc 
     184       ! 
     185 
     186       ! 
     187       ! 2.1 Only natural part of the grid cell 
     188       ! 
     189 
     190       fracnat(:) = 1. 
     191       do j = 2,nvm 
     192          IF ( .NOT. natural(j) ) THEN 
     193             fracnat(:) = fracnat(:) - veget_max(:,j) 
     194          ENDIF 
     195       ENDDO 
     196 
     197       ! 
     198       ! 2.2 total natural fpc on grid 
     199       ! 
     200       sumfpc(:) = zero 
     201       DO j = 2,nvm 
     202 
     203          IF ( natural(j) ) THEN 
     204             WHERE(fracnat(:).GT.min_stomate) 
     205                WHERE (lai(:,j) == val_exp)  
     206                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 
     207                ELSEWHERE 
     208                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) &  
     209                        * ( 1. - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ) 
     210                ENDWHERE 
     211             ENDWHERE 
     212 
     213             WHERE ( PFTpresent(:,j) ) 
     214                sumfpc(:) = sumfpc(:) + fpc_nat(:,j) 
     215             ENDWHERE 
     216          ELSE 
     217 
     218             fpc_nat(:,j) = 0.0 
     219 
     220          ENDIF 
     221 
     222       ENDDO 
     223 
     224       ! 
     225       ! 2.3 total woody fpc on grid and number of regenerative tree pfts 
     226       ! 
     227 
     228       sumfpc_wood(:) = zero 
     229       spacefight_tree(:) = zero 
     230 
     231       DO j = 2,nvm 
     232 
     233          IF ( tree(j) .AND. natural(j) ) THEN 
     234 
     235             ! total woody fpc 
     236 
     237             WHERE ( PFTpresent(:,j) ) 
     238                sumfpc_wood(:) = sumfpc_wood(:) + fpc_nat(:,j) 
     239             ENDWHERE 
     240 
     241             ! how many trees are competing? Count a PFT fully only if it is present 
     242             !   on the whole grid box. 
     243 
     244             WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) ) 
     245                spacefight_tree(:) = spacefight_tree(:) + everywhere(:,j) 
     246             ENDWHERE 
     247 
     248          ENDIF 
     249 
     250       ENDDO 
     251 
     252       ! 
     253       ! 2.4 number of natural grasses 
     254       ! 
     255 
     256       spacefight_grass(:) = zero 
     257 
     258       DO j = 2,nvm 
     259 
     260          IF ( .NOT. tree(j) .AND. natural(j) ) THEN 
     261 
     262             ! how many grasses are competing? Count a PFT fully only if it is present 
     263             !   on the whole grid box. 
     264 
     265             WHERE ( PFTpresent(:,j) ) 
     266                spacefight_grass(:) = spacefight_grass(:) + everywhere(:,j) 
     267             ENDWHERE 
     268 
     269          ENDIF 
     270 
     271       ENDDO 
     272 
     273       ! 
     274       ! 3 establishment rate 
     275       ! 
     276 
     277       ! 
     278       ! 3.1 maximum establishment rate, based on climate only 
     279       ! 
     280 
     281       WHERE ( ( precip_annual(:) .GE. precip_crit ) .AND. ( gdd0(:) .GE. gdd_crit ) ) 
     282 
     283          estab_rate_max_climate_tree(:) = estab_max_tree 
     284          estab_rate_max_climate_grass(:) = estab_max_grass 
     285 
     286       ELSEWHERE 
     287 
     288          estab_rate_max_climate_tree(:) = zero 
     289          estab_rate_max_climate_grass(:) = zero 
     290 
     291       ENDWHERE 
     292 
     293       ! 
     294       ! 3.2 reduce maximum tree establishment rate if many trees present. 
     295       !     In the original DGVM, this is done using a step function which yields a 
     296       !     reduction by factor 4 if sumfpc_wood(i) .GT.  fpc_crit - 0.05. 
     297       !     This can lead to small oscillations (without consequences however). 
     298       !     Here, a steady linear transition is used between fpc_crit-0.075 and 
     299       !     fpc_crit-0.025. 
     300       ! 
     301 
     302       !       factor(:) = 1. - 15. * ( sumfpc_wood(:) - (fpc_crit-.075) ) 
     303       !       factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:) ) ) 
     304 
     305       !SZ modified according to Smith et al. 2001, 080806 
     306       factor(:)=(1.0-exp(-5.0*(1.0-sumfpc_wood(:))))*(1.0-sumfpc_wood(:)) 
     307 
     308       estab_rate_max_tree(:) = estab_rate_max_climate_tree(:) * factor(:) 
     309 
     310       ! 
     311       ! 3.3 Modulate grass establishment rate. 
     312       !     If canopy is not closed (fpc < fpc_crit-0.05), normal establishment. 
     313       !     If canopy is closed, establishment is reduced by a factor 4. 
     314       !     Factor is linear between these two bounds. 
     315       !     This is different from the original DGVM where a step function is 
     316       !     used at fpc_crit-0.05 (This can lead to small oscillations, 
     317       !     without consequences however). 
     318       ! 
     319 
     320       !       factor(:) = 1. - 15. * ( sumfpc(:) - (fpc_crit-.05) ) 
     321       !       factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:) ) ) 
     322       !       estab_rate_max_grass(:) = estab_rate_max_climate_grass(:) * factor(:) 
     323 
     324       !SZ modified to true LPJ formulation, grasses are only allowed in the 
     325       !fpc fraction not occupied by trees..., 080806 
     326!NVmodif       estab_rate_max_grass(:)=MAX(0.98-sumfpc(:),zero) 
     327       estab_rate_max_grass(:)=MAX(MIN(estab_rate_max_climate_grass(:),0.98-sumfpc(:)),zero) 
     328 
     329       ! SZ: longterm grass NPP for competition between C4 and C3 grasses 
     330       !     to avoid equal veget_max, the idea is that more reestablishment 
     331       !     is possible for the more productive PFT 
     332       factor(:)=min_stomate 
     333       DO j = 2,nvm 
     334          IF ( natural(j) .AND. .NOT.tree(j)) &  
     335               factor(:)=factor(:)+npp_longterm(:,j) * & 
     336               lm_lastyearmax(:,j) * sla(j) 
     337       ENDDO 
     338       ! 
     339       ! 
     340       ! 
     341       ! 4 do establishment for natural PFTs 
     342       ! 
     343 
     344       d_ind(:,:) = zero 
     345 
     346       DO j = 2,nvm 
     347 
     348          ! only for natural PFTs 
     349 
     350          IF ( natural(j) ) THEN 
     351 
     352             ! 
     353             ! 4.1 PFT expansion across the grid box. Not to be confused with areal 
     354             !     coverage. 
     355             ! 
     356 
     357             IF ( treat_expansion ) THEN 
     358 
     359                ! only treat plants that are regenerative and present and still can expand 
     360 
     361                DO i = 1, npts 
     362 
     363                   IF ( PFTpresent(i,j) .AND. & 
     364                        ( everywhere(i,j) .LT. un ) .AND. & 
     365                        ( regenerate(i,j) .GT. regenerate_crit ) ) THEN 
     366 
     367                      ! from how many sides is the grid box invaded (separate x and y directions 
     368                      ! because resolution may be strongly anisotropic) 
     369                      ! 
     370                      ! For the moment we only look into 4 direction but that can be extanded (JP)  
     371                      ! 
     372                      nfrontx = 0 
     373                      IF ( neighbours(i,3) .GT. 0 ) THEN 
     374                         IF ( everywhere(neighbours(i,3),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1 
     375                      ENDIF 
     376                      IF ( neighbours(i,7) .GT. 0 ) THEN 
     377                         IF ( everywhere(neighbours(i,7),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1 
     378                      ENDIF 
     379 
     380                      nfronty = 0 
     381                      IF ( neighbours(i,1) .GT. 0 ) THEN 
     382                         IF ( everywhere(neighbours(i,1),j) .GT. 1.-min_stomate ) nfronty = nfronty+1 
     383                      ENDIF 
     384                      IF ( neighbours(i,5) .GT. 0 ) THEN 
     385                         IF ( everywhere(neighbours(i,5),j) .GT. 1.-min_stomate ) nfronty = nfronty+1 
     386                      ENDIF 
    349387 
    350388                      everywhere(i,j) = & 
    351389                           everywhere(i,j) + migrate(j) * dt/one_year * & 
    352                            2. * SQRT( pi*everywhere(i,j)/(resolution(i,1)*resolution(i,2)) ) 
     390                           ( nfrontx / resolution(i,1) + nfronty / resolution(i,2) ) 
     391 
     392                      IF ( .NOT. need_adjacent(i,j) ) THEN 
     393 
     394                         ! in that case, we also assume that the PFT expands from places within 
     395                         ! the grid box (e.g., oasis). 
     396 
     397                         everywhere(i,j) = & 
     398                              everywhere(i,j) + migrate(j) * dt/one_year * & 
     399                              2. * SQRT( pi*everywhere(i,j)/(resolution(i,1)*resolution(i,2)) ) 
     400 
     401                      ENDIF 
     402 
     403                      everywhere(i,j) = MIN( everywhere(i,j), 1._r_std ) 
    353404 
    354405                   ENDIF 
    355406 
    356                    everywhere(i,j) = MIN( everywhere(i,j), 1._r_std ) 
    357  
    358                 ENDIF 
    359  
    360              ENDDO 
    361  
    362           ENDIF  ! treat expansion? 
    363  
    364           ! 
    365           ! 4.2 establishment rate 
    366           !     - Is lower if the PFT is only present in a small part of the grid box 
    367           !       (after its introduction), therefore multiplied by "everywhere". 
    368           !     - Is divided by the number of PFTs that compete ("spacefight"). 
    369           !     - Is modulated by space availability (avail_tree, avail_grass). 
    370           ! 
    371  
    372           IF ( tree(j) ) THEN 
    373  
    374              ! 4.2.1 present and regenerative trees 
    375  
    376              WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) ) 
    377  
    378  
    379                 d_ind(:,j) = estab_rate_max_tree(:)*everywhere(:,j)/spacefight_tree(:) * & 
    380                      avail_tree(:) * dt/one_year 
    381  
    382              ENDWHERE 
    383  
    384           ELSE 
    385  
    386              ! 4.2.2 present and regenerative grasses 
    387  
    388              WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) ) 
    389  
    390                 d_ind(:,j) = estab_rate_max_grass(:)*everywhere(:,j)/spacefight_grass(:) * & 
    391                      avail_grass(:) * dt/one_year 
    392  
    393              ENDWHERE 
    394  
    395           ENDIF  ! tree/grass 
     407                ENDDO 
     408 
     409             ENDIF  ! treat expansion? 
     410 
     411             ! 
     412             ! 4.2 establishment rate 
     413             !     - Is lower if the PFT is only present in a small part of the grid box 
     414             !       (after its introduction), therefore multiplied by "everywhere". 
     415             !     - Is divided by the number of PFTs that compete ("spacefight"). 
     416             !     - Is modulated by space availability (avail_tree, avail_grass). 
     417             ! 
     418 
     419             IF ( tree(j) ) THEN 
     420 
     421                ! 4.2.1 present and regenerative trees 
     422 
     423                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) ) 
     424 
     425 
     426                   d_ind(:,j) = estab_rate_max_tree(:)*everywhere(:,j)/spacefight_tree(:) * & 
     427                        avail_tree(:) * dt/one_year 
     428 
     429                ENDWHERE 
     430 
     431             ELSE 
     432 
     433                ! 4.2.2 present and regenerative grasses 
     434 
     435                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit )  &  
     436                     .AND.factor(:).GT.min_stomate .AND. spacefight_grass(:).GT. min_stomate)  
     437 
     438                   d_ind(:,j) = estab_rate_max_grass(:)*everywhere(:,j)/spacefight_grass(:) * & 
     439                        MAX(min_stomate,npp_longterm(:,j)*lm_lastyearmax(:,j)*sla(j)/factor(:)) * fracnat(:) * dt/one_year 
     440 
     441                ENDWHERE 
     442 
     443             ENDIF  ! tree/grass 
     444 
     445          ENDIF ! if natural 
     446       ENDDO ! PFTs 
     447 
     448    ELSE ! lpj establishment in static case, SZ 080806, account for real LPJ dynamics in  
     449       ! prescribed vegetation, i.e. population dynamics within a given area of the  
     450       ! grid cell 
     451 
     452       d_ind(:,:) = 0.0 
     453 
     454       DO j = 2,nvm 
     455 
     456          ! only for natural PFTs 
     457 
     458          WHERE(ind(:,j)*cn_ind(:,j).GT.min_stomate) 
     459             lai_ind(:)=sla(j) * lm_lastyearmax(:,j)/(ind(:,j)*cn_ind(:,j)) 
     460          ELSEWHERE 
     461             lai_ind(:)=0.0 
     462          ENDWHERE 
     463 
     464          IF ( natural(j) .AND. tree(j)) THEN  
     465 
     466             fpc_nat(:,j) =  MIN(1.0,cn_ind(:,j) * ind(:,j) * &  
     467                  MAX( ( 1._r_std - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) ) 
     468             !fpc_nat(:,j) = max(fpc_nat(:,j),1.-exp(-0.5*sla(j) * lm_lastyearmax(:,j))) 
     469 
     470 
     471             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).LE.2.) 
     472 
     473                ! only establish into growing stands, ind can become very 
     474                ! large in the static mode because LAI is very low in poor  
     475                ! growing conditions, favouring continuous establishment. To avoid this 
     476                ! a maximum IND is set. BLARPP: This should be replaced by a  
     477                ! better stand density criteria 
     478                ! 
     479                factor(:)=(1.0-exp(-5.0*(1.0-fpc_nat(:,j))))*(1.0-fpc_nat(:,j)) 
     480 
     481                estab_rate_max_tree(:) = estab_max_tree * factor(:)  
     482                ! 
     483                ! 4 do establishment for natural PFTs 
     484                ! 
     485                d_ind(:,j) = MAX( 0.0, estab_rate_max_tree(:) * dt/one_year) 
     486 
     487             ENDWHERE 
     488 
     489             !SZ: quickfix: to simulate even aged stand, uncomment the following lines... 
     490             !where (ind(:,j) .LE. min_stomate) 
     491             !d_ind(:,j) = 0.1 !MAX( 0.0, estab_rate_max_tree(:) * dt/one_year) 
     492 
     493             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).EQ.0.0) 
     494                d_ind(:,j) = ind_0*10. 
     495                !          elsewhere 
     496                !d_ind(:,j) =0.0 
     497             endwhere 
     498 
     499          ELSEIF ( natural(j) .AND. .NOT.tree(j)) THEN  
     500 
     501             WHERE (veget_max(:,j).GT.min_stomate) 
     502 
     503                fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * &  
     504                     MAX( ( 1._r_std - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) 
     505 
     506                d_ind(:,j) = MAX(0.0 , (1.0-fpc_nat(:,j)) * dt/one_year ) 
     507 
     508             ENDWHERE 
     509 
     510             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).EQ.0.0) 
     511                d_ind(:,j) = ind_0*10. 
     512             ENDWHERE 
     513 
     514          ENDIF 
     515 
     516       ENDDO 
     517 
     518    ENDIF ! DGVM OR NOT 
     519 
     520    DO j = 2,nvm 
     521 
     522       ! only for natural PFTs 
     523 
     524       IF ( natural(j) ) THEN 
    396525 
    397526          ! 
    … …  
    409538          ! 
    410539          ! 4.4 be sure that ind*cn_ind does not exceed 1 
    411           ! 
    412  
    413           WHERE ( ( d_ind(:,j) .GT. zero ) .AND. & 
    414                ( (ind(:,j)+d_ind(:,j))*cn_ind(:,j) .GT. un ) ) 
    415  
    416              d_ind(:,j) = MAX( 1._r_std / cn_ind(:,j) - ind(:,j), 0._r_std ) 
    417  
    418           ENDWHERE 
     540          !SZ This control is now moved to lpj_cover.f90 
     541          !SZ 
     542 
     543          !The aim is to control for sum(veget)=1., irrespective of ind*cnd (crowns can overlap as long as 
     544          ! there is enough light 
     545          ! 
     546          !SZ: This could be part of the dynamic vegetation problem of Orchidee 
     547          !in conjunction with the wrong formulation of establishment response  
     548          !to tree fpc above... 
     549          !          WHERE ( ( d_ind(:,j) .GT. zero ) .AND. & 
     550          !                  ( (ind(:,j)+d_ind(:,j))*cn_ind(:,j) .GT. un ) ) 
     551          ! 
     552          !            d_ind(:,j) = MAX( 1._stnd / cn_ind(:,j) - ind(:,j), zero ) 
     553          ! 
     554          !          ENDWHERE 
    419555 
    420556          ! 
    … …  
    428564 
    429565          ! compare establishment rate and present number of inidivuals 
    430           many_new(:) = ( d_ind(:,j) .GT. 0.1 * ind(:,j) ) 
     566          !many_new(:) = ( d_ind(:,j) .GT. 0.1 * ind(:,j) ) 
    431567 
    432568          ! gives a better vectorization of the VPP 
    433569 
    434           IF ( ANY( many_new(:) ) ) THEN 
    435  
    436              DO k = 1, nparts 
    437  
    438                 WHERE ( many_new(:) ) 
    439  
    440                    bm_new(:) = d_ind(:,j) * bm_sapl(j,k) / veget_max (:,j) 
    441  
    442                    biomass(:,j,k) = biomass(:,j,k) + bm_new(:) 
    443  
    444                    !NV passage 2D 
    445                    co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:) / dt 
    446  
    447                 ENDWHERE 
    448  
     570          !IF ( ANY( many_new(:) ) ) THEN 
     571 
     572          ! save old leaf mass to calculate leaf age 
     573          leaf_mass_young(:) = leaf_frac(:,j,1) * biomass(:,j,ileaf) 
     574          ! total biomass of existing PFT to limit biomass added from establishment 
     575          total_bm_c(:) = zero 
     576 
     577          DO k = 1, nparts 
     578             total_bm_c(:)=total_bm_c(:)+biomass(:,j,k) 
     579          ENDDO 
     580          IF(control%ok_dgvm) THEN 
     581             vn(:)=veget_max(:,j) 
     582          ELSE 
     583             vn(:)=1.0 
     584          ENDIF 
     585          total_bm_sapl(:)=zero 
     586          DO k = 1, nparts 
     587             WHERE(d_ind(:,j).GT.min_stomate.AND.vn(:).GT.min_stomate) 
     588 
     589                total_bm_sapl(:) = total_bm_sapl(:) + &  
     590                     bm_sapl(j,k) * d_ind(:,j) / vn(:) 
     591             ENDWHERE 
     592          ENDDO 
     593 
     594          IF(control%ok_dgvm) THEN 
     595             ! SZ calculate new woodmass_ind and veget_max after establishment (needed for correct scaling!) 
     596             ! essential correction for MERGE! 
     597             IF(tree(j))THEN 
     598                DO i=1,npts 
     599                   IF((d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN 
     600 
     601                      IF((total_bm_c(i).LE.min_stomate) .OR. (veget_max(i,j) .LE. min_stomate)) THEN 
     602 
     603                         ! new wood mass of PFT 
     604                         woodmass_ind(i,j) = & 
     605                              & (((biomass(i,j,isapabove)+biomass(i,j,isapbelow) & 
     606                              & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow))*veget_max(i,j)) & 
     607                              & +(bm_sapl(j,isapabove)+bm_sapl(j,isapbelow) & 
     608                              & +bm_sapl(j,iheartabove)+bm_sapl(j,iheartbelow))*d_ind(i,j))/(ind(i,j)+d_ind(i,j)) 
     609 
     610                      ELSE  
     611                         ! new biomass is added to the labile pool, hence there is no change in CA associated with establishment 
     612                         woodmass_ind(i,j) = & 
     613                              & (biomass(i,j,isapabove)+biomass(i,j,isapbelow) & 
     614                              & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow))*veget_max(i,j) & 
     615                              & /(ind(i,j)+d_ind(i,j)) 
     616 
     617                      ENDIF 
     618 
     619                      ! new diameter of PFT 
     620                      dia(i) = (woodmass_ind(i,j)/(pipe_density*pi/4.*pipe_tune2)) & 
     621                           &                **(1./(2.+pipe_tune3)) 
     622                      vn(i)=(ind(i,j)+d_ind(i,j))*pipe_tune1*MIN(dia(i),maxdia(j))**1.6 
     623 
     624                   ENDIF 
     625                ENDDO 
     626             ELSE ! for grasses, cnd=1, so the above calculation cancels 
     627                vn(:)=ind(:,j)+d_ind(:,j) 
     628             ENDIF 
     629          ELSE ! static 
     630             DO i=1,npts 
     631                IF(tree(j).AND.(d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN 
     632                   IF(total_bm_c(i).LE.min_stomate) THEN 
     633 
     634                      ! new wood mass of PFT 
     635                      woodmass_ind(i,j) = & 
     636                           & (((biomass(i,j,isapabove)+biomass(i,j,isapbelow) & 
     637                           & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow))) & 
     638                           & +(bm_sapl(j,isapabove)+bm_sapl(j,isapbelow) & 
     639                           & +bm_sapl(j,iheartabove)+bm_sapl(j,iheartbelow))*d_ind(i,j))/(ind(i,j)+d_ind(i,j)) 
     640 
     641                   ELSE ! new biomass is added to the labile pool, hence there is no change in CA associated with establishment 
     642 
     643                      woodmass_ind(i,j) = & 
     644                           & (biomass(i,j,isapabove)+biomass(i,j,isapbelow) & 
     645                           & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow)) & 
     646                           & /(ind(i,j)+d_ind(i,j)) 
     647 
     648                   ENDIF 
     649                ENDIF 
    449650             ENDDO 
    450651 
    451              ! reset leaf ages. Should do a real calculation like in the npp routine,  
    452              ! but this case is rare and not worth messing around. 
    453  
    454              WHERE ( many_new(:) ) 
    455                 leaf_age(:,j,1) = zero 
    456                 leaf_frac(:,j,1) = un 
    457              ENDWHERE 
    458  
    459              DO m = 2, nleafages 
    460  
    461                 WHERE ( many_new(:) ) 
    462                    leaf_age(:,j,m) = zero 
    463                    leaf_frac(:,j,m) = zero 
    464                 ENDWHERE 
    465  
    466              ENDDO 
    467  
    468           ENDIF   ! establishment rate is large 
    469  
    470           WHERE ( d_ind(:,j) .GT. zero ) 
    471  
    472              ! 4.5.2 age decreases 
     652             vn(:)=1.0 ! cannot change in static!, and veget_max implicit in d_ind 
     653 
     654          ENDIF 
     655          ! total biomass of PFT added by establishment defined over veget_max ... 
     656          total_bm_sapl(:)=zero 
     657          DO k = 1, nparts 
     658             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate.AND.vn(:).GT.min_stomate) 
     659 
     660                total_bm_sapl(:) = total_bm_sapl(:) + &  
     661                     bm_sapl(j,k) * d_ind(:,j) / vn(:) 
     662             ENDWHERE 
     663          ENDDO 
     664 
     665          DO k = 1, nparts 
     666 
     667             bm_new(:)=zero 
     668 
     669             ! first ever establishment, C flows 
     670             WHERE( d_ind(:,j).GT.min_stomate .AND. & 
     671                  total_bm_c(:).LE.min_stomate .AND. & 
     672                  vn(:).GT.min_stomate) 
     673                ! WHERE ( many_new(:) ) 
     674 
     675                !bm_new(:) = d_ind(:,j) * bm_sapl(j,k) / veget_max (:,j) 
     676                bm_new(:) = d_ind(:,j) * bm_sapl(j,k) / vn(:) 
     677 
     678                biomass(:,j,k) = biomass(:,j,k) + bm_new(:) 
     679 
     680                co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:) / dt 
     681 
     682             ENDWHERE 
     683 
     684             ! establishment into existing population, C flows 
     685             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate) 
     686 
     687                bm_new(:) = total_bm_sapl(:) * biomass(:,j,k) / total_bm_c(:) 
     688 
     689                biomass(:,j,k) = biomass(:,j,k) + bm_new(:) 
     690                co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:) / dt 
     691 
     692             ENDWHERE 
     693          ENDDO 
     694 
     695          ! reset leaf ages. Should do a real calculation like in the npp routine,  
     696          ! but this case is rare and not worth messing around. 
     697          ! SZ 080806, added real calculation now, because otherwise leaf_age/leaf_frac 
     698          ! are not initialised for the calculation of vmax, and hence no growth at all. 
     699          ! logic follows that of stomate_npp.f90, just that it's been adjusted for the code here 
     700          ! 
     701          ! 4.5.2 Decrease leaf age in youngest class if new leaf biomass is higher than old one. 
     702          ! 
     703 
     704!!$          WHERE ( many_new(:) ) 
     705!!$             leaf_age(:,j,1) = zero 
     706!!$             leaf_frac(:,j,1) = un 
     707!!$          ENDWHERE 
     708!!$ 
     709!!$          DO m = 2, nleafages 
     710!!$ 
     711!!$             WHERE ( many_new(:) ) 
     712!!$                leaf_age(:,j,m) = zero 
     713!!$                leaf_frac(:,j,m) = zero 
     714!!$             ENDWHERE 
     715!!$ 
     716!!$          ENDDO 
     717 
     718          WHERE ( d_ind(:,j) * bm_sapl(j,ileaf) .GT. min_stomate )  
     719 
     720             leaf_age(:,j,1) = leaf_age(:,j,1) * leaf_mass_young(:) / & 
     721                  ( leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf) ) 
     722 
     723          ENDWHERE 
     724 
     725          leaf_mass_young(:) = leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf) 
     726 
     727          ! 
     728          ! new age class fractions (fraction in youngest class increases) 
     729          ! 
     730 
     731          ! youngest class: new mass in youngest class divided by total new mass 
     732 
     733          WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) 
     734 
     735             leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf) 
     736 
     737          ENDWHERE 
     738 
     739          ! other classes: old mass in leaf age class divided by new mass 
     740 
     741          DO m = 2, nleafages 
     742 
     743             WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) 
     744 
     745                leaf_frac(:,j,m) = leaf_frac(:,j,m) * &  
     746                     ( biomass(:,j,ileaf) + d_ind(:,j) * bm_sapl(j,ileaf) ) /  biomass(:,j,ileaf) 
     747 
     748             ENDWHERE 
     749 
     750          ENDDO 
     751 
     752          !ENDIF   ! establishment rate is large 
     753 
     754          WHERE ( d_ind(:,j) .GT. min_stomate ) 
     755 
     756             ! 4.5.3 age decreases 
    473757 
    474758             age(:,j) = age(:,j) * ind(:,j) / ( ind(:,j) + d_ind(:,j) ) 
    475759 
    476              ! 4.5.3 new number of individuals 
     760             ! 4.5.4 new number of individuals 
    477761 
    478762             ind(:,j) = ind(:,j) + d_ind(:,j) 
    … …  
    484768          ! 
    485769 
     770          !SZ to clarify with Gerhard Krinner: This is theoretically inconsistent because  
     771          ! the allocation to sapwood and leaves do not follow the LPJ logic in stomate_alloc.f90 
     772          ! hence imposing this here not only solves for the uneveness of age (mixing new and average individual) 
     773          ! but also corrects for the discrepancy between SLAVE and LPJ logic of allocation, thus leads to excess heartwood 
     774          ! and thus carbon accumulation! 
     775          ! should be removed. 
     776 
    486777          IF ( tree(j) ) THEN 
    487778 
    488              sm2(:) = zero 
    489  
    490              WHERE ( d_ind(:,j) .GT. zero )  
    491  
    492                 ! ratio of above / total sap parts 
    493                 sm_at(:) = biomass(:,j,isapabove) / & 
    494                      ( biomass(:,j,isapabove) + biomass(:,j,isapbelow) ) 
    495  
    496                 ! woodmass of an individual 
    497  
    498                 woodmass(:) = & 
    499                      ( biomass(:,j,isapabove) + biomass(:,j,isapbelow) + & 
    500                      biomass(:,j,iheartabove) + biomass(:,j,iheartbelow) ) / ind(:,j) 
    501  
    502                 ! crown area (m**2) depends on stem diameter (pipe model) 
    503                 dia(:) = ( woodmass(:) / ( pipe_density * pi/4. * pipe_tune2 ) ) & 
    504                      ** ( un / ( 2. + pipe_tune3 ) ) 
    505  
    506                 b1(:) = pipe_k1 / ( sla(j) * pipe_density*pipe_tune2 * dia(:)**pipe_tune3 ) * & 
    507                      ind(:,j) 
    508                 sm2(:) = lm_lastyearmax(:,j) / b1(:) 
    509  
    510              ENDWHERE 
    511  
    512              WHERE ( ( d_ind(:,j) .GT. zero ) .AND. & 
     779!!$             sm2(:) = 0.0 
     780!!$             WHERE ( d_ind(:,j) .GT. 0.0 )  
     781!!$ 
     782!!$                ! ratio of above / total sap parts 
     783!!$                sm_at(:) = biomass(:,j,isapabove) / & 
     784!!$                     ( biomass(:,j,isapabove) + biomass(:,j,isapbelow) ) 
     785!!$ 
     786!!$                ! woodmass of an individual 
     787!!$ 
     788!!$                woodmass(:) = & 
     789!!$                     ( biomass(:,j,isapabove) + biomass(:,j,isapbelow) + & 
     790!!$                     biomass(:,j,iheartabove) + biomass(:,j,iheartbelow) ) / ind(:,j) 
     791!!$ 
     792!!$                ! crown area (m**2) depends on stem diameter (pipe model) 
     793!!$                dia(:) = ( woodmass(:) / ( pipe_density * pi/4. * pipe_tune2 ) ) & 
     794!!$                     ** ( 1. / ( 2. + pipe_tune3 ) ) 
     795!!$ 
     796!!$                b1(:) = pipe_k1 / ( sla(j) * pipe_density*pipe_tune2 * dia(:)**pipe_tune3 ) * & 
     797!!$                     ind(:,j) 
     798!!$                sm2(:) = lm_lastyearmax(:,j) / b1(:) 
     799!!$ 
     800!!$             ENDWHERE 
     801 
     802             sm2(:)=biomass(:,j,isapabove) + biomass(:,j,isapbelow) 
     803 
     804             WHERE ( ( d_ind(:,j) .GT. min_stomate ) .AND. & 
    513805                  ( biomass(:,j,isapabove) + biomass(:,j,isapbelow) ) .GT. sm2(:) ) 
    514806 
    … …  
    536828 
    537829    CALL histwrite (hist_id_stomate, 'IND_ESTAB', itime, d_ind, npts*nvm, horipft_index) 
     830    CALL histwrite (hist_id_stomate, 'ESTABTREE', itime, estab_rate_max_tree, npts, hori_index) 
     831    CALL histwrite (hist_id_stomate, 'ESTABGRASS', itime, estab_rate_max_grass, npts, hori_index) 
    538832 
    539833    IF (bavard.GE.4) WRITE(numout,*) 'Leaving establish' 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_fire.f90

    r119 r405  
    421421       !       individuals. 
    422422 
    423        IF ( control%ok_dgvm .AND. tree(j) ) THEN 
     423       IF ( (control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) .AND. tree(j) ) THEN 
    424424 
    425425          ! fraction of plants that dies each day. 
    … …  
    472472       !       into CO2) 
    473473 
    474        residue(:) = litter(:,istructural,j,iabove) * firefrac(:,j) * & 
    475             struc_residual(:) 
    476        !MM in SZ        residue(:) = firefrac(:,j) * struc_residual(:) 
     474!NV,MM : We add this test to keep coherence with CMIP5 computations without DGVM. 
     475!        It has to be removed in trunk version after CMIP5. 
     476       IF (control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN 
     477          residue(:) = firefrac(:,j) * struc_residual(:) 
     478       ELSE 
     479          residue(:) = litter(:,istructural,j,iabove) * firefrac(:,j) * & 
     480               struc_residual(:) 
     481       ENDIF 
    477482 
    478483       ! 5.2.4 determine fraction of black carbon in the residue. 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_gap.f90

    r119 r405  
    3838  SUBROUTINE gap (npts, dt, & 
    3939       npp_longterm, turnover_longterm, lm_lastyearmax, & 
    40        PFTpresent, biomass, ind, bm_to_litter) 
     40       PFTpresent, biomass, ind, bm_to_litter, mortality) 
    4141 
    4242    ! 
    … …  
    6767    ! biomass taken away (gC/(m**2 of ground)) 
    6868    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)  :: bm_to_litter 
     69    ! mortality (fraction of trees that is dying per time step), per day in history file 
     70    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)             :: mortality 
    6971 
    7072    ! 0.3 local 
    7173 
    72     ! which kind of mortality 
    73     LOGICAL, SAVE                                           :: constant_mortality 
    7474    ! biomass increase 
    7575    REAL(r_std), DIMENSION(npts)                             :: delta_biomass 
     76    ! biomass increase 
     77    REAL(r_std), DIMENSION(npts)                             :: dmortality 
    7678    ! vigour 
    7779    REAL(r_std), DIMENSION(npts)                             :: vigour 
    7880    ! natural availability, based on vigour 
    7981    REAL(r_std), DIMENSION(npts)                             :: availability 
    80     ! mortality (fraction of trees that is dying per time step), per day in history file 
    81     REAL(r_std), DIMENSION(npts,nvm)                        :: mortality 
    8282    ! indices 
    83     INTEGER(i_std)                                           :: j,k 
     83    INTEGER(i_std)                                           :: j,k,m 
     84    REAL(r_std) :: ref_greff 
    8485 
    8586    ! ========================================================================= 
    … …  
    8990       firstcall = .FALSE. 
    9091 
    91        !Config  Key  = LPJ_GAP_CONST_MORT 
    92        !Config  Desc = constant tree mortality 
    93        !Config  Def  = y 
    94        !Config  Help = If yes, then a constant mortality is applied to trees.  
    95        !Config         Otherwise, mortality is a function of the trees'  
    96        !Config         vigour (as in LPJ). 
    97  
    98        constant_mortality = .TRUE. 
    99        CALL getin_p('LPJ_GAP_CONST_MORT', constant_mortality)      
    100        WRITE(numout,*) 'gap: constant mortality:', constant_mortality 
    101  
    10292    ENDIF 
    10393 
    104     IF (bavard.GE.3) WRITE(numout,*) 'Entering gap' 
     94    IF (bavard.GE.3) WRITE(numout,*) 'Entering gap',lpj_gap_const_mort 
    10595 
    10696    mortality(:,:) = zero 
    10797 
     98    ref_greff =  0.035 
     99 
    108100    DO j = 2,nvm 
    109101 
    … …  
    116108          ! 
    117109 
    118           IF ( .NOT. constant_mortality ) THEN 
     110          IF ( .NOT.  lpj_gap_const_mort ) THEN 
    119111 
    120112             ! 
    … …  
    124116             WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) ) 
    125117 
     118!SZ 080806, changed to LPJ formulation according to Smith et al., 2001  
     119 
    126120                ! how much did the tree grow per year? 
    127121 
    128                 delta_biomass(:) = & 
    129                      MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + & 
    130                      turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) ), & 
    131                      0._r_std ) 
     122!!$                delta_biomass(:) = & 
     123!!$                     MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + & 
     124!!$                     turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) ), & 
     125!!$                     0._r_std ) 
     126 
     127            ! note that npp_longterm is now actually longterm growth efficiency (NPP/LAI) 
     128            ! to be fair to deciduous trees 
     129             delta_biomass(:) = MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + & 
     130                  turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) + &  
     131                  turnover_longterm(:,j,isapabove) + turnover_longterm(:,j,isapbelow) ) ,zero) 
    132132 
    133133                ! scale this to the leaf surface of the tree 
    134  
    135                 vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j)) / 70. 
     134!!$                vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j)) / 70. 
     135             vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j)) 
    136136 
    137137             ELSEWHERE 
    … …  
    146146                ! low vigour. 
    147147 
    148                 availability(:) = 0.02 / ( 1.+vigour(:)/0.17 ) 
     148!SZ 080806, changed to LPJ formulation according to Smith et al., 2001  
     149! tuned maximal mortality to 0.05 to get realistic range of avergage age to get ~100 years at GREFF=100 
     150! for the range of modelled annual NPP 
     151!!$                availability(:) = min_avail / ( 1.+vigour(:)/0.17 ) 
     152                availability(:) = 0.1 / ( 1.+ref_greff*vigour(:) ) 
    149153 
    150154                ! Mortality (fraction per time step). 
    … …  
    157161                ! approximation ok as availability < 0.02 << 1 
    158162 
    159                 mortality(:,j) = availability(:) * dt/one_year 
    160  
     163                mortality(:,j) = MAX(min_avail,availability(:))  * dt/one_year   
     164!!$                mortality(:,j) = availability(:) * dt/one_year 
     165                 
    161166             ENDWHERE 
    162167 
    … …  
    198203             WHERE ( PFTpresent(:,j) ) 
    199204 
    200                 bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + mortality(:,j) * biomass(:,j,k) 
    201  
    202                 biomass(:,j,k) = biomass(:,j,k) * ( un - mortality(:,j) ) 
     205                dmortality(:) =  mortality(:,j) * biomass(:,j,k) 
     206                bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + dmortality(:) 
     207                 
     208                biomass(:,j,k) = biomass(:,j,k) - dmortality(:) 
    203209 
    204210             ENDWHERE 
    … …  
    210216          ! 
    211217 
    212           IF ( control%ok_dgvm ) THEN 
     218!SZ 080806, allow changing density in static case when mortality is dynamic 
     219          IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN 
    213220 
    214221             WHERE ( PFTpresent(:,j) ) 
    … …  
    219226 
    220227          ENDIF 
    221  
     228       ELSE  
     229 
     230          IF ( .NOT.control%ok_dgvm .AND. .NOT.lpj_gap_const_mort) THEN 
     231 
     232             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. 10. ) ) 
     233 
     234                mortality(:,j) = 1. 
     235 
     236             ENDWHERE 
     237             DO k = 1, nparts 
     238 
     239                WHERE ( PFTpresent(:,j) ) 
     240 
     241                   dmortality(:) =  mortality(:,j) * biomass(:,j,k) 
     242                    
     243                   bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + dmortality(:) 
     244                    
     245                   biomass(:,j,k) = biomass(:,j,k) - dmortality(:) 
     246 
     247                ENDWHERE 
     248             ENDDO 
     249              
     250          ENDIF 
     251           
    222252       ENDIF       ! only trees 
    223253 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_kill.f90

    r119 r405  
    2424  SUBROUTINE kill (npts, whichroutine, lm_lastyearmax, & 
    2525       ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, & 
    26        lai, age, leaf_age, leaf_frac, & 
     26       lai, age, leaf_age, leaf_frac, npp_longterm, & 
    2727       when_growthinit, everywhere, veget, veget_max, bm_to_litter) 
    2828 
    … …  
    7171    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground 
    7272    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max 
     73    ! "long term" net primary productivity (gC/(m**2 of ground)/year) 
     74    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm  
    7375    ! conversion of biomass to litter (gC/(m**2 of ground)) / day 
    7476    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)    :: bm_to_litter 
    … …  
    9799          ! the "was_killed" business is necessary for a more efficient code on the VPP 
    98100 
    99           WHERE ( PFTpresent(:,j) .AND. & 
    100                ( ( ind(:,j) .LT. min_stomate ) .OR. & 
    101                ( lm_lastyearmax(:,j) .LT. min_stomate ) ) ) 
    102  
    103              was_killed(:) = .TRUE. 
    104  
    105           ENDWHERE 
     101          IF ( control%ok_dgvm ) THEN 
     102             WHERE ( PFTpresent(:,j) .AND. & 
     103                  ( ( ind(:,j) .LT. min_stomate ) .OR. & 
     104                  ( lm_lastyearmax(:,j) .LT. min_stomate ) ) ) 
     105 
     106                was_killed(:) = .TRUE. 
     107 
     108             ENDWHERE 
     109 
     110          ELSE 
     111             WHERE ( PFTpresent(:,j) .AND. &  
     112                  (biomass(:,j,icarbres) .LE.zero .OR. &  
     113                  biomass(:,j,iroot).LT.-min_stomate .OR. biomass(:,j,ileaf).LT.-min_stomate ).AND. &  
     114                  ind(:,j).GT. zero) 
     115 
     116                was_killed(:) = .TRUE. 
     117 
     118             ENDWHERE 
     119 
     120             IF(.NOT.tree(j).AND..NOT.lpj_gap_const_mort)THEN 
     121                WHERE ( was_killed(:) ) 
     122 
     123                   npp_longterm(:,j)=500. 
     124 
     125                ENDWHERE 
     126             ENDIF 
     127 
     128          ENDIF 
    106129 
    107130          IF ( ANY( was_killed(:) ) ) THEN 
    108131 
    109132             WHERE ( was_killed(:) ) 
    110  
    111                 ind(:,j) = zero 
    112133 
    113134                bm_to_litter(:,j,ileaf) = bm_to_litter(:,j,ileaf) + biomass(:,j,ileaf) 
    … …  
    131152                biomass(:,j,icarbres) = zero 
    132153 
    133                 PFTpresent(:,j) = .FALSE. 
     154             ENDWHERE   ! number of individuals very low 
     155 
     156             IF (control%ok_dgvm) THEN 
     157 
     158                WHERE ( was_killed(:) ) 
     159                   PFTpresent(:,j) = .FALSE. 
     160 
     161                   veget_max(:,j) = zero 
     162                    
     163                   RIP_time(:,j) = zero 
     164 
     165                ENDWHERE  ! number of individuals very low 
     166 
     167             ENDIF 
     168 
     169             WHERE ( was_killed(:) ) 
     170 
     171                ind(:,j) = zero 
    134172 
    135173                cn_ind(:,j) = zero 
    … …  
    140178                age(:,j) = zero 
    141179 
    142                 when_growthinit(:,j) = undef 
     180                ! SZ: why undef ??? this causes a delay in reestablishment 
     181                !when_growthinit(:,j) = undef 
     182                when_growthinit(:,j) = large_value  
    143183 
    144184                everywhere(:,j) = zero 
    145185 
    146186                veget(:,j) = zero 
    147  
    148                 veget_max(:,j) = zero 
    149  
    150                 RIP_time(:,j) = zero 
    151187 
    152188             ENDWHERE   ! number of individuals very low 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_light.f90

    r119 r405  
    1414! Exclude agricultural pfts from competition 
    1515! 
     16! SZ: added light competition for the static case if the mortality is not  
     17!     assumed to be constant. 
     18! other modifs: 
     19! -1      FPC is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is  
     20!         to represent community ecology effects; seasonal variations in establishment related to phenology 
     21!         may be relevant, but beyond the scope of a 1st generation DGVM  
     22! -2      problem, if agriculture is present, fpc can never reach 1.0 since natural veget_max < 1.0. To 
     23!         correct for this, ind must be recalculated to correspond to the natural density... 
     24!         since ind is 1/m2 grid cell, this can be achived by dividing ind by the agricultural fraction 
     25 
     26! 
    1627! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_light.f90,v 1.8 2009/01/06 15:01:25 ssipsl Exp $ 
    1728! IPSL (2006) 
    … …  
    4354 
    4455  SUBROUTINE light (npts, dt, & 
    45        PFTpresent, cn_ind, lai, maxfpc_lastyear, & 
    46        ind, biomass, veget_lastlight, bm_to_litter) 
     56       veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, & 
     57       lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality) 
    4758 
    4859    ! 
    … …  
    6475    ! last year's maximum fpc for each natural PFT, on ground 
    6576    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: maxfpc_lastyear 
     77    ! last year's maximum leafmass for each natural PFT, on ground 
     78    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: lm_lastyearmax 
     79    ! last year's maximum fpc for each natural PFT, on ground 
     80    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: veget_max 
     81    ! last year's maximum fpc for each natural PFT, on ground 
     82    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: fpc_max 
    6683 
    6784    ! 0.2 modified fields 
    … …  
    7592    ! biomass taken away (gC/m**2) 
    7693    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)   :: bm_to_litter 
     94    ! fraction of individuals that died this time step 
     95    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)          :: mortality 
    7796 
    7897    ! 0.3 local 
    … …  
    86105    LOGICAL, PARAMETER                                       :: annual_increase = .TRUE. 
    87106    ! index 
    88     INTEGER(i_std)                                            :: i,j 
     107    INTEGER(i_std)                                            :: i,j,k,m 
    89108    ! total natural fpc 
    90109    REAL(r_std), DIMENSION(npts)                              :: sumfpc 
     110    ! fraction of natural vegetation at grid cell level 
     111    REAL(r_std), DIMENSION(npts)                              :: fracnat 
    91112    ! total natural woody fpc 
    92113    REAL(r_std)                                               :: sumfpc_wood 
    … …  
    107128    ! Fraction of plants that survive 
    108129    REAL(r_std), DIMENSION(nvm)                              :: survive 
     130    ! FPC for static mode 
     131    REAL(r_std), DIMENSION(npts)                              :: fpc_real 
     132    ! FPC mortality for static mode 
     133    REAL(r_std), DIMENSION(npts)                              :: lai_ind 
    109134    ! number of grass PFTs present in the grid box 
    110     INTEGER(i_std)                                            :: num_grass 
     135    !    INTEGER(i_std)                                            :: num_grass 
    111136    ! New total grass fpc 
    112137    REAL(r_std)                                               :: sumfpc_grass2 
    113138    ! fraction of plants that dies each day (1/day) 
    114139    REAL(r_std), DIMENSION(npts,nvm)                         :: light_death 
     140    ! Relative change of number of individuals for trees 
     141    REAL(r_std)                                               :: fpc_dec 
    115142 
    116143    ! ========================================================================= 
    … …  
    146173    ENDIF 
    147174 
    148     ! 
    149     ! 2 fpc characteristics 
    150     ! 
    151  
    152     ! 
    153     ! 2.1 calculate fpc on natural part of grid cell. 
    154     ! 
    155  
    156     DO j = 2, nvm 
    157  
    158        IF ( natural(j) ) THEN 
    159  
    160           ! 2.1.1 natural PFTs 
    161  
    162           IF ( tree(j) ) THEN 
    163  
    164              ! 2.1.1.1 trees: minimum cover due to stems, branches etc. 
    165  
    166              DO i = 1, npts 
    167                 IF (lai(i,j) == val_exp) THEN 
    168                    fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 
    169                 ELSE 
    170                    fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 
    171                         MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 
    172                 ENDIF 
    173              ENDDO 
     175    IF (control%ok_dgvm) THEN 
     176       ! 
     177       ! 2 fpc characteristics 
     178       ! 
     179 
     180       ! 2.0 Only natural part of the grid cell: 
     181       ! calculate fraction of natural and agricultural (1-fracnat) surface 
     182 
     183       fracnat(:) = 1. 
     184       DO j = 2,nvm 
     185          IF ( .NOT. natural(j) ) THEN 
     186             fracnat(:) = fracnat(:) - veget_max(:,j) 
     187          ENDIF 
     188       ENDDO 
     189       ! 
     190       ! 2.1 calculate fpc on natural part of grid cell. 
     191       ! 
     192       fpc_nat(:,:)=zero 
     193       fpc_nat(:,ibare_sechiba)=un 
     194 
     195       DO j = 2, nvm 
     196 
     197          IF ( natural(j) ) THEN 
     198 
     199             ! 2.1.1 natural PFTs 
     200 
     201             IF ( tree(j) ) THEN 
     202 
     203                ! 2.1.1.1 trees: minimum cover due to stems, branches etc. 
     204 
     205                !          DO i = 1, npts 
     206                !             IF (lai(i,j) == val_exp) THEN 
     207                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 
     208                !             ELSE 
     209                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 
     210                !                     MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 
     211                !             ENDIF 
     212                !          ENDDO 
     213 
     214                !NV : modif from SZ version : fpc is based on veget_max, not veget. 
     215                WHERE(fracnat(:).GE.min_stomate) 
     216                   !            WHERE(LAI(:,j) == val_exp) 
     217                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 
     218                   !            ELSEWHERE 
     219                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * & 
     220                   !                    MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover ) 
     221                   !            ENDWHERE 
     222                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 
     223                ENDWHERE 
     224 
     225             ELSE 
     226 
     227                !NV : modif from SZ version : fpc is based on veget_max, not veget. 
     228                WHERE(fracnat(:).GE.min_stomate) 
     229                   !            WHERE(LAI(:,j) == val_exp) 
     230                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 
     231                   !            ELSEWHERE 
     232                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * & 
     233                   !                    ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ) 
     234                   !            ENDWHERE 
     235                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 
     236                ENDWHERE 
     237 
     238!!$                ! 2.1.1.2 bare ground  
     239!!$                IF (j == ibare_sechiba) THEN 
     240!!$                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j)  
     241!!$ 
     242!!$                   ! 2.1.1.3 grasses 
     243!!$                ELSE 
     244!!$                   DO i = 1, npts 
     245!!$                      IF (lai(i,j) == val_exp) THEN 
     246!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 
     247!!$                      ELSE 
     248!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 
     249!!$                              ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ) 
     250!!$                      ENDIF 
     251!!$                   ENDDO 
     252!!$                ENDIF 
     253 
     254             ENDIF  ! tree/grass 
    174255 
    175256          ELSE 
    176257 
    177              ! 2.1.1.2 bare ground  
    178              IF (j == ibare_sechiba) THEN 
    179                 fpc_nat(:,j) = cn_ind(:,j) * ind(:,j)  
    180  
    181                 ! 2.1.1.3 grasses 
     258             ! 2.1.2 agricultural PFTs: not present on natural part 
     259 
     260             fpc_nat(:,j) = zero 
     261 
     262          ENDIF    ! natural/agricultural 
     263 
     264       ENDDO 
     265 
     266       ! 
     267       ! 2.2 sum natural fpc for every grid point 
     268       ! 
     269 
     270       sumfpc(:) = zero 
     271       DO j = 2,nvm 
     272          !SZ bug correction MERGE: need to subtract agricultural area! 
     273          sumfpc(:) = sumfpc(:) + fpc_nat(:,j) 
     274       ENDDO 
     275 
     276       ! 
     277       ! 3 Light competition 
     278       ! 
     279 
     280       light_death(:,:) = zero 
     281 
     282       DO i = 1, npts ! SZ why this loop and not a vector statement ? 
     283 
     284          ! Only if vegetation cover is dense 
     285 
     286          IF ( sumfpc(i) .GT. fpc_crit ) THEN 
     287 
     288             ! fpc change for each pft 
     289             ! There are two possibilities: either we compare today's fpc with the fpc after the last 
     290             ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case, 
     291             ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season. 
     292             ! As for trees, the cutback is proportional to this increase, this means that seasonal trees 
     293             ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its  
     294             ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.) 
     295 
     296             IF ( annual_increase ) THEN 
     297                deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), 0._r_std ) 
    182298             ELSE 
    183                 DO i = 1, npts 
    184                    IF (lai(i,j) == val_exp) THEN 
    185                       fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 
     299                deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), 0._r_std ) 
     300             ENDIF 
     301 
     302             ! default: survive 
     303 
     304             survive(:) = 1.0 
     305 
     306             ! 
     307             ! 3.1 determine some characteristics of the fpc distribution 
     308             ! 
     309 
     310             sumfpc_wood = zero 
     311             sumdelta_fpc_wood = zero 
     312             maxfpc_wood = zero 
     313             optpft_wood = 0 
     314             sumfpc_grass = zero 
     315             !        num_grass = 0 
     316 
     317             DO j = 2,nvm 
     318 
     319                ! only natural pfts 
     320 
     321                IF ( natural(j) ) THEN 
     322 
     323                   IF ( tree(j) ) THEN 
     324 
     325                      ! trees 
     326 
     327                      ! total woody fpc 
     328 
     329                      sumfpc_wood = sumfpc_wood + fpc_nat(i,j) 
     330 
     331                      ! how much did the woody fpc increase 
     332 
     333                      sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j) 
     334 
     335                      ! which woody pft is preponderant 
     336 
     337                      IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN 
     338 
     339                         optpft_wood = j 
     340 
     341                         maxfpc_wood = fpc_nat(i,j) 
     342 
     343                      ENDIF 
     344 
    186345                   ELSE 
    187                       fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 
    188                            ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ) 
    189                    ENDIF 
    190                 ENDDO 
    191              ENDIF 
    192           ENDIF  ! tree/grass 
    193  
    194        ELSE 
    195  
    196           ! 2.1.2 agricultural PFTs: not present on natural part 
    197  
    198           fpc_nat(:,j) = zero 
    199  
    200        ENDIF    ! natural/agricultural 
    201  
    202     ENDDO 
    203  
    204     ! 
    205     ! 2.2 sum natural fpc for every grid point 
    206     ! 
    207  
    208     sumfpc(:) = zero 
    209     DO j = 2,nvm 
    210        !SZ bug correction MERGE: need to subtract agricultural area! 
    211        sumfpc(:) = sumfpc(:) + fpc_nat(:,j) 
    212     ENDDO 
    213  
    214     ! 
    215     ! 3 Light competition 
    216     ! 
    217  
    218     light_death(:,:) = zero 
    219  
    220     DO i = 1, npts ! SZ why this loop and not a vector statement ? 
    221  
    222        ! Only if vegetation cover is dense 
    223  
    224        IF ( sumfpc(i) .GT. fpc_crit ) THEN 
    225  
    226           ! fpc change for each pft 
    227           ! There are two possibilities: either we compare today's fpc with the fpc after the last 
    228           ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case, 
    229           ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season. 
    230           ! As for trees, the cutback is proportional to this increase, this means that seasonal trees 
    231           ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its  
    232           ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.) 
    233  
    234           IF ( annual_increase ) THEN 
    235              deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), 0._r_std ) 
    236           ELSE 
    237              deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), 0._r_std ) 
    238           ENDIF 
    239  
    240           ! default: survive 
    241  
    242           survive(:) = 1.0 
    243  
    244           ! 
    245           ! 3.1 determine some characteristics of the fpc distribution 
    246           ! 
    247  
    248           sumfpc_wood = zero 
    249           sumdelta_fpc_wood = zero 
    250           maxfpc_wood = zero 
    251           optpft_wood = 0 
    252           sumfpc_grass = zero 
    253           num_grass = 0 
    254  
    255           DO j = 2,nvm 
    256  
    257              ! only natural pfts 
    258  
    259              IF ( natural(j) ) THEN 
    260  
    261                 IF ( tree(j) ) THEN 
    262  
    263                    ! trees 
    264  
    265                    ! total woody fpc 
    266  
    267                    sumfpc_wood = sumfpc_wood + fpc_nat(i,j) 
    268  
    269                    ! how much did the woody fpc increase 
    270  
    271                    sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j) 
    272  
    273                    ! which woody pft is preponderant 
    274  
    275                    IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN 
    276  
    277                       optpft_wood = j 
    278  
    279                       maxfpc_wood = fpc_nat(i,j) 
    280  
    281                    ENDIF 
    282  
    283                 ELSE 
    284  
    285                    ! grasses 
    286  
    287                    ! total (natural) grass fpc 
    288  
    289                    sumfpc_grass = sumfpc_grass + fpc_nat(i,j) 
    290  
    291                    ! number of grass PFTs present in the grid box 
    292  
    293                    IF ( PFTpresent(i,j) ) THEN 
    294                       num_grass = num_grass + 1 
    295                    ENDIF 
    296  
    297                 ENDIF   ! tree or grass 
    298  
    299              ENDIF   ! natural 
    300  
    301           ENDDO     ! loop over pfts 
    302  
    303           ! 
    304           ! 3.2 light competition: assume wood outcompetes grass 
    305           ! 
    306  
    307           IF (sumfpc_wood .GE. fpc_crit ) THEN 
     346 
     347                      ! grasses 
     348 
     349                      ! total (natural) grass fpc 
     350 
     351                      sumfpc_grass = sumfpc_grass + fpc_nat(i,j) 
     352 
     353                      ! number of grass PFTs present in the grid box 
     354 
     355                      ! IF ( PFTpresent(i,j) ) THEN 
     356                      !    num_grass = num_grass + 1 
     357                      ! ENDIF 
     358 
     359                   ENDIF   ! tree or grass 
     360 
     361                ENDIF   ! natural 
     362 
     363             ENDDO     ! loop over pfts 
     364 
     365             ! 
     366             ! 3.2 light competition: assume wood outcompetes grass 
     367             ! 
     368             !SZ 
     369!!$             IF (sumfpc_wood .GE. fpc_crit ) THEN 
    308370 
    309371             ! 
    … …  
    326388                      ! 
    327389 
    328                       IF ( maxfpc_wood .GE. fpc_crit ) THEN 
    329  
    330                          ! 3.2.1.1.1 one single woody pft is overwhelming 
    331  
    332                          IF ( j .eq. optpft_wood ) THEN 
    333  
    334                             ! reduction for this dominant pft 
    335  
    336                             reduct = un - fpc_crit / fpc_nat(i,j) 
    337  
    338                          ELSE 
    339  
    340                             ! strongly reduce all other woody pfts 
    341                             !   (original DGVM: tree_mercy = 0.0 ) 
    342  
    343                             reduct = un - tree_mercy 
    344  
    345                          ENDIF   ! pft = dominant woody pft 
     390                      ! no single woody pft is overwhelming 
     391                      ! (original DGVM: tree_mercy = 0.0 ) 
     392                      ! The reduction rate is proportional to the ratio deltafpc/fpc. 
     393 
     394                      IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. &  
     395                           sumdelta_fpc_wood .GT. min_stomate) THEN 
     396 
     397                         ! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * & 
     398                         !     (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), & 
     399                         !     ( 1._r_std - tree_mercy ) ) 
     400                         reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) &  
     401                              * deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un ) 
    346402 
    347403                      ELSE 
    348404 
    349                          ! 3.2.1.1.2 no single woody pft is overwhelming 
    350                          !           (original DGVM: tree_mercy = 0.0 ) 
    351                          !           The reduction rate is proportional to the ratio deltafpc/fpc. 
    352  
    353                          IF ( fpc_nat(i,j) .GE. min_stomate ) THEN 
    354  
    355                             reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * & 
    356                                  (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), & 
    357                                  ( 1._r_std - tree_mercy ) ) 
    358  
    359                          ELSE 
    360  
    361                             ! tree fpc didn't icrease or it started from nothing 
    362  
    363                             reduct = zero 
    364  
    365                          ENDIF 
    366  
    367                       ENDIF   ! maxfpc_wood > fpc_crit 
     405                         ! tree fpc didn't icrease or it started from nothing 
     406 
     407                         reduct = zero 
     408 
     409                      ENDIF 
    368410 
    369411                      survive(j) = un - reduct 
    … …  
    379421                      ! 
    380422 
    381                       survive(j) = ( grass_mercy / REAL( num_grass,r_std ) ) / ind(i,j) 
    382  
    383                       survive(j) = MIN( 1._r_std, survive(j) ) 
    384  
     423                      ! survive(j) = ( grass_mercy / REAL( num_grass,r_std ) ) / ind(i,j) 
     424 
     425                      ! survive(j) = MIN( 1._r_std, survive(j) ) 
     426 
     427                      IF(sumfpc_grass .GE. 1.0-MIN(fpc_crit,sumfpc_wood).AND. &  
     428                           sumfpc_grass.GE.min_stomate) THEN 
     429 
     430                         fpc_dec=(sumfpc_grass-1.+MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass 
     431 
     432                         reduct=fpc_dec 
     433                      ELSE  
     434                         reduct = zero 
     435                      ENDIF 
     436                      survive(j) = ( un -  reduct )  
    385437                   ENDIF   ! tree or grass 
    386438 
    … …  
    389441             ENDDO       ! loop over pfts 
    390442 
     443             !SZ 
     444!!$          ELSE 
     445!!$ 
     446!!$             ! 
     447!!$             ! 3.2.2 not too much wood so that grasses can subsist 
     448!!$             ! 
     449!!$ 
     450!!$             ! new total grass fpc 
     451!!$             sumfpc_grass2 = fpc_crit - sumfpc_wood 
     452!!$ 
     453!!$             DO j = 2,nvm 
     454!!$ 
     455!!$                ! only present and natural PFTs compete 
     456!!$ 
     457!!$                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 
     458!!$ 
     459!!$                   IF ( tree(j) ) THEN 
     460!!$ 
     461!!$                      ! no change for trees 
     462!!$ 
     463!!$                      survive(j) = 1.0 
     464!!$ 
     465!!$                   ELSE 
     466!!$ 
     467!!$                      ! grass: fractional loss is the same for all grasses 
     468!!$ 
     469!!$                      IF ( sumfpc_grass .GT. min_stomate ) THEN 
     470!!$                         survive(j) = sumfpc_grass2 / sumfpc_grass 
     471!!$                      ELSE 
     472!!$                         survive(j)=  zero 
     473!!$                      ENDIF 
     474!!$ 
     475!!$                   ENDIF 
     476!!$ 
     477!!$                ENDIF    ! pft there and natural 
     478!!$ 
     479!!$             ENDDO       ! loop over pfts 
     480!!$ 
     481!!$          ENDIF    ! sumfpc_wood > fpc_crit 
     482 
     483             ! 
     484             ! 3.3 update output variables 
     485             ! 
     486 
     487             DO j = 2,nvm 
     488 
     489                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 
     490 
     491                   bm_to_litter(i,j,:) = bm_to_litter(i,j,:) + & 
     492                        biomass(i,j,:) * ( un - survive(j) ) 
     493 
     494                   biomass(i,j,:) = biomass(i,j,:) * survive(j) 
     495 
     496                   IF ( control%ok_dgvm ) THEN 
     497                      ind(i,j) = ind(i,j) * survive(j) 
     498                   ENDIF 
     499 
     500                   ! fraction of plants that dies each day.  
     501                   ! exact formulation: light_death(i,j) = un - survive(j) / dt 
     502                   light_death(i,j) = ( un - survive(j) ) / dt 
     503 
     504                ENDIF      ! pft there and natural 
     505 
     506             ENDDO        ! loop over pfts 
     507 
     508          ENDIF      ! sumfpc > fpc_crit 
     509 
     510       ENDDO        ! loop over grid points 
     511 
     512       ! 
     513       ! 4 recalculate fpc on natural part of grid cell (for next light competition) 
     514       ! 
     515 
     516       DO j = 2,nvm 
     517 
     518          IF ( natural(j) ) THEN 
     519 
     520             ! 
     521             ! 4.1 natural PFTs 
     522             ! 
     523 
     524             IF ( tree(j) ) THEN 
     525 
     526                ! 4.1.1 trees: minimum cover due to stems, branches etc. 
     527 
     528                DO i = 1, npts 
     529                   !NVMODIF          
     530                   !    IF (lai(i,j) == val_exp) THEN 
     531                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
     532                   !             ELSE 
     533                   !                veget_lastlight(i,j) = & 
     534                   !                     cn_ind(i,j) * ind(i,j) * & 
     535                   !                     MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 
     536                   !             ENDIF 
     537                   !!                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
     538                   IF (lai(i,j) == val_exp) THEN 
     539                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
     540                   ELSE 
     541                      veget_lastlight(i,j) = & 
     542                           cn_ind(i,j) * ind(i,j) * & 
     543                           MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover ) 
     544                   ENDIF 
     545                ENDDO 
     546 
     547             ELSE 
     548 
     549                ! 4.1.2 grasses 
     550                DO i = 1, npts 
     551                   !NVMODIF          
     552                   !            IF (lai(i,j) == val_exp) THEN 
     553                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
     554                   !             ELSE 
     555                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & 
     556                   !                     ( un - exp( -lai(i,j) * ext_coeff(j) ) ) 
     557                   !             ENDIF 
     558                   !!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
     559                   IF (lai(i,j) == val_exp) THEN 
     560                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
     561                   ELSE 
     562                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & 
     563                           ( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ) 
     564                   ENDIF 
     565                ENDDO 
     566             ENDIF    ! tree/grass 
     567 
    391568          ELSE 
    392569 
    393570             ! 
    394              ! 3.2.2 not too much wood so that grasses can subsist 
    395              ! 
    396  
    397              ! new total grass fpc 
    398              sumfpc_grass2 = fpc_crit - sumfpc_wood 
    399  
    400              DO j = 2,nvm 
    401  
    402                 ! only present and natural PFTs compete 
    403  
    404                 IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 
    405  
    406                    IF ( tree(j) ) THEN 
    407  
    408                       ! no change for trees 
    409  
    410                       survive(j) = 1.0 
    411  
    412                    ELSE 
    413  
    414                       ! grass: fractional loss is the same for all grasses 
    415  
    416                       IF ( sumfpc_grass .GT. min_stomate ) THEN 
    417                          survive(j) = sumfpc_grass2 / sumfpc_grass 
    418                       ELSE 
    419                          survive(j)=  zero 
    420                       ENDIF 
    421  
    422                    ENDIF 
    423  
    424                 ENDIF    ! pft there and natural 
    425  
    426              ENDDO       ! loop over pfts 
    427  
    428           ENDIF    ! sumfpc_wood > fpc_crit 
    429  
    430           ! 
    431           ! 3.3 update output variables 
    432           ! 
    433  
    434           DO j = 2,nvm 
    435  
    436              IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 
    437  
    438                 bm_to_litter(i,j,:) = bm_to_litter(i,j,:) + & 
    439                      biomass(i,j,:) * ( un - survive(j) ) 
    440  
    441                 biomass(i,j,:) = biomass(i,j,:) * survive(j) 
    442  
    443                 IF ( control%ok_dgvm ) THEN 
    444                    ind(i,j) = ind(i,j) * survive(j) 
    445                 ENDIF 
    446  
    447                 ! fraction of plants that dies each day.  
    448                 ! exact formulation: light_death(i,j) = un - survive(j) ** (1/dt) 
    449                 light_death(i,j) = ( un - survive(j) ) / dt 
    450  
    451              ENDIF      ! pft there and natural 
    452  
    453           ENDDO        ! loop over pfts 
    454  
    455        ENDIF      ! sumfpc > fpc_crit 
    456  
    457     ENDDO        ! loop over grid points 
    458  
    459     ! 
    460     ! 4 recalculate fpc on natural part of grid cell (for next light competition) 
    461     ! 
    462  
    463     DO j = 2,nvm 
    464  
    465        IF ( natural(j) ) THEN 
    466  
    467           ! 
    468           ! 4.1 natural PFTs 
    469           ! 
    470  
    471           IF ( tree(j) ) THEN 
    472  
    473              ! 4.1.1 trees: minimum cover due to stems, branches etc. 
    474  
    475              DO i = 1, npts 
    476                 IF (lai(i,j) == val_exp) THEN 
    477                    veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
    478                 ELSE 
    479                    veget_lastlight(i,j) = & 
    480                         cn_ind(i,j) * ind(i,j) * & 
    481                         MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 
    482                 ENDIF 
     571             ! 4.2 agricultural PFTs: not present on natural part 
     572             ! 
     573 
     574             veget_lastlight(:,j) = zero 
     575 
     576          ENDIF      ! natural/agricultural 
     577 
     578       ENDDO 
     579 
     580    ELSE ! static 
     581 
     582       light_death(:,:)=0.0 
     583 
     584       DO j = 2, nvm 
     585 
     586          IF ( natural(j) ) THEN 
     587 
     588             ! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses, 
     589             ! neither a redistribution of mortality (delta fpc) 
     590 
     591             WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate )  
     592                lai_ind(:)=sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) ) 
     593             ELSEWHERE 
     594                lai_ind(:)=zero 
     595             ENDWHERE 
     596 
     597             fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * &  
     598                  MAX( ( 1._r_std - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) 
     599 
     600             WHERE(fpc_nat(:,j).GT.fpc_max(:,j)) 
     601 
     602                light_death(:,j)=MIN(1.0,1.0-fpc_max(:,j)/fpc_nat(:,j))  
     603 
     604             ENDWHERE 
     605 
     606             DO k=1,nparts 
     607 
     608                bm_to_litter(:,j,k)=bm_to_litter(:,j,k)+light_death(:,j)*biomass(:,j,k) 
     609                biomass(:,j,k)=biomass(:,j,k)-light_death(:,j)*biomass(:,j,k) 
     610 
    483611             ENDDO 
    484  
    485           ELSE 
    486  
    487              ! 4.1.2 grasses 
    488              DO i = 1, npts 
    489                 IF (lai(i,j) == val_exp) THEN 
    490                    veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)  
    491                 ELSE 
    492                    veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & 
    493                         ( un - exp( -lai(i,j) * ext_coeff(j) ) ) 
    494                 ENDIF 
    495              ENDDO 
    496           ENDIF    ! tree/grass 
    497  
    498        ELSE 
    499  
    500           ! 
    501           ! 4.2 agricultural PFTs: not present on natural part 
    502           ! 
    503  
    504           veget_lastlight(:,j) = zero 
    505  
    506        ENDIF      ! natural/agricultural 
    507  
    508     ENDDO 
     612             ind(:,j)=ind(:,j)-light_death(:,j)*ind(:,j) 
     613             ! if (j==10) print *,'ind10bis=',ind(:,j),light_death(:,j)*ind(:,j) 
     614          ENDIF 
     615       ENDDO 
     616 
     617       light_death(:,:)=light_death(:,:)/dt 
     618 
     619    ENDIF 
    509620 
    510621    ! 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_pftinout.f90

    r119 r405  
    3232  SUBROUTINE pftinout (npts, dt, adapted, regenerate, & 
    3333       neighbours, veget, veget_max, & 
    34        biomass, ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, & 
     34       biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, & 
    3535       PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, & 
    3636       co2_to_bm, & 
    … …  
    6565    ! density of individuals 1/m**2 
    6666    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind 
     67    ! crownarea of individuals m**2 
     68    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind 
    6769    ! mean age (years) 
    6870    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age 
    … …  
    105107    REAL(r_std), DIMENSION(npts)                               :: avail 
    106108    ! indices 
    107     INTEGER(i_std)                                             :: i,j 
     109    INTEGER(i_std)                                             :: i,j,m 
    108110    ! total woody vegetation cover 
    109111    REAL(r_std), DIMENSION(npts)                               :: sumfrac_wood 
    … …  
    112114    ! we can introduce this PFT 
    113115    LOGICAL, DIMENSION(npts)                                  :: can_introduce 
     116    ! no real need for dimension(ntps) except for vectorisation 
     117    REAL(r_std), DIMENSION(npts)                               :: fracnat 
    114118 
    115119    ! ========================================================================= 
    … …  
    133137    ! 
    134138 
    135     ! need to know total woody vegetation fraction 
    136  
     139    ! 2.1 Only natural part of the grid cell 
     140    ! 
     141    !SZ bug correction MERGE: need to subtract agricultural area! 
     142    ! fraction of agricultural surface 
     143    fracnat(:) = 1. 
     144    do j = 2,nvm 
     145       IF ( .NOT. natural(j) ) THEN 
     146          fracnat(:) = fracnat(:) - veget_max(:,j) 
     147       ENDIF 
     148    ENDDO 
     149 
     150    ! 
     151    ! 2.2 total woody fpc on grid 
     152    ! 
    137153    sumfrac_wood(:) = zero 
    138154 
    139155    DO j = 2,nvm 
    140  
    141        IF ( tree(j) ) THEN 
    142  
    143           sumfrac_wood(:) = sumfrac_wood(:) + veget(:,j) 
    144  
     156       !SZ problem here: agriculture, not convinced that this representation of LPJ is correct 
     157       !if agriculture is present, ind must be recalculated to correspond to the natural density... 
     158       ! since ind is per grid cell, can be achived by discounting for agricultura fraction 
     159       IF ( natural(j).AND.tree(j) ) THEN 
     160          WHERE(fracnat(:).GT.min_stomate) 
     161                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) &  
     162                     * ( 1. - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ) 
     163                !lai changed to lm_last 
     164          ENDWHERE 
    145165       ENDIF 
    146  
    147166    ENDDO 
    148167 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/stomate.f90

    r119 r405  
    3030  IMPLICIT NONE 
    3131  PRIVATE 
    32   PUBLIC stomate_main,stomate_clear 
     32  PUBLIC stomate_main,stomate_clear,init_forcing,forcing_read 
    3333  ! 
    3434  INTEGER,PARAMETER :: r_typ =nf90_real4 
    … …  
    231231  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: harvest_above_monthly, cflux_prod_monthly 
    232232 
     233  ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground  
     234  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)              :: fpc_max 
     235 
    233236  ! Date and EndOfYear, intialize and update in slowproc 
    234237  ! (Now managed in slowproc for land_use) 
    … …  
    263266  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)     :: precip_fm 
    264267  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: gpp_daily_fm 
    265   REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: resp_maint_part_fm 
    266268  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: veget_fm 
    267269  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: veget_max_fm 
    268270  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: lai_fm 
     271  PUBLIC clay_fm, humrel_daily_fm, litterhum_daily_fm, t2m_daily_fm, t2m_min_daily_fm, tsurf_daily_fm, tsoil_daily_fm, & 
     272       soilhum_daily_fm, precip_fm, gpp_daily_fm, veget_fm, veget_max_fm, lai_fm 
    269273 
    270274  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)     :: clay_fm_g 
    … …  
    278282  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)     :: precip_fm_g 
    279283  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: gpp_daily_fm_g 
    280   REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:) :: resp_maint_part_fm_g 
    281284  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: veget_fm_g 
    282285  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)   :: veget_max_fm_g 
    … …  
    286289  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:)      :: nf_written 
    287290  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: nf_cumul 
     291  PUBLIC isf, nf_written 
     292   
    288293  ! first call 
    289294  LOGICAL,SAVE :: l_first_stomate = .TRUE. 
    … …  
    312317  ! harvest above ground biomass for agriculture 
    313318  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)                            :: harvest_above 
     319 
     320  ! Carbon Mass total 
     321  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)                            :: carb_mass_total 
    314322 
    315323CONTAINS 
    … …  
    327335       &  veget_max_new, totfrac_nobio_new, & 
    328336       &  hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    329        &  co2_flux,resp_maint,resp_hetero,resp_growth) 
     337       &  co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    330338    !--------------------------------------------------------------------- 
    331339    ! 
    … …  
    417425    !NV champs 2D  
    418426    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)      :: co2_flux 
     427    REAL(r_std),DIMENSION(kjpindex),INTENT(out)      :: fco2_lu 
    419428    ! autotrophic respiration in gC/m**2 of surface/dt 
    420429    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: resp_maint 
    … …  
    490499    ! for forcing file: "daily" gpp 
    491500    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x 
    492     ! for forcing file: "daily" auto resp 
    493     REAL(r_std),DIMENSION(kjpindex,nvm,nparts)    :: resp_maint_part_x 
    494501    ! total "vegetation" cover 
    495502    REAL(r_std),DIMENSION(kjpindex)               :: cvegtot 
    … …  
    511518    INTEGER(i_std),SAVE        :: nparan            ! Number of time steps per year for carbon spinup 
    512519    INTEGER(i_std),SAVE        :: nbyear 
    513     INTEGER(i_std),PARAMETER   :: nparanmax=36      ! Number max of time steps per year for carbon spinup 
     520    INTEGER(i_std),PARAMETER   :: nparanmax=366     ! Number max of time steps per year for carbon spinup 
    514521    REAL(r_std)                 :: sf_time 
    515     INTEGER(i_std),SAVE        :: iatt=1 
     522    INTEGER(i_std),SAVE        :: iatt 
    516523    INTEGER(i_std),SAVE        :: iatt_old=1 
    517524    INTEGER(i_std)             :: max_totsize, totsize_1step,totsize_tmp 
    … …  
    591598            rest_id_stom, hist_id_stom, hist_id_stom_IPCC) 
    592599 
    593        co2_flux_monthly(:,:) = zero 
    594600       ! 
    595601       ! 1.2 read PFT data 
    … …  
    600606       ! 
    601607       ! 1.3.1 read STOMATE's start file 
     608       ! 
     609       co2_flux(:,:) = zero 
     610       fco2_lu(:) = zero 
    602611       ! 
    603612       CALL readstart & 
    … …  
    629638            &         carbon, black_carbon, lignin_struc,turnover_time,& 
    630639            &         prod10,prod100,flux10, flux100, & 
    631             &         convflux, cflux_prod10, cflux_prod100, bm_to_litter) 
     640            &         convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total) 
    632641 
    633642       ! 1.4 read the boundary conditions 
    … …  
    726735                  &     +SIZE(precip_daily)*KIND(precip_daily) & 
    727736                  &     +SIZE(gpp_daily_x)*KIND(gpp_daily_x) & 
    728                   &     +SIZE(resp_maint_part_x)*KIND(resp_maint_part_x) & 
    729737                  &     +SIZE(veget)*KIND(veget) & 
    730738                  &     +SIZE(veget_max)*KIND(veget_max) & 
    … …  
    813821                ier = NF90_DEF_VAR (forcing_id,'lai', & 
    814822                     &                            r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid) 
    815                 ier = NF90_DEF_VAR (forcing_id,'resp_maint_part', & 
    816                      &                       r_typ,(/ d_id(1),d_id(3),d_id(7),d_id(6) /),vid) 
    817823                ier = NF90_ENDDEF (forcing_id) 
    818824                !- 
    … …  
    867873             !Config  Key  = FORCESOIL_STEP_PER_YEAR 
    868874             !Config  Desc = Number of time steps per year for carbon spinup. 
    869              !Config  Def  = 12 
     875             !Config  Def  = 365 
    870876             !Config  Help = Number of time steps per year for carbon spinup. 
    871              nparan = 12 
     877             nparan = 365 
    872878             CALL getin_p('FORCESOIL_STEP_PER_YEAR', nparan) 
    873879 
    … …  
    10081014            &          carbon, black_carbon, lignin_struc,turnover_time,& 
    10091015            &          prod10,prod100,flux10, flux100, & 
    1010             &          convflux, cflux_prod10, cflux_prod100, bm_to_litter) 
     1016            &          convflux, cflux_prod10, cflux_prod100, bm_to_litter,carb_mass_total) 
    10111017 
    10121018       IF (ldforcing_write .AND. TRIM(forcing_name) /= 'NONE' ) THEN   
    … …  
    13361342               &             t_photo_min, t_photo_opt, t_photo_max,bm_to_litter,& 
    13371343               &             prod10, prod100, flux10, flux100, veget_cov_max_new,& 
    1338                &             convflux, cflux_prod10, cflux_prod100, harvest_above, lcchange) 
    1339  
     1344               &             convflux, cflux_prod10, cflux_prod100, harvest_above, carb_mass_total, lcchange,& 
     1345               &             fpc_max) 
     1346 
     1347          ! 
     1348          ! fco2_lu --> luccarb 
     1349          fco2_lu(:) = convflux(:) & 
     1350               &             + cflux_prod10(:)  & 
     1351               &             + cflux_prod100(:) & 
     1352               &             + harvest_above(:) 
    13401353          ! 
    13411354          ! 6.4 output: transform from dimension nvm to dimension nvm 
    … …  
    13971410             ENDDO 
    13981411             sf_time = MODULO(REAL(date,r_std)-1,one_year*REAL(nbyear,r_std)) 
    1399              iatt=FLOOR(sf_time/dt_forcesoil)+1 
    1400              IF ((iatt < 1) .OR. (iatt > nparan*nbyear)) THEN 
    1401                 WRITE(numout,*) 'Error with iatt=',iatt 
    1402                 CALL ipslerr (3,'stomate', & 
    1403                      &          'Error with iatt.', '', & 
    1404                      &          '(Problem with dt_forcesoil ?)') 
    1405              ENDIF 
     1412             iatt=FLOOR(sf_time/dt_forcesoil) 
     1413             IF (iatt == 0) iatt = iatt_old + 1 
    14061414 
    14071415             IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN 
    14081416                nforce(:)=0 
    1409                 soilcarbon_input(:,:,:,:) = 0 
    1410                 control_moist(:,:,:) = 0 
    1411                 control_temp(:,:,:) = 0 
    1412                 npp_equil(:,:) = 0 
     1417                soilcarbon_input(:,:,:,:) = zero 
     1418                control_moist(:,:,:) = zero 
     1419                control_temp(:,:,:) = zero 
     1420                npp_equil(:,:) = zero 
    14131421             ENDIF 
    14141422             iatt_old=iatt 
    … …  
    14371445 
    14381446          gpp_daily_x(:,:) = zero 
    1439           resp_maint_part_x(:,:,:) = zero 
    14401447          !gpp needs to be multiplied by coverage for forcing (see above) 
    14411448          DO j = 2, nvm              
    14421449             gpp_daily_x(:,j) = gpp_daily_x(:,j) + & 
    14431450                  &                              gpp_daily(:,j) * dt_slow / one_day * veget_cov_max(:,j) 
    1444              resp_maint_part_x(:,j,:) = resp_maint_part_x(:,j,:) + & 
    1445                   &                              resp_maint_part(:,j,:) * dt_slow / one_day 
    14461451          ENDDO 
    14471452          ! 
    … …  
    14791484             gpp_daily_fm(:,:,iisf) = & 
    14801485                  &                (xn*gpp_daily_fm(:,:,iisf) + gpp_daily_x(:,:))/(xn+1.) 
    1481              resp_maint_part_fm(:,:,:,iisf) = & 
    1482                   &                ( xn*resp_maint_part_fm(:,:,:,iisf) & 
    1483                   &         +resp_maint_part_x(:,:,:) )/(xn+1.) 
    14841486             veget_fm(:,:,iisf) = & 
    14851487                  &                (xn*veget_fm(:,:,iisf) + veget(:,:) )/(xn+1.) 
    … …  
    14911493             clay_fm(:,iisf) = clay(:) 
    14921494             humrel_daily_fm(:,:,iisf) = humrel_daily(:,:) 
    1493              litterhum_daily_fm(:,iisf) = +litterhum_daily(:) 
     1495             litterhum_daily_fm(:,iisf) = litterhum_daily(:) 
    14941496             t2m_daily_fm(:,iisf) = t2m_daily(:) 
    14951497             t2m_min_daily_fm(:,iisf) =t2m_min_daily(:) 
    … …  
    14991501             precip_fm(:,iisf) = precip_daily(:) 
    15001502             gpp_daily_fm(:,:,iisf) =gpp_daily_x(:,:) 
    1501              resp_maint_part_fm(:,:,:,iisf) = resp_maint_part_x(:,:,:) 
    15021503             veget_fm(:,:,iisf) = veget(:,:) 
    15031504             veget_max_fm(:,:,iisf) =veget_max(:,:) 
    … …  
    17161717    ! allocation error 
    17171718    LOGICAL                                     :: l_error 
    1718     ! Global world fraction of vegetation type map 
    1719     REAL(r_std),DIMENSION(360,180,nvm)           :: veget_ori_on_disk 
    17201719    INTEGER(i_std)                              :: ier 
    17211720    ! indices 
    … …  
    19861985    ALLOCATE (harvest_above(kjpindex), stat=ier) 
    19871986    l_error = l_error .OR. (ier.NE.0) 
     1987    ALLOCATE (carb_mass_total(kjpindex), stat=ier) 
     1988    l_error = l_error .OR. (ier.NE.0) 
    19881989    ALLOCATE (soilcarbon_input_daily(kjpindex,ncarb,nvm), stat=ier) 
    19891990    l_error = l_error .OR. (ier.NE.0) 
    … …  
    19931994    l_error = l_error .OR. (ier.NE.0) 
    19941995    ! 
     1996    ALLOCATE (fpc_max(kjpindex,nvm), stat=ier) 
     1997    l_error = l_error .OR. (ier.NE.0) 
     1998    ! 
    19951999    IF (l_error) THEN 
    19962000       STOP 'stomate_init: error in memory allocation' 
    … …  
    20662070    WRITE(numout,*) & 
    20672071         &  'expansion across a grid cell is treated: ',treat_expansion 
     2072 
     2073    !Config Key  = LPJ_GAP_CONST_MORT 
     2074    !Config Desc = prescribe mortality if not using DGVM? 
     2075    !Config Def  = y 
     2076    !Config Help = set to TRUE if constant mortality is to be activated 
     2077    !              ignored if DGVM=true! 
     2078    ! 
     2079    lpj_gap_const_mort=.TRUE. 
     2080    CALL getin('LPJ_GAP_CONST_MORT', lpj_gap_const_mort) 
     2081    WRITE(numout,*) 'LPJ GAP: constant mortality:', lpj_gap_const_mort 
    20682082 
    20692083    !Config  Key  = HARVEST_AGRI 
    … …  
    20982112    cflux_prod10(:) = zero 
    20992113    cflux_prod100(:)= zero 
     2114 
     2115    fpc_max(:,:)=zero 
    21002116    !-------------------------- 
    21012117  END SUBROUTINE stomate_init 
    … …  
    22032219    IF (ALLOCATED(precip_fm)) DEALLOCATE(precip_fm) 
    22042220    IF (ALLOCATED(gpp_daily_fm))  DEALLOCATE(gpp_daily_fm) 
    2205     IF (ALLOCATED(resp_maint_part_fm))  DEALLOCATE(resp_maint_part_fm) 
    22062221    IF (ALLOCATED(veget_fm)) DEALLOCATE(veget_fm) 
    22072222    IF (ALLOCATED(veget_max_fm)) DEALLOCATE(veget_max_fm) 
    … …  
    22192234       IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g) 
    22202235       IF (ALLOCATED(gpp_daily_fm_g))  DEALLOCATE(gpp_daily_fm_g) 
    2221        IF (ALLOCATED(resp_maint_part_fm_g))  DEALLOCATE(resp_maint_part_fm_g) 
    22222236       IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g) 
    22232237       IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g) 
    … …  
    22472261    IF ( ALLOCATED (control_temp_daily)) DEALLOCATE (control_temp_daily) 
    22482262    IF ( ALLOCATED (control_moist_daily)) DEALLOCATE (control_moist_daily) 
     2263 
     2264    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max) 
    22492265 
    22502266    ! 2. reset l_first 
    … …  
    24592475    ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier) 
    24602476    l_error = l_error .OR. (ier /= 0) 
    2461     ALLOCATE(resp_maint_part_fm(kjpindex,nvm,nparts,nsfm),stat=ier) 
    2462     l_error = l_error .OR. (ier /= 0) 
    24632477    ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier) 
    24642478    l_error = l_error .OR. (ier /= 0) 
    … …  
    24732487    ALLOCATE(nf_cumul(nsft),stat=ier) 
    24742488    l_error = l_error .OR. (ier /= 0) 
     2489    IF (l_error) THEN 
     2490       WRITE(numout,*) 'Problem with memory allocation: forcing variables' 
     2491       STOP 'init_forcing' 
     2492    ENDIF 
    24752493 
    24762494    IF (is_root_prc) THEN 
    … …  
    24952513       ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier) 
    24962514       l_error = l_error .OR. (ier /= 0) 
    2497        ALLOCATE(resp_maint_part_fm_g(nbp_glo,nvm,nparts,nsfm),stat=ier) 
    2498        l_error = l_error .OR. (ier /= 0) 
    24992515       ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier) 
    25002516       l_error = l_error .OR. (ier /= 0) 
    … …  
    25032519       ALLOCATE(lai_fm_g(nbp_glo,nvm,nsfm),stat=ier) 
    25042520       l_error = l_error .OR. (ier /= 0) 
     2521       IF (l_error) THEN 
     2522          WRITE(numout,*) 'Problem with memory allocation: forcing variables' 
     2523          STOP 'init_forcing' 
     2524       ENDIF 
     2525    ELSE 
     2526       ALLOCATE(clay_fm_g(0,nsfm),stat=ier) 
     2527       ALLOCATE(humrel_daily_fm_g(0,nvm,nsfm),stat=ier) 
     2528       ALLOCATE(litterhum_daily_fm_g(0,nsfm),stat=ier) 
     2529       ALLOCATE(t2m_daily_fm_g(0,nsfm),stat=ier) 
     2530       ALLOCATE(t2m_min_daily_fm_g(0,nsfm),stat=ier) 
     2531       ALLOCATE(tsurf_daily_fm_g(0,nsfm),stat=ier) 
     2532       ALLOCATE(tsoil_daily_fm_g(0,nbdl,nsfm),stat=ier) 
     2533       ALLOCATE(soilhum_daily_fm_g(0,nbdl,nsfm),stat=ier) 
     2534       ALLOCATE(precip_fm_g(0,nsfm),stat=ier) 
     2535       ALLOCATE(gpp_daily_fm_g(0,nvm,nsfm),stat=ier) 
     2536       ALLOCATE(veget_fm_g(0,nvm,nsfm),stat=ier) 
     2537       ALLOCATE(veget_max_fm_g(0,nvm,nsfm),stat=ier) 
     2538       ALLOCATE(lai_fm_g(0,nvm,nsfm),stat=ier) 
    25052539    ENDIF 
    25062540    ! 
    … …  
    25282562    precip_fm(:,:) = zero 
    25292563    gpp_daily_fm(:,:,:) = zero 
    2530     resp_maint_part_fm(:,:,:,:)=zero 
    25312564    veget_fm(:,:,:) = zero 
    25322565    veget_max_fm(:,:,:) = zero 
    … …  
    25802613    CALL gather(precip_fm,precip_fm_g) 
    25812614    CALL gather(gpp_daily_fm,gpp_daily_fm_g) 
    2582     CALL gather(resp_maint_part_fm,resp_maint_part_fm_g) 
    25832615    CALL gather(veget_fm,veget_fm_g) 
    25842616    CALL gather(veget_max_fm,veget_max_fm_g) 
    … …  
    26672699                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    26682700                  &            start=start(1:ndim), count=count_force(1:ndim)) 
    2669              ndim = 4; 
    2670              start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    2671              count_force(1:ndim)=SHAPE(resp_maint_part_fm_g) 
    2672              count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    2673              ier = NF90_INQ_VARID (forcing_id,'resp_maint_part',vid) 
    2674              ier = NF90_PUT_VAR (forcing_id,vid, & 
    2675                   &            resp_maint_part_fm_g(:,:,:,ifirst(iblocks):ilast(iblocks)), & 
    2676                   &            start=start(1:ndim), count=count_force(1:ndim)) 
    26772701             ndim = 3; 
    26782702             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    27152739    INTEGER(i_std)                :: iisf, iblocks, nblocks 
    27162740    INTEGER(i_std)                :: ier 
     2741    LOGICAL    :: a_er 
    27172742    INTEGER(i_std),DIMENSION(0:2) :: ifirst, ilast 
    27182743    INTEGER(i_std),PARAMETER      :: ndm = 10 
    27192744    INTEGER(i_std),DIMENSION(ndm) :: start, count_force 
    27202745    INTEGER(i_std)                :: ndim, vid 
     2746 
     2747    LOGICAL, PARAMETER :: check=.FALSE. 
     2748 
     2749    IF (check) WRITE(numout,*) "forcing_read " 
    27212750    !--------------------------------------------------------------------- 
    27222751    ! 
    … …  
    27362765          precip_fm(:,iisf) = zero 
    27372766          gpp_daily_fm(:,:,iisf) = zero 
    2738           resp_maint_part_fm(:,:,:,iisf) = zero 
    27392767          veget_fm(:,:,iisf) = zero 
    27402768          veget_max_fm(:,:,iisf) = zero 
    … …  
    27652793       ENDIF 
    27662794    ENDDO 
     2795    IF (check) WRITE(numout,*) "forcing_read nblocks, ifirst, ilast",nblocks, ifirst, ilast 
    27672796    ! 
    27682797    IF (is_root_prc) THEN 
    27692798       DO iblocks = 1, nblocks 
     2799          IF (check) WRITE(numout,*) "forcing_read iblocks, ifirst(iblocks), ilast(iblocks)",iblocks, & 
     2800               ifirst(iblocks), ilast(iblocks) 
    27702801          IF (ifirst(iblocks) /= ilast(iblocks)) THEN 
     2802             a_er=.FALSE. 
    27712803             ndim = 2; 
    27722804             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    27742806             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    27752807             ier = NF90_INQ_VARID (forcing_id,'clay',vid) 
     2808             a_er = a_er.OR.(ier.NE.0) 
    27762809             ier = NF90_GET_VAR (forcing_id, vid, & 
    27772810                  &            clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
    27782811                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2812             a_er = a_er.OR.(ier.NE.0) 
     2813!--------- 
    27792814             ndim = 3; 
    27802815             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    27822817             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    27832818             ier = NF90_INQ_VARID (forcing_id,'humrel',vid) 
     2819             a_er = a_er.OR.(ier.NE.0) 
    27842820             ier = NF90_GET_VAR (forcing_id, vid, & 
    27852821                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    27862822                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2823             a_er = a_er.OR.(ier.NE.0) 
     2824!--------- 
    27872825             ndim = 2; 
    27882826             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    27902828             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    27912829             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid) 
     2830             a_er = a_er.OR.(ier.NE.0) 
    27922831             ier = NF90_GET_VAR (forcing_id, vid, & 
    27932832                  &              litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
    27942833                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2834             a_er = a_er.OR.(ier.NE.0) 
     2835!--------- 
    27952836             ndim = 2; 
    27962837             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    27982839             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    27992840             ier = NF90_INQ_VARID (forcing_id,'t2m',vid) 
     2841             a_er = a_er.OR.(ier.NE.0) 
    28002842             ier = NF90_GET_VAR (forcing_id, vid, & 
    28012843                  &              t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
    28022844                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2845             a_er = a_er.OR.(ier.NE.0) 
     2846!--------- 
    28032847             ndim = 2; 
    28042848             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28062850             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28072851             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid) 
     2852             a_er = a_er.OR.(ier.NE.0) 
    28082853             ier = NF90_GET_VAR (forcing_id, vid, & 
    28092854                  &              t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
    28102855                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2856             a_er = a_er.OR.(ier.NE.0) 
     2857!--------- 
    28112858             ndim = 2; 
    28122859             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28142861             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28152862             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid) 
     2863             a_er = a_er.OR.(ier.NE.0) 
    28162864             ier = NF90_GET_VAR (forcing_id, vid, & 
    28172865                  &              tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
    28182866                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2867             a_er = a_er.OR.(ier.NE.0) 
     2868!--------- 
    28192869             ndim = 3; 
    28202870             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28222872             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28232873             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid) 
     2874             a_er = a_er.OR.(ier.NE.0) 
    28242875             ier = NF90_GET_VAR (forcing_id, vid, & 
    28252876                  &              tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    28262877                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2878             a_er = a_er.OR.(ier.NE.0) 
     2879!--------- 
    28272880             ndim = 3; 
    28282881             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28302883             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28312884             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid) 
     2885             a_er = a_er.OR.(ier.NE.0) 
    28322886             ier = NF90_GET_VAR (forcing_id, vid, & 
    28332887                  &              soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    28342888                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2889             a_er = a_er.OR.(ier.NE.0) 
     2890!--------- 
    28352891             ndim = 2; 
    28362892             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28382894             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28392895             ier = NF90_INQ_VARID (forcing_id,'precip',vid) 
     2896             a_er = a_er.OR.(ier.NE.0) 
    28402897             ier = NF90_GET_VAR (forcing_id, vid, & 
    28412898                  &              precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), & 
    28422899                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2900             a_er = a_er.OR.(ier.NE.0) 
     2901!--------- 
    28432902             ndim = 3; 
    28442903             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28462905             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28472906             ier = NF90_INQ_VARID (forcing_id,'gpp',vid) 
     2907             a_er = a_er.OR.(ier.NE.0) 
    28482908             ier = NF90_GET_VAR (forcing_id, vid, & 
    28492909                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    28502910                  &            start=start(1:ndim), count=count_force(1:ndim)) 
    2851              ndim = 4; 
    2852              start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    2853              count_force(1:ndim)=SHAPE(resp_maint_part_fm_g) 
    2854              count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    2855              ier = NF90_INQ_VARID (forcing_id,'resp_maint_part',vid) 
    2856              ier = NF90_GET_VAR (forcing_id,vid, & 
    2857                   &       resp_maint_part_fm_g(:,:,:,ifirst(iblocks):ilast(iblocks)), & 
    2858                   &            start=start(1:ndim), count=count_force(1:ndim)) 
     2911             a_er = a_er.OR.(ier.NE.0) 
     2912!--------- 
    28592913             ndim = 3; 
    28602914             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28622916             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28632917             ier = NF90_INQ_VARID (forcing_id,'veget',vid) 
     2918             a_er = a_er.OR.(ier.NE.0) 
    28642919             ier = NF90_GET_VAR (forcing_id, vid, & 
    28652920                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    28662921                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2922             a_er = a_er.OR.(ier.NE.0) 
     2923!--------- 
    28672924             ndim = 3; 
    28682925             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28702927             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28712928             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid) 
     2929             a_er = a_er.OR.(ier.NE.0) 
    28722930             ier = NF90_GET_VAR (forcing_id, vid, & 
    28732931                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    28742932                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2933             a_er = a_er.OR.(ier.NE.0) 
     2934!--------- 
    28752935             ndim = 3; 
    28762936             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks)); 
    … …  
    28782938             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    28792939             ier = NF90_INQ_VARID (forcing_id,'lai',vid) 
     2940             a_er = a_er.OR.(ier.NE.0) 
    28802941             ier = NF90_GET_VAR (forcing_id, vid, & 
    28812942                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), & 
    28822943                  &            start=start(1:ndim), count=count_force(1:ndim)) 
     2944             a_er = a_er.OR.(ier.NE.0) 
     2945             IF (a_er) THEN 
     2946                CALL ipslerr (3,'forcing_read', & 
     2947                     &        'PROBLEM when read forcing file', & 
     2948                     &        '','') 
     2949             ENDIF 
    28832950          ENDIF 
    28842951       ENDDO 
    … …  
    28942961    CALL scatter(precip_fm_g,precip_fm) 
    28952962    CALL scatter(gpp_daily_fm_g,gpp_daily_fm) 
    2896     CALL scatter(resp_maint_part_fm_g,resp_maint_part_fm) 
    28972963    CALL scatter(veget_fm_g,veget_fm) 
    28982964    CALL scatter(veget_max_fm_g,veget_max_fm) 
    2899     CALL scatter(lai_fm_g,lai_fm_g) 
     2965    CALL scatter(lai_fm_g,lai_fm) 
    29002966    !-------------------------- 
    29012967  END SUBROUTINE forcing_read 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/stomate_constants.f90

    r119 r405  
    160160! initial density of individuals 
    161161  REAL(r_std),PARAMETER :: ind_0 = 0.02 
     162  ! min npp to test competition between grass 
     163  REAL(r_std), PARAMETER :: npp_min = 100. 
    162164!- 
    163165! Do we treat PFT expansion across a grid point after introduction? 
    164166! default = .FALSE. 
    165167  LOGICAL,SAVE :: treat_expansion = .FALSE. 
     168! Do we treat calculate constant mortality if vegetation is static? 
     169! default = .TRUE. 
     170  LOGICAL, SAVE :: lpj_gap_const_mort = .TRUE. 
    166171!- 
    167172! herbivores? 
    … …  
    193198! fraction of GPP which is lost as growth respiration 
    194199  REAL(r_std),PARAMETER :: frac_growthresp = 0.28 
     200!- 
     201! minimum availability to calculate mortality 
     202  REAL(r_std),PARAMETER :: min_avail = 0.02 
    195203!- 
    196204! description of the PFT 
    … …  
    498506! critical tmin, tabulated (C) 
    499507  tmin_crit_tab(2:nvm) =    & 
    500  & (/     0.0,     0.0,   -45.0,   -10.0,   -45.0,   -60.0, & 
    501  &      -60.0,   undef,   undef,   undef,   undef,   undef /) 
     508 & (/     0.0,     0.0,   -30.0,   -14.0,   -30.0,   -45.0, & 
     509 &      -45.0,   undef,   undef,   undef,   undef,   undef /) 
    502510! critical tcm, tabulated (C) 
    503511  tcm_crit_tab(2:nvm) =     & 
    504  & (/   undef,   undef,     5.0,    15.5,    15.5,    -2.0, & 
    505  &        5.0,    -2.0,   undef,   undef,   undef,   undef /) 
     512 & (/   undef,   undef,     5.0,    15.5,    15.5,    -8.0, & 
     513 &        -8.0,    -8.0,   undef,   undef,   undef,   undef /) 
    506514! critical gdd, tabulated (C), constant c of aT^2+bT+c 
    507515  gdd_crit1_tab(2:nvm) =    & 
    … …  
    552560 &            1.,      1.,      1.,      1.,      1.,      1.      /) 
    553561! Maximum rate of carboxylation 
     562  !Config Key  = vcmax_opt 
     563  !Config Desc = Maximum rate of carboxylation 
     564  !Config Def  = undef, 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70. 
     565  !Config Help =  
     566  ! 
    554567!Shilong 
    555568  vcmax_opt(:) =     & 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/stomate_io.f90

    r119 r405  
    5555       &  carbon, black_carbon, lignin_struc,turnover_time, & 
    5656       &  prod10,prod100,flux10, flux100, & 
    57        &  convflux, cflux_prod10, cflux_prod100, bm_to_litter) 
     57       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total) 
    5858    !--------------------------------------------------------------------- 
    5959    !- read start file 
    … …  
    275275    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod100 
    276276    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out)                   :: bm_to_litter 
     277    REAL(r_std),DIMENSION(npts),INTENT(out)                              :: carb_mass_total 
    277278    !--------------------------------------------------------------------- 
    278279    IF (bavard >= 3) WRITE(numout,*) 'Entering readstart' 
    … …  
    342343       date = NINT(date_real) 
    343344    ENDIF 
    344     CALL bcast(date_real) 
     345    CALL bcast(date) 
    345346    !- 
    346347    ! 3 daily meteorological variables 
    … …  
    940941    ENDDO 
    941942 
     943    carb_mass_total(:) = val_exp 
     944    var_name = 'carb_mass_total' 
     945    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, & 
     946         &              .TRUE., carb_mass_total, 'gather', nbp_glo, index_g) 
     947    IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero 
    942948    !- 
    943949 
    … …  
    971977       &  carbon, black_carbon, lignin_struc, turnover_time, & 
    972978       &  prod10,prod100 ,flux10, flux100, & 
    973        &  convflux, cflux_prod10, cflux_prod100, bm_to_litter) 
     979       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total) 
    974980 
    975981    !--------------------------------------------------------------------- 
    … …  
    11791185    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod100 
    11801186    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in)                   :: bm_to_litter 
     1187    REAL(r_std),DIMENSION(npts),INTENT(in)                              :: carb_mass_total 
    11811188    !--------------------------------------------------------------------- 
    11821189    IF (bavard >= 3) WRITE(numout,*) 'Entering writerestart' 
    … …  
    16431650            &                bm_to_litter(:,:,k), 'scatter', nbp_glo, index_g) 
    16441651    ENDDO 
     1652    var_name = 'carb_mass_total' 
     1653    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, & 
     1654         &              carb_mass_total, 'scatter', nbp_glo, index_g) 
    16451655    !- 
    16461656    IF (bavard >= 4) WRITE(numout,*) 'Leaving writerestart' 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/stomate_lpj.f90

    r119 r405  
    9292       t_photo_min, t_photo_opt, t_photo_max,bm_to_litter, & 
    9393       prod10,prod100,flux10, flux100, veget_max_new, & 
    94        convflux,cflux_prod10,cflux_prod100, harvest_above, lcchange) 
     94       convflux,cflux_prod10,cflux_prod100, harvest_above, carb_mass_total, lcchange, & 
     95       fpc_max) 
    9596 
    9697    ! 
    … …  
    166167    ! maintenance respiration of different plant parts (gC/day/m**2 of ground) 
    167168    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)             :: resp_maint_part 
     169    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground  
     170    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                  :: fpc_max 
    168171 
    169172    ! 0.2 modified fields 
    … …  
    292295    ! harvest above ground biomass for agriculture 
    293296    REAL(r_std), DIMENSION(npts), INTENT(inout)                       :: harvest_above 
     297    ! Carbon Mass total 
     298    REAL(r_std), DIMENSION(npts), INTENT(inout)                       :: carb_mass_total 
    294299 
    295300    ! land cover change flag 
    … …  
    319324    ! total soil carbon (gC/(m**2)) 
    320325    REAL(r_std), DIMENSION(npts,nvm)                                   :: tot_soil_carb 
     326    ! Carbon Mass variation 
     327    REAL(r_std), DIMENSION(npts)                                      :: carb_mass_variation 
    321328    ! crown area of individuals (m**2) 
    322329    REAL(r_std), DIMENSION(npts,nvm)                               :: cn_ind 
     330    ! woodmass of individuals (gC) 
     331    REAL(r_std), DIMENSION(npts,nvm)                               :: woodmass_ind 
    323332    ! fraction that goes into plant part 
    324333    REAL(r_std), DIMENSION(npts,nvm,nparts)                        :: f_alloc 
    … …  
    337346    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground 
    338347    REAL(r_std),DIMENSION(npts,nvm)                                :: veget_max_old 
     348 
     349    ! fraction of individual dying this time step 
     350    REAL(r_std), DIMENSION(npts,nvm)                               :: mortality 
    339351 
    340352    REAL(r_std), DIMENSION(npts)                                   :: vartmp 
    … …  
    367379    bm_to_litter(:,:,:) = zero 
    368380    cn_ind(:,:) = zero 
     381    woodmass_ind(:,:) = zero 
    369382    veget_max_old(:,:) = veget_max(:,:) 
    370383 
    371     ! 
    372     ! 1.3 Prescribe some vegetation characteristics if the vegetation is not dynamic 
     384    ! 1.3 Calculate some vegetation characteristics 
     385 
     386    ! 
     387    ! 1.3.1 Calculate some vegetation characteristics (cn_ind and height) from 
     388    !     state variables if running DGVM or dynamic mortality in static cover mode 
     389    ! 
     390    IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN 
     391       IF(control%ok_dgvm) THEN 
     392          WHERE (ind(:,:).GT.min_stomate) 
     393             woodmass_ind(:,:) = & 
     394                  ((biomass(:,:,isapabove)+biomass(:,:,isapbelow) & 
     395                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow)) &  
     396                  *veget_max(:,:))/ind(:,:) 
     397          ENDWHERE 
     398       ELSE 
     399          WHERE (ind(:,:).GT.min_stomate) 
     400             woodmass_ind(:,:) = & 
     401                  (biomass(:,:,isapabove)+biomass(:,:,isapbelow) & 
     402                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/ind(:,:) 
     403          ENDWHERE 
     404       ENDIF 
     405 
     406       CALL crown (npts,  PFTpresent, & 
     407            ind, biomass, woodmass_ind, & 
     408            veget_max, cn_ind, height) 
     409    ENDIF 
     410 
     411    ! 
     412    ! 1.3.2 Prescribe some vegetation characteristics if the vegetation is not dynamic 
    373413    !     IF the DGVM is not activated, the density of individuals and their crown 
    374414    !     areas don't matter, but they should be defined for the case we switch on 
    … …  
    389429 
    390430    CALL constraints (npts, dt_days, & 
    391          t2m_month, t2m_min_daily, when_growthinit, & 
     431         t2m_month, t2m_min_daily,when_growthinit, & 
    392432         adapted, regenerate) 
    393433 
    … …  
    404444       CALL pftinout (npts, dt_days, adapted, regenerate, & 
    405445            neighbours, veget, veget_max, & 
    406             biomass, ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, & 
     446            biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, & 
    407447            PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, & 
    408448            co2_to_bm, & 
    … …  
    417457       CALL kill (npts, 'pftinout  ', lm_lastyearmax, & 
    418458            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, & 
    419             lai, age, leaf_age, leaf_frac, & 
     459            lai, age, leaf_age, leaf_frac, npp_longterm, & 
    420460            when_growthinit, everywhere, veget, veget_max, bm_to_litter) 
    421461 
    … …  
    423463       ! 3.3 calculate new crown area and maximum vegetation cover 
    424464       ! 
     465       ! 
     466       ! unsure whether this is really required 
     467       ! - in theory this could ONLY be done at the END of stomate_lpj 
     468       ! 
     469 
     470       ! calculate woodmass of individual tree 
     471       WHERE ((ind(:,:).GT.min_stomate)) 
     472          WHERE  ( veget_max(:,:) .GT. min_stomate) 
     473             woodmass_ind(:,:) = & 
     474                  ((biomass(:,:,isapabove)+biomass(:,:,isapbelow) & 
     475                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))*veget_max(:,:))/ind(:,:) 
     476          ELSEWHERE 
     477             woodmass_ind(:,:) =(biomass(:,:,isapabove)+biomass(:,:,isapbelow) & 
     478                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/ind(:,:) 
     479          ENDWHERE 
     480 
     481       ENDWHERE 
    425482 
    426483       CALL crown (npts, PFTpresent, & 
    427             ind, biomass, & 
     484            ind, biomass, woodmass_ind, & 
    428485            veget_max, cn_ind, height) 
    429486 
    … …  
    487544         resp_maint, resp_growth, npp_daily) 
    488545 
    489     IF ( control%ok_dgvm ) THEN 
     546    IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN 
     547       CALL kill (npts, 'npp       ', lm_lastyearmax,  & 
     548            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, & 
     549            lai, age, leaf_age, leaf_frac, npp_longterm, & 
     550            when_growthinit, everywhere, veget, veget_max, bm_to_litter) 
    490551 
    491552       ! new provisional crown area and maximum vegetation cover after growth 
     553       IF(control%ok_dgvm) THEN 
     554          WHERE (ind(:,:).GT.min_stomate) 
     555             woodmass_ind(:,:) = & 
     556                  ((biomass(:,:,isapabove)+biomass(:,:,isapbelow) & 
     557                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow)) &  
     558                  *veget_max(:,:))/ind(:,:) 
     559          ENDWHERE 
     560       ELSE 
     561          WHERE (ind(:,:).GT.min_stomate) 
     562             woodmass_ind(:,:) = & 
     563                  (biomass(:,:,isapabove)+biomass(:,:,isapbelow) & 
     564                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/ind(:,:) 
     565          ENDWHERE 
     566       ENDIF 
    492567 
    493568       CALL crown (npts, PFTpresent, & 
    494             ind, biomass, & 
     569            ind, biomass, woodmass_ind,& 
    495570            veget_max, cn_ind, height) 
    496571 
    … …  
    513588       CALL kill (npts, 'fire      ', lm_lastyearmax, & 
    514589            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, & 
    515             lai, age, leaf_age, leaf_frac, & 
     590            lai, age, leaf_age, leaf_frac, npp_longterm, & 
    516591            when_growthinit, everywhere, veget, veget_max, bm_to_litter) 
    517592 
    … …  
    524599    CALL gap (npts, dt_days, & 
    525600         npp_longterm, turnover_longterm, lm_lastyearmax, & 
    526          PFTpresent, biomass, ind, bm_to_litter) 
     601         PFTpresent, biomass, ind, bm_to_litter, mortality) 
    527602 
    528603    IF ( control%ok_dgvm ) THEN 
    … …  
    532607       CALL kill (npts, 'gap       ', lm_lastyearmax, & 
    533608            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, & 
    534             lai, age, leaf_age, leaf_frac, & 
     609            lai, age, leaf_age, leaf_frac, npp_longterm, & 
    535610            when_growthinit, everywhere, veget, veget_max, bm_to_litter) 
    536611 
    … …  
    570645 
    571646       CALL light (npts, dt_days, & 
    572             PFTpresent, cn_ind, lai, maxfpc_lastyear, & 
    573             ind, biomass, veget_lastlight, bm_to_litter) 
     647            veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, & 
     648            lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality) 
    574649 
    575650       ! 
    … …  
    579654       CALL kill (npts, 'light     ', lm_lastyearmax, & 
    580655            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, & 
    581             lai, age, leaf_age, leaf_frac, & 
     656            lai, age, leaf_age, leaf_frac, npp_longterm, & 
    582657            when_growthinit, everywhere, veget, veget_max, bm_to_litter) 
    583658 
    … …  
    588663    ! 
    589664 
    590     IF ( control%ok_dgvm ) THEN 
     665    IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort ) THEN 
    591666 
    592667       ! 
    … …  
    597672            neighbours, resolution, need_adjacent, herbivores, & 
    598673            precip_lastyear, gdd0_lastyear, lm_lastyearmax, & 
    599             cn_ind, lai, avail_tree, avail_grass, & 
     674            cn_ind, lai, avail_tree, avail_grass, npp_longterm, & 
    600675            leaf_age, leaf_frac, & 
    601             ind, biomass, age, everywhere, co2_to_bm, veget_max) 
     676            ind, biomass, age, everywhere, co2_to_bm, veget_max, woodmass_ind) 
    602677 
    603678       ! 
    … …  
    606681 
    607682       CALL crown (npts, PFTpresent, & 
    608             ind, biomass, & 
     683            ind, biomass, woodmass_ind, & 
    609684            veget_max, cn_ind, height) 
    610685 
    … …  
    617692    CALL cover (npts, cn_ind, ind, biomass, & 
    618693         veget_max, veget_max_old, veget, & 
    619          lai, litter, carbon) 
     694         lai, litter, carbon, turnover_daily, bm_to_litter) 
    620695 
    621696    ! 
    … …  
    647722       ENDIF 
    648723    ENDIF 
    649 !MM déplacement pour initialisation correcte des grandeurs cumulées : 
     724    !MM déplacement pour initialisation correcte des grandeurs cumulées : 
    650725    cflux_prod_total(:) = convflux(:) + cflux_prod10(:) + cflux_prod100(:) 
    651726    prod10_total(:)=SUM(prod10,dim=2) 
    … …  
    681756         &             bm_to_litter(:,:,iheartabove) + bm_to_litter(:,:,iroot) + & 
    682757         &             bm_to_litter(:,:,ifruit) + bm_to_litter(:,:,icarbres) 
     758 
     759    carb_mass_variation(:)=-carb_mass_total(:) 
     760    carb_mass_total(:)=SUM((tot_live_biomass+tot_litter_carb+tot_soil_carb)*veget_max,dim=2) + & 
     761         &                 (prod10_total + prod100_total) 
     762    carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:) 
    683763 
    684764    ! 
    … …  
    759839    CALL histwrite (hist_id_stomate, 'IND', itime, & 
    760840         ind, npts*nvm, horipft_index) 
     841    CALL histwrite (hist_id_stomate, 'CN_IND', itime, & 
     842         cn_ind, npts*nvm, horipft_index) 
     843    CALL histwrite (hist_id_stomate, 'WOODMASS_IND', itime, & 
     844         woodmass_ind, npts*nvm, horipft_index) 
    761845    CALL histwrite (hist_id_stomate, 'TOTAL_M', itime, & 
    762846         tot_live_biomass, npts*nvm, horipft_index) 
    … …  
    832916       vartmp(:)=SUM(tot_live_biomass*veget_max,dim=2)/1e3*contfrac 
    833917       CALL histwrite (hist_id_stomate_IPCC, "cVeg", itime, & 
    834          vartmp, npts, hori_index) 
     918            vartmp, npts, hori_index) 
    835919       vartmp(:)=SUM(tot_litter_carb*veget_max,dim=2)/1e3*contfrac 
    836920       CALL histwrite (hist_id_stomate_IPCC, "cLitter", itime, & 
    837          vartmp, npts, hori_index) 
     921            vartmp, npts, hori_index) 
    838922       vartmp(:)=SUM(tot_soil_carb*veget_max,dim=2)/1e3*contfrac 
    839923       CALL histwrite (hist_id_stomate_IPCC, "cSoil", itime, & 
    840          vartmp, npts, hori_index) 
     924            vartmp, npts, hori_index) 
    841925       vartmp(:)=(prod10_total + prod100_total)/1e3 
    842926       CALL histwrite (hist_id_stomate_IPCC, "cProduct", itime, & 
    843          vartmp, npts, hori_index) 
     927            vartmp, npts, hori_index) 
     928       vartmp(:)=carb_mass_variation/1e3/one_day*contfrac 
     929       CALL histwrite (hist_id_stomate_IPCC, "cMassVariation", itime, & 
     930            vartmp, npts, hori_index) 
     931 
    844932       vartmp(:)=SUM(lai*veget_max,dim=2)*contfrac 
    845933       CALL histwrite (hist_id_stomate_IPCC, "lai", itime, & 
    846          vartmp, npts, hori_index) 
     934            vartmp, npts, hori_index) 
    847935       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)/1e3/one_day*contfrac 
    848936       CALL histwrite (hist_id_stomate_IPCC, "gpp", itime, & 
    849          vartmp, npts, hori_index) 
     937            vartmp, npts, hori_index) 
    850938       vartmp(:)=SUM((resp_maint+resp_growth)*veget_max,dim=2)/1e3/one_day*contfrac 
    851939       CALL histwrite (hist_id_stomate_IPCC, "ra", itime, & 
    852          vartmp, npts, hori_index) 
     940            vartmp, npts, hori_index) 
    853941       vartmp(:)=SUM(npp_daily*veget_max,dim=2)/1e3/one_day*contfrac 
    854942       CALL histwrite (hist_id_stomate_IPCC, "npp", itime, & 
    855          vartmp, npts, hori_index) 
     943            vartmp, npts, hori_index) 
    856944       vartmp(:)=SUM(resp_hetero*veget_max,dim=2)/1e3/one_day*contfrac 
    857945       CALL histwrite (hist_id_stomate_IPCC, "rh", itime, & 
    858          vartmp, npts, hori_index) 
     946            vartmp, npts, hori_index) 
    859947       vartmp(:)=SUM(co2_fire*veget_max,dim=2)/1e3/one_day*contfrac 
    860948       CALL histwrite (hist_id_stomate_IPCC, "fFire", itime, & 
    861          vartmp, npts, hori_index) 
     949            vartmp, npts, hori_index) 
    862950       vartmp(:)=harvest_above/1e3/one_day*contfrac 
    863951       CALL histwrite (hist_id_stomate_IPCC, "fHarvest", itime, & 
    864          vartmp, npts, hori_index) 
     952            vartmp, npts, hori_index) 
    865953       vartmp(:)=cflux_prod_total/1e3/one_day*contfrac 
    866954       CALL histwrite (hist_id_stomate_IPCC, "fLuc", itime, & 
    867          vartmp, npts, hori_index) 
     955            vartmp, npts, hori_index) 
    868956       vartmp(:)=(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero)-co2_fire) & 
    869957            &        *veget_max,dim=2)-cflux_prod_total-harvest_above)/1e3/one_day*contfrac 
    870958       CALL histwrite (hist_id_stomate_IPCC, "nbp", itime, & 
    871          vartmp, npts, hori_index) 
     959            vartmp, npts, hori_index) 
    872960       vartmp(:)=SUM(tot_bm_to_litter*veget_max,dim=2)/1e3/one_day*contfrac 
    873961       CALL histwrite (hist_id_stomate_IPCC, "fVegLitter", itime, & 
    874          vartmp, npts, hori_index) 
     962            vartmp, npts, hori_index) 
    875963       vartmp(:)=SUM(SUM(soilcarbon_input,dim=2)*veget_max,dim=2)/1e3/one_day*contfrac 
    876964       CALL histwrite (hist_id_stomate_IPCC, "fLitterSoil", itime, & 
    877          vartmp, npts, hori_index) 
     965            vartmp, npts, hori_index) 
    878966       vartmp(:)=SUM(biomass(:,:,ileaf)*veget_max,dim=2)/1e3*contfrac 
    879967       CALL histwrite (hist_id_stomate_IPCC, "cLeaf", itime, & 
    880          vartmp, npts, hori_index) 
     968            vartmp, npts, hori_index) 
    881969       vartmp(:)=SUM((biomass(:,:,isapabove)+biomass(:,:,iheartabove))*veget_max,dim=2)/1e3*contfrac 
    882970       CALL histwrite (hist_id_stomate_IPCC, "cWood", itime, & 
    883          vartmp, npts, hori_index) 
     971            vartmp, npts, hori_index) 
    884972       vartmp(:)=SUM(( biomass(:,:,iroot) + biomass(:,:,isapbelow) + biomass(:,:,iheartbelow) ) & 
    885973            &        *veget_max,dim=2)/1e3*contfrac 
    886974       CALL histwrite (hist_id_stomate_IPCC, "cRoot", itime, & 
    887          vartmp, npts, hori_index) 
     975            vartmp, npts, hori_index) 
    888976       vartmp(:)=SUM(( biomass(:,:,icarbres) + biomass(:,:,ifruit))*veget_max,dim=2)/1e3*contfrac 
    889977       CALL histwrite (hist_id_stomate_IPCC, "cMisc", itime, & 
    890          vartmp, npts, hori_index) 
     978            vartmp, npts, hori_index) 
    891979       vartmp(:)=SUM((litter(:,istructural,:,iabove)+litter(:,imetabolic,:,iabove))*veget_max,dim=2)/1e3*contfrac 
    892980       CALL histwrite (hist_id_stomate_IPCC, "cLitterAbove", itime, & 
    893          vartmp, npts, hori_index) 
     981            vartmp, npts, hori_index) 
    894982       vartmp(:)=SUM((litter(:,istructural,:,ibelow)+litter(:,imetabolic,:,ibelow))*veget_max,dim=2)/1e3*contfrac 
    895983       CALL histwrite (hist_id_stomate_IPCC, "cLitterBelow", itime, & 
    896          vartmp, npts, hori_index) 
     984            vartmp, npts, hori_index) 
    897985       vartmp(:)=SUM(carbon(:,iactive,:)*veget_max,dim=2)/1e3*contfrac 
    898986       CALL histwrite (hist_id_stomate_IPCC, "cSoilFast", itime, & 
    899          vartmp, npts, hori_index) 
     987            vartmp, npts, hori_index) 
    900988       vartmp(:)=SUM(carbon(:,islow,:)*veget_max,dim=2)/1e3*contfrac 
    901989       CALL histwrite (hist_id_stomate_IPCC, "cSoilMedium", itime, & 
    902          vartmp, npts, hori_index) 
     990            vartmp, npts, hori_index) 
    903991       vartmp(:)=SUM(carbon(:,ipassive,:)*veget_max,dim=2)/1e3*contfrac 
    904992       CALL histwrite (hist_id_stomate_IPCC, "cSoilSlow", itime, & 
    905          vartmp, npts, hori_index) 
     993            vartmp, npts, hori_index) 
    906994       DO j=1,nvm 
    907995          histvar(:,j)=veget_max(:,j)*contfrac(:)*100 
    908996       ENDDO 
    909997       CALL histwrite (hist_id_stomate_IPCC, "landCoverFrac", itime, & 
    910          histvar, npts*nvm, horipft_index) 
     998            histvar, npts*nvm, horipft_index) 
    911999       vartmp(:)=(veget_max(:,3)+veget_max(:,6)+veget_max(:,8)+veget_max(:,9))*contfrac*100 
    9121000       CALL histwrite (hist_id_stomate_IPCC, "treeFracPrimDec", itime, & 
    913           vartmp, npts, hori_index) 
     1001            vartmp, npts, hori_index) 
    9141002       vartmp(:)=(veget_max(:,2)+veget_max(:,4)+veget_max(:,5)+veget_max(:,7))*contfrac*100 
    9151003       CALL histwrite (hist_id_stomate_IPCC, "treeFracPrimEver", itime, & 
    916          vartmp, npts, hori_index) 
     1004            vartmp, npts, hori_index) 
    9171005       vartmp(:)=(veget_max(:,10)+veget_max(:,12))*contfrac*100 
    9181006       CALL histwrite (hist_id_stomate_IPCC, "c3PftFrac", itime, & 
    919          vartmp, npts, hori_index) 
     1007            vartmp, npts, hori_index) 
    9201008       vartmp(:)=(veget_max(:,11)+veget_max(:,13))*contfrac*100 
    9211009       CALL histwrite (hist_id_stomate_IPCC, "c4PftFrac", itime, & 
    922          vartmp, npts, hori_index) 
     1010            vartmp, npts, hori_index) 
    9231011       vartmp(:)=SUM(resp_growth*veget_max,dim=2)/1e3/one_day*contfrac 
    9241012       CALL histwrite (hist_id_stomate_IPCC, "rGrowth", itime, & 
    925          vartmp, npts, hori_index) 
     1013            vartmp, npts, hori_index) 
    9261014       vartmp(:)=SUM(resp_maint*veget_max,dim=2)/1e3/one_day*contfrac 
    9271015       CALL histwrite (hist_id_stomate_IPCC, "rMaint", itime, & 
    928          vartmp, npts, hori_index) 
     1016            vartmp, npts, hori_index) 
    9291017       vartmp(:)=SUM(bm_alloc(:,:,ileaf)*veget_max,dim=2)/1e3/one_day*contfrac 
    9301018       CALL histwrite (hist_id_stomate_IPCC, "nppLeaf", itime, & 
    931          vartmp, npts, hori_index) 
     1019            vartmp, npts, hori_index) 
    9321020       vartmp(:)=SUM(bm_alloc(:,:,isapabove)*veget_max,dim=2)/1e3/one_day*contfrac 
    9331021       CALL histwrite (hist_id_stomate_IPCC, "nppWood", itime, & 
    934          vartmp, npts, hori_index) 
     1022            vartmp, npts, hori_index) 
    9351023       vartmp(:)=SUM(( bm_alloc(:,:,isapbelow) + bm_alloc(:,:,iroot) )*veget_max,dim=2)/1e3/one_day*contfrac 
    9361024       CALL histwrite (hist_id_stomate_IPCC, "nppRoot", itime, & 
    937          vartmp, npts, hori_index) 
     1025            vartmp, npts, hori_index) 
    9381026 
    9391027       CALL histwrite (hist_id_stomate_IPCC, 'RESOLUTION_X', itime, & 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/stomate_prescribe.f90

    r119 r405  
    8989      ! only when the DGVM is not activated or agricultural PFT. 
    9090 
    91       IF ( ( .NOT. control%ok_dgvm ) .OR. ( .NOT. natural(j) ) ) THEN 
     91      IF ( ( .NOT. control%ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) ) THEN 
    9292 
    9393        ! 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/stomate_season.f90

    r119 r405  
    163163    ! rapport maximal GPP/GGP_max pour dormance 
    164164    REAL(r_std), PARAMETER                                  :: gppfrac_dormance = 0.2 
    165 ! 
    166 !NVADD 
    167      ! minimum gpp considered as not "lowgpp" 
     165    ! 
     166    !NVADD 
     167    ! minimum gpp considered as not "lowgpp" 
    168168    REAL(r_std), PARAMETER                                  :: min_gpp_allowed = 0.3 
    169      ! tau (year) for "climatologic variables 
     169    ! tau (year) for "climatologic variables 
    170170    REAL(r_std), PARAMETER                                  :: tau_climatology = 20 
    171 !ENDNVADD 
     171    !ENDNVADD 
    172172    ! maximum ncd (d) (to avoid floating point underflows) 
    173173    REAL(r_std)                                             :: ncd_max  
    … …  
    186186    ! herbivore consumption (gC/m**2/day) 
    187187    REAL(r_std), DIMENSION(npts)                            :: consumption 
     188    ! fraction of each gridcell occupied by natural vegetation 
     189    REAL(r_std), DIMENSION(npts)                            :: fracnat 
    188190 
    189191    ! ========================================================================= 
    … …  
    226228 
    227229       ! 1.2.1.1 "monthly" 
    228 !MM PAS PARALLELISE!! 
     230       !MM PAS PARALLELISE!! 
    229231       IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN 
    230232 
    … …  
    278280 
    279281       ! 1.2.3 "monthly" soil temperatures 
    280 !MM PAS PARALLELISE!! 
     282       !MM PAS PARALLELISE!! 
    281283       IF ( ABS( SUM( tsoil_month(:,:) ) ) .LT. min_stomate ) THEN 
    282284 
    … …  
    465467    !         detect a beginning of the growing season by declaring it dormant 
    466468    ! 
    467 !NVMODIF 
     469    !NVMODIF 
    468470    DO j = 2,nvm 
    469471       WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. &  
    … …  
    471473            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. & 
    472474            ( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) ) 
    473 !       WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. &  
    474 !            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. & 
    475 !            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. & 
    476 !            ( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) ) 
    477            
     475          !       WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. &  
     476          !            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. & 
     477          !            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. & 
     478          !            ( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) ) 
     479 
    478480          time_lowgpp(:,j) = time_lowgpp(:,j) + dt 
    479            
     481 
    480482       ELSEWHERE 
    481            
     483 
    482484          time_lowgpp(:,j) = zero 
    483485 
    … …  
    817819    ! 
    818820 
     821    IF(control%ok_dgvm ) THEN 
     822 
     823       fracnat(:) = un 
     824       DO j = 2,nvm 
     825          IF ( .NOT. natural(j) ) THEN 
     826             fracnat(:) = fracnat(:) - veget_max(:,j) 
     827          ENDIF 
     828       ENDDO 
     829 
     830    ENDIF 
     831 
    819832    IF ( control%ok_stomate ) THEN 
    820  
    821        DO j = 2,nvm 
    822           WHERE ( biomass(:,j,ileaf) .GT. lm_thisyearmax(:,j) ) 
    823              lm_thisyearmax(:,j) = biomass(:,j,ileaf) 
    824           ENDWHERE 
    825        ENDDO 
    826  
     833       IF(control%ok_dgvm ) THEN 
     834          DO j=2,nvm 
     835 
     836             IF ( natural(j) .AND. control%ok_dgvm ) THEN 
     837 
     838                WHERE ( fracnat(:) .GT. min_stomate .AND. biomass(:,j,ileaf).GT. lm_lastyearmax(:,j)*0.75 ) 
     839                   maxfpc_lastyear(:,j) = ( maxfpc_lastyear(:,j) * ( one_year/leaflife_tab(j)- dt ) + & 
     840                        veget(:,j) / fracnat(:) * dt ) / (one_year/leaflife_tab(j)) 
     841                ENDWHERE 
     842                maxfpc_thisyear(:,j) = maxfpc_lastyear(:,j) ! just to initialise value 
     843 
     844             ENDIF 
     845 
     846!NV : correct initialization 
     847!!$             WHERE(biomass(:,j,ileaf).GT. lm_lastyearmax(:,j)*0.75) 
     848!!$                lm_lastyearmax(:,j) = ( lm_lastyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + & 
     849!!$                     biomass(:,j,ileaf) * dt ) / (one_year/leaflife_tab(j)) 
     850!!$             ENDWHERE 
     851!!$             lm_thisyearmax(:,j)=lm_lastyearmax(:,j) ! just to initialise value 
     852             WHERE (lm_thisyearmax(:,j) .GT. min_stomate) 
     853                WHERE(biomass(:,j,ileaf).GT. lm_thisyearmax(:,j)*0.75) 
     854                   lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + & 
     855                        biomass(:,j,ileaf) * dt ) / (one_year/leaflife_tab(j)) 
     856                ENDWHERE 
     857             ELSEWHERE 
     858                lm_thisyearmax(:,j) =biomass(:,j,ileaf) 
     859             ENDWHERE 
     860 
     861          ENDDO 
     862 
     863       ELSE 
     864 
     865          DO j = 2,nvm 
     866             WHERE ( biomass(:,j,ileaf) .GT. lm_thisyearmax(:,j) ) 
     867                lm_thisyearmax(:,j) = biomass(:,j,ileaf) 
     868             ENDWHERE 
     869          ENDDO 
     870 
     871       ENDIF 
    827872    ELSE 
    828873 
    … …  
    852897       ! 21.1 replace old values 
    853898       ! 
    854 !NVMODIF 
    855       maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology 
    856       minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology 
    857       maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology 
    858 !       maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:) 
    859 !       minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:) 
    860 !       maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:) 
     899       !NVMODIF 
     900       maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology 
     901       minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology 
     902       maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology 
     903       !       maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:) 
     904       !       minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:) 
     905       !       maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:) 
    861906 
    862907       gdd0_lastyear(:) = gdd0_thisyear(:) 
    … …  
    910955       !        fpc_crit. 
    911956 
    912        ! calculate the sum of maxfpc_lastyear 
    913        sumfpc_nat(:) = zero 
    914        DO j = 2,nvm 
    915           sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j) 
    916        ENDDO 
    917  
    918        ! scale so that the new sum is fpc_crit 
    919        DO j = 2,nvm  
    920           WHERE ( sumfpc_nat(:) .GT. fpc_crit ) 
    921              maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:)) 
    922           ENDWHERE 
    923        ENDDO 
     957!!$       ! calculate the sum of maxfpc_lastyear 
     958!!$       sumfpc_nat(:) = zero 
     959!!$       DO j = 2,nvm 
     960!!$          sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j) 
     961!!$       ENDDO 
     962!!$ 
     963!!$       ! scale so that the new sum is fpc_crit 
     964!!$       DO j = 2,nvm  
     965!!$          WHERE ( sumfpc_nat(:) .GT. fpc_crit ) 
     966!!$             maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:)) 
     967!!$          ENDWHERE 
     968!!$       ENDDO 
    924969 
    925970    ENDIF  ! EndOfYear 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FLUXNET/Job_FLUXNET_validation

    r119 r405  
    212212 
    213213    IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/spinup.card UserChoices DRIVER_NORESTART y 
     214    IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/spinup.card UserChoices DRIVER_TIMELENGTH n 
    214215 
    215216    eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/spinup.card UserChoices duree_nostomate $( correct_duree ${fluxnet_SPINUP_duree_nostomate} ${TIME_YEAR} ) 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FLUXNET/PARAM/sechiba.def

    r119 r405  
    503503 
    504504# Total depth of soil reservoir 
    505 HYDROL_SOIL_DEPTH = 2. 
     505HYDROL_SOIL_DEPTH = 4. 
    506506# default = 2. 
    507507 
    … …  
    510510# For 4 meters soil depth, you may use those ones : 
    511511# 5., .4, .4, 1., .8, .8, 1., 1., .8, 4., 1., 4., 1. 
    512 HYDROL_HUMCSTE = 5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4. 
     512HYDROL_HUMCSTE = 5., .4, .4, 1., .8, .8, 1., 1., .8, 4., 1., 4., 1. 
    513513# default =  5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4. 
    514514 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FLUXNET/fluxnet.card

    r119 r405  
    11[FLUXNET] 
    22# - Fluxnet files path 
    3 FluxnetPath=${R_BC}/OOL/${config_UserChoices_TagName}/FLUXNET/BC 
     3FluxnetPath=/home/orchidee01/vuichard/Input_Fluxnet 
    44 
    55# - Number of PFTs : 
    66NbPFTs= 13 
    77 
    8 # - Information on the sites to be treated : 
    9 #   * Number of physical parameters on each sites per PFTs 
    10 NbSitesParam= 2 
    11 # 4 first parameters are Name, Forcing file, Begin date, Number of years in forcing file 
    12  
    13 #   * ORCHIDEE name for physical parameters on each sites 
    14 #   PFT (IMPOSE_VEG), \ 
    15 #   initial LAI (IMPOSE_VEG) 
    16 NameSitesParam= ( SECHIBA_VEGMAX, SECHIBA_LAI ) 
    17 # by Default :  
    18 # 1) first line is for PFT 
    19 # 2) second line is for LAI default for SLOWPROC lai model with :  
    20 #    llaimax = 0.,  8.,  8.,  4., 4.5, 4.5,  4., 4.5,  4.,  2.,  2.,  2.,  2.) 
    21  
    22 #   * Name of component for each physical parameter described in NameSitesParam 
    23 #     (in SECHIBA, STOMATE, DRIVER) 
    24 CompSitesParam= ( SECHIBA, SECHIBA ) 
    25  
     8#**** Information on the sites to be treated ************************* 
     9#  Number of parameters to modify for each site 
     10NbSitesParam= 1 
     11#  Name of the parameters to modify for on each site 
     12NameSitesParam= ( SECHIBA_VEGMAX ) 
     13#  Name of the component for each parameter described in NameSitesParam (either, SECHIBA, STOMATE, or DRIVER) 
     14CompSitesParam= ( SECHIBA ) 
    2615 
    2716# Sites descriptions 
    28 #       Abbrv,  Filename ,      Inital year (for gregorian calendar) , Length (Y),  \ 
    29 #param 1,   2,   3,   4,   5,   6,   7,   8,   9,  10,  11,  12,  13 
    30 Sites= ( GU, GU.nc   ,          1996,                         3     , \ 
    31      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.3, 0.0, 0.0, 0.0, \ 
    32      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2.0, 0.0, 2.0, 0.0, 0.0, 0.0) \ 
    33 \ 
    34        ( FL, FL.nc   ,          1996,                         3     , \ 
    35      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    36      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    37 \ 
    38        ( HY, HY.nc   ,          1996,                         5     , \ 
    39      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, \ 
    40      0.0, 8.0, 8.0, 4.0, 4.5, 4.5, 3.0, 2.5, 4.0, 3.0, 2.0, 2.0, 2.0) \ 
    41 \ 
    42        ( NB, NB.nc   ,          1994,                         5     , \ 
    43      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    44      0.0, 0.0, 0.0, 0.0, 0.0, 4.5, 4.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    45 \ 
    46        ( NO, NO.nc   ,          1996,                         3     , \ 
    47      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    48      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 4.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    49 \ 
    50        ( HV, HV.nc   ,          1992,                         8     , \ 
    51      0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    52      0.0, 0.0, 0.0, 2.8, 0.0, 2.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    53 \ 
    54        ( SO, SO.nc   ,          1997,                         4     , \ 
    55      0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    56      0.0, 0.0, 0.0, 0.0, 0.0, 2.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    57 \ 
    58        ( VI, VI.nc   ,          1996,                         3     , \ 
    59      0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    60      0.0, 0.0, 0.0, 2.5, 0.0, 2.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    61 \ 
    62        ( WB, WB.nc   ,          1995,                         3     , \ 
    63      0.0, 0.0, 0.0, 0.2, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    64      0.0, 0.0, 0.0, 3.0, 0.0, 3.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    65 \ 
    66        ( AB, AB.nc   ,          1997,                         3     , \ 
    67      0.0, 0.0, 0.0, 0.9, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    68      0.0, 0.0, 0.0, 7.5, 0.0, 0.0, 0.0, 0.0, 0.0, 7.5, 0.0, 0.0, 0.0) \ 
    69 \ 
    70        ( BR, BR.nc   ,          1996,                         4     , \ 
    71      0.0, 0.0, 0.0, 0.6, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    72      0.0, 0.0, 0.0, 2.5, 0.0, 2.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    73 \ 
    74        ( LO, LO.nc   ,          1996,                         5     , \ 
    75      0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, \ 
    76      1.5, 8.0, 8.0, 3.0, 1.6, 5.5, 3.0, 2.5, 4.0, 3.2, 2.9, 5.0, 2.0) \ 
    77 \ 
    78        ( ME, ME.nc   ,          1996,                         2     , \ 
    79      0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    80      0.0, 0.0, 0.0, 3.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    81 \ 
    82        ( TH, TH.nc   ,          1996,                         5     , \ 
    83      0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, \ 
    84      1.5, 8.0, 8.0, 6.0, 1.6, 5.5, 3.0, 2.5, 4.0, 6.0, 2.9, 5.0, 2.0) \ 
    85 \ 
    86        ( WE, WE.nc   ,          1996,                         4     , \ 
    87      0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, \ 
    88      0.0, 0.0, 0.0, 6.0, 0.0, 0.0, 0.0, 0.0, 0.0, 6.0, 0.0, 0.0, 0.0) \ 
    89 \ 
    90        ( MA, MA.nc   ,          1996,                         1     , \ 
    91      0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    92      0.0, 5.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    93 \ 
    94        ( LW, LW.nc   ,          1997,                         2     , \ 
    95      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, \ 
    96      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2.5, 0.0, 0.0, 0.0) \ 
    97 \ 
    98        ( SH, SH.nc   ,          1997,                         1     , \ 
    99      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, \ 
    100      0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 2.0, 0.0, 0.0) \ 
     17# 4 first parameters are Name, Forcing file, Initial Year, Number of years in forcing file 
     18# following parameters are NameSitesParam 
     19Sites= ( NL-Loo, NL-Loo.nc,  1996,                                 11, \ 
     20     0,   0,   0, 0.8,   0,   0,   0,   0,   0, 0.2,   0,   0,   0.) \ 
     21 \ 
     22       ( DE-Hai, DE-Hai.nc,  2000,                                  7, \ 
     23     0,   0,   0,   0,    0, 0.8,   0,   0,   0, 0.2,   0,   0,   0) \ 
     24 \ 
     25       ( BW-Ma1, BW-Ma1.nc,  1999,                                  3, \ 
     26    0.1, 0.2,   0,   0,   0,   0,   0,   0,   0, 0.7,   0,   0,   0) \ 
     27 \ 
     28       ( FI-Sod, FI-Sod.nc,  2000,                                  7, \ 
     29      0,   0,   0,   0,   0,   0, 0.8,   0,   0, 0.2,   0,   0,   0) \ 
     30 \ 
     31       ( BR-Sa1, BR-Sa1.nc,  2002,                                  3, \ 
     32      0, 0.8,   0,   0,   0,   0,   0,   0,   0, 0.2,   0,   0,   0) \ 
     33 \ 
     34       ( RU-Zot, RU-Zot.nc,  2002,                                  3, \ 
     35     0,   0,   0,   0,   0,   0, 0.8,   0,   0, 0.2,   0,   0,   0) \ 
     36 \ 
     37        ( BR-Ma2, BR-Ma2.nc,  2002,                                  5, \ 
     38      0, 0.8,   0,   0,   0,   0,   0,   0,   0, 0.2,   0,   0,   0) 
    10139 
    102 #??? 
    103 #        ( BX, BX.nc   ,     2     , \ 
    104 #      0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, \ 
    105 #      0.0, 0.0, 0.0, 2.9, 0.0, 0.0, 0.0, 0.0, 0.0, 2.9, 0.0, 0.0, 0.0) \ 
    106 # \ 
    107  
    108 #\ 
    109 #       ( ??, ??.nc   ,     2000,     0     , \ 
    110 #     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, \ 
    111 #                                   0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) \ 
    112 #\ 
    113  
    114  
    115 # The following tables of parameters for SECHIBA 
    116 # are in the following order : 
     40# To fill the VEGMAX for each site 
     41# here below is the standard PFT list 
    11742# 
    11843#    1 - Bare soil 
    … …  
    13156 
    13257[SPINUP] 
    133     # SPINUP configuration :  
    134     # ---------------------- 
    135 # !! Step of time in N Years !! 
    136 # !! The spinup will change if the fluxnet file contains more than one year !! 
    137 #    ( N = Number of years contain in fluxnet forcing file )  
    138 #     each Year * N 
    139  
    14058# Initialisation for spin-up : 
    14159# orchidee with sechiba alone (!!! if ok_stomate == n !!!) 
    … …  
    14361# orchidee with stomate 
    14462duree_inistomate=1 
    145 # teststomate (only if duree_nostomate or duree_inistomate > 0) 
     63# teststomate (only if duree_inistomate > 0) 
    14664duree_offlineini=0 
    14765 
    148 # Loop configuration for spin-up : 
     66# Loop over ORCHIDEE runs (used for spin-up) 
    14967# The whole job is restarted n_iter times 
    15068n_iter=1 
    … …  
    15674duree_carbonsol=10000 
    15775 
    158 # Finalization for spin-up : 
    159 # all orchidee 
    160 duree_final=20 
     76# Final run (full ORCHIDEE) 
    16177# This last parameter must be non-zero. 
     78duree_final=200 
    16279 
    16380 
    16481    # POST configuration :  
    16582    # -------------------- 
    166 # ATLAS fix parameters : 
    16783# Atlas Name :  
    168 AtlasCfg=atlas_FLUXNET.cfg 
    169 #atlas_FLUXNET.cfg 
    170 #atlas_FLUXNET_soenke.cfg 
     84AtlasCfg=atlas_FLUXNET_LATHUILE.cfg 
    17185 
    172 # observation_file 
    173 observation_file_path='${R_BC}/OOL/${config_UserChoices_TagName}/FLUXNET/BC/${Site}.nc' 
    174 #'${R_BC}/OOL/${config_UserChoices_TagName}/FLUXNET/OLD/${Site}.nc' 
    175 #'${R_BC}/OOL/${config_UserChoices_TagName}/FLUXNET/OBS/${Site}_obs_gapfilled.nc' 
     86# Observation_file 
     87observation_file_path='/home/orchidee01/vuichard/Input_Fluxnet/${Site}.nc' 
    17688 
    177 # old history file 
    178 reference_file_path='/dmnfs/cont003/p86manci/VALID_OL/OK_STOMATE/${Site}_sechiba_hist.nc' 
    179 # 3 choices : SECHIBA, OK_CO2, OK_STOMATE 
    180 #'/dmnfs/cont003/p86manci/VALID_OL/SECHIBA/${Site}_sechiba_hist.nc' 
     89# History file of former ORCHIDEE runs (Reference) to compare with the current simulations 
     90reference_file_path='/home/orchidee01/vuichard/ORCHIDEE_1951/IGCM_OUT/OL2/Fluxnet_Vuichard/${Site}_sechiba_hist.nc' 
    18191 
    18292# Modulo for SpinUp years 
    … …  
    18797 
    18898[UserChoices] 
    189  
    190 # 
    191 ###-- STOMATE flag 
    192 # 
     99# stomate activated or not ? 
    193100ok_stomate=y 
    194 # 
    195 ###-- OK_CO2 flag 
    196 # 
     101# Photosynthesis activated or not ? 
    197102ok_co2=y 
    198  
    199 # 
    200 ###-- NEW HYDROL CWRR flag 
    201 # 
     103# New hydrology (deRosnay) activated or not ? 
    202104ok_newhydrol=n 
    203105 
    204 # 
    205 ## DEBUG mode for SPINUP  
     106# DEBUG mode for SPINUP  
    206107# 
    207108# This mode keep all SPINUP directory in ARCHIVE 
    208109# If disable, all ARCHIVE is automaticly cleaned. 
    209 #  
    210110DEBUG_SPIN=n 
    211111# If you don't want to keep old spinup steps, but last one 
    212 CONSERVE=y 
     112CONSERVE=n  
    213113 
    214114[SubJobParams] 
    215 # You can specify here any parameters to be modified in sechiba.def, stomate.def or driver.def for SpinUp Subjobs. 
    216 # NEW : due to split of orchidee.def in component specific parameter files, 
    217 #       you must add here a prefix for the specific parameter file. 
    218 driver_DEBUG_INFO=n 
    219 sechiba_LONGPRINT=n 
     115# You can specify here any parameters to be modified in sechiba.def, stomate.def or driver.def 
     116# due to split of orchidee.def in component specific parameter files, 
     117# you must add here a prefix for the specific parameter file. 
    220118stomate_BAVARD=0 
    221119sechiba_ALMA_OUTPUT=y 
    222 driver_ALLOW_WEATHERGEN=n 
    223120sechiba_SECHIBA_reset_time=y 
    224 ## To begin with half water stress 
    225 #sechiba_HYDROL_HUMR=0.5 
    226 # FLUXNET files have hour frequency values. 
    227121driver_SPLIT_DT=1 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FLUXNET/fluxnet_LATHUILE.card

    r119 r405  
    5757\ 
    5858       ( RU-Zot, RU-Zot.nc,  2002,                                  3, \ 
    59     0,   0,   0,   0,   0,   0, 0.8,   0,   0, 0.2,   0,   0,   0, \ 
    60     0.,  8.,  8.,  4., 4.5, 4.5,  4., 4.5,  4.,  2.,  2.,  2.,  2.) 
     59     0,   0,   0,   0,   0,   0, 0.8,   0,   0, 0.2,   0,   0,   0, \ 
     60     0.,  8.,  8.,  4., 4.5, 4.5,  4., 4.5,  4.,  2.,  2.,  2.,  2.) 
    6161# lat           lon             site    sand    silt    clay    pft1    pft2    pft3    pft4    pft5    pft6    pft7    pft8    pft9    pft10   pft11   pft12   pft13 
    6262# 51.07929993   10.45199966     DE-Hai  0.03667 0.54    0.42333 0       0       0       0       0       0.8     0       0       0       0.2     0       0       0 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FORCESOIL/COMP/stomate.card

    r119 r405  
    2828 
    2929[OutputText] 
    30 List=   (stomate.def, driver.def, used_run.def, out_forcesoil) 
     30List=   (used_stomate.def, used_driver.def, used_run.def, out_forcesoil, out_orchidee) 
    3131 
    3232[OutputFiles] 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FORCESOIL/COMP/stomate.driver

    r119 r405  
    5858 
    5959    IGCM_debug_PopStack "SBG_Initialize" 
     60} 
     61 
     62#----------------------------------------------------------------- 
     63function SBG_PeriodStart 
     64{ 
     65    IGCM_debug_PushStack "SBG_PeriodStart" 
     66 
     67    IGCM_debug_PopStack "SBG_PeriodStart" 
    6068} 
    6169 
    … …  
    125133    fi 
    126134 
    127     DRIVER_sed TIME_LENGTH ${PeriodLengthInDays}D 
     135    DRIVER_sed TIME_LENGTH ${PeriodLengthInYears}Y 
    128136#    DRIVER_sed TIME_SKIP ${OldSimulationLengthInDays}D 
    129137 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/FORCESOIL/PARAM/run.def

    r119 r405  
    22# 
    33INCLUDEDEF=driver.def 
    4 INCLUDEDEF=sechiba.def 
    54INCLUDEDEF=stomate.def 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC/COMP/orchidee_ol.card

    r119 r405  
    88# If you want to use the same forcing file 
    99NORESTART=n 
     10# If you want use config.card PeriodLength for TIME_LENGTH 
     11TIMELENGTH=y 
    1012 
    1113[InitialStateFiles] 
    … …  
    2830 
    2931[OutputText] 
    30 List=   (used_driver.def, out_orchidee_ol) 
     32List=   (used_driver.def, used_run.def, out_orchidee_ol) 
    3133# avec la // : out_orchidee_* 
    3234 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC/COMP/orchidee_ol.driver

    r119 r405  
    4545    IGCM_debug_PushStack "OOL_Update" 
    4646 
    47     case ${config_UserChoices_PeriodLength} in 
    48         *Y|*y|*M|*m|*D|*d) 
    49             DRIVER_sed TIME_LENGTH ${PeriodLengthInDays}D 
    50             ;; 
    51         *s) 
    52             DRIVER_sed TIME_LENGTH ${config_UserChoices_PeriodLength} 
    53     esac 
     47    if [ X"${orchidee_ol_UserChoices_TIMELENGTH}" = Xy ] ; then 
     48        case ${config_UserChoices_PeriodLength} in 
     49            *Y|*y|*M|*m|*D|*d) 
     50                DRIVER_sed TIME_LENGTH ${PeriodLengthInDays}D 
     51                ;; 
     52            *s) 
     53                DRIVER_sed TIME_LENGTH ${config_UserChoices_PeriodLength} 
     54        esac 
     55    fi 
    5456 
    5557    if ( ${FirstInitialize} ) ; then 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC/COMP/sechiba.card

    r119 r405  
    55LAIMAP=n 
    66IMPOSE_VEG=n 
     7# if IMPOSE_VEG = n 
    78LAND_USE=n 
     9# if LAND_USE=y 
    810VEGET_UPDATE=1Y 
     11# if LAND_USE=n and we want to use carteveg5km.nc for maxvegetfrac map. 
     12# (instead of default PFTmap_1850to2005_AR5_LUHa.rc2 below) 
     13OLD_VEGET=n 
    914ROUTING=n 
    1015NEWHYDROL=n 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC/COMP/sechiba.driver

    r119 r405  
    2626    RESOL_SRF=ALL 
    2727     
     28    typeset frequency 
    2829    for frequency in ${config_SRF_WriteFrequency} ; do 
    2930        case ${frequency} in 
    … …  
    6263    typeset SECHIBA_WRITE_STEP 
    6364 
     65    # Get WriteFrenquecies from config.card for SECHIBA 
    6466    SRF_WriteFrequency=$( echo ${config_SRF_WriteFrequency} | sed -e 's/\([0-9]*[yYmMdDs]\).*/\1/' )  
    6567    case ${SRF_WriteFrequency} in 
    … …  
    108110            IGCM_debug_Verif_Exit ;; 
    109111    esac 
     112    SECHIBA_sed WRITE_STEP ${SECHIBA_WRITE_STEP} 
     113    SECHIBA_sed SECHIBA_HISTLEVEL ${sechiba_UserChoices_sechiba_LEVEL} 
     114 
     115    # Outputs HF in HISTFILE2 if required 
     116    if [ X${SRF_ok_hf} = Xy ] ; then 
     117        SECHIBA_sed SECHIBA_HISTFILE2 y 
     118        SECHIBA_sed SECHIBA_HISTLEVEL2 1 
     119        SECHIBA_sed WRITE_STEP2 10800.0 
     120    fi 
    110121 
    111122    SECHIBA_sed STOMATE_OK_CO2 ${sechiba_UserChoices_OKCO2} 
    … …  
    114125    SECHIBA_sed HYDROL_CWRR ${sechiba_UserChoices_NEWHYDROL} 
    115126 
    116     SECHIBA_sed WRITE_STEP ${SECHIBA_WRITE_STEP} 
    117     SECHIBA_sed SECHIBA_HISTLEVEL ${sechiba_UserChoices_sechiba_LEVEL} 
     127    if [ X${sechiba_UserChoices_IMPOSE_VEG} = Xn ] ; then 
     128        if [ X${sechiba_UserChoices_LAND_USE} = Xy ] ; then 
     129            SECHIBA_sed VEGET_UPDATE ${sechiba_UserChoices_VEGET_UPDATE} 
    118130 
    119     # Outputs HF in HISTFILE2 if required 
    120     [ X${SRF_ok_hf} = Xy ] && SECHIBA_sed SECHIBA_HISTFILE2 y 
    121     SECHIBA_sed SECHIBA_HISTLEVEL2 1 
    122     SECHIBA_sed WRITE_STEP2 10800.0 
    123  
    124     if [ X${sechiba_UserChoices_LAND_USE} = Xy ] ; then 
    125       SECHIBA_sed LAND_USE ${sechiba_UserChoices_LAND_USE} 
    126       SECHIBA_sed VEGET_UPDATE ${sechiba_UserChoices_VEGET_UPDATE} 
    127  
    128       ##MM : cutting PFTmaps of ORCHIDEE : for first year without restart, we must use this year map 
    129       ##     WARNING : the next year map must be avaible and the december month, then this device will 
    130       ##               only work with PeriodLength scrictly less than 1Y. 
    131       # If you want to come back to old BIG LAND USE file 
    132       # (to run on multipple years, just one time with LAND USE activated),  
    133       # you must  
    134       # comment all next 8 lines and check correct parameters in sechiba.def file 
    135       # for your LAND USE specific file. 
    136         SECHIBA_sed VEGET_REINIT y 
    137         if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
    138             SECHIBA_sed VEGET_YEAR 1 
    139         else 
    140             SECHIBA_sed VEGET_YEAR 0 
    141             IGCM_sys_Mv -f PFTmap_IPCC_${year_p1}.nc PFTmap.nc 
     131            ##MM : cutting PFTmaps of ORCHIDEE : for first year without restart, we must use this year map 
     132            ##     WARNING : the next year map must be avaible and the december month, then this device will 
     133            ##               only work with PeriodLength scrictly less than 1Y. 
     134            # If you want to come back to old BIG LAND USE file 
     135            # (to run on multipple years, just one time with LAND USE activated),  
     136            # you must  
     137            # comment all next 8 lines and check correct parameters in sechiba.def file 
     138            # for your LAND USE specific file. 
     139            SECHIBA_sed VEGET_REINIT y 
     140            if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
     141                SECHIBA_sed VEGET_YEAR 1 
     142            else 
     143                SECHIBA_sed VEGET_YEAR 0 
     144                IGCM_sys_Mv -f PFTmap_IPCC_${year_p1}.nc PFTmap.nc 
     145            fi 
     146        elif [ X${sechiba_UserChoices_OLD_VEGET} = Xy ] ; then 
     147            SECHIBA_sed LAND_USE n 
    142148        fi 
     149    else 
     150        SECHIBA_sed IMPOSE_VEG y 
    143151    fi 
    144152 
    145     SECHIBA_sed IMPOSE_VEG ${sechiba_UserChoices_IMPOSE_VEG} 
    146      
    147153    if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
    148154        SECHIBA_sed SECHIBA_reset_time y 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC/POST/monitoring01_sechiba.cfg

    r119 r405  
    4848snownobio_lands | "snownobio"      |  ""               | "snownobio[d=1]"                 | "Snow Other Surfaces (LANDS)"  | "kg/m^2" | "Areas[d=1]*Contfrac[d=1]" 
    4949snowf_lands    | "snowf"           |  ""               | "snowf[d=1]"                     | "Snowfall (LANDS)"             | "mm/d"   | "Areas[d=1]*Contfrac[d=1]" 
    50 vegetn_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
    51 vegetg_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
    52 vegeta_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
    53 maxveget_lands | "maxvegetfrac"    |  ""               | "maxvegetfrac[d=1,K=12:13]"      | "vegetmax[pft=12,13] (LANDS)"      | "1"      | "2" 
    54 lai_lands      | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2:13]*maxvegetfrac[d=2,K=2:13])"  | "lai (LANDS)"      | "1"      | "2" 
    55 # lai2_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2]*maxvegetfrac[d=2,K=2])" | "lai (LANDS)"      | "1"      | "2" 
    56 # lai3_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=3]*maxvegetfrac[d=2,K=3])" | "lai (LANDS)"      | "1"      | "2" 
    57 # lai4_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=4]*maxvegetfrac[d=2,K=4])" | "lai (LANDS)"      | "1"      | "2" 
    58 # lai5_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=5]*maxvegetfrac[d=2,K=5])" | "lai (LANDS)"      | "1"      | "2" 
    59 # lai6_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=6]*maxvegetfrac[d=2,K=6])" | "lai (LANDS)"      | "1"      | "2" 
    60 # lai7_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=7]*maxvegetfrac[d=2,K=7])" | "lai (LANDS)"      | "1"      | "2" 
    61 # lai8_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=8]*maxvegetfrac[d=2,K=8])" | "lai (LANDS)"      | "1"      | "2" 
    62 # lai9_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=9]*maxvegetfrac[d=2,K=9])" | "lai (LANDS)"      | "1"      | "2" 
    63 # lai10_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=10]*maxvegetfrac[d=2,K=10])" | "lai (LANDS)"      | "1"      | "2" 
    64 # lai11_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=11]*maxvegetfrac[d=2,K=11])" | "lai (LANDS)"      | "1"      | "2" 
    65 # lai12_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=12]*maxvegetfrac[d=2,K=12])" | "lai (LANDS)"      | "1"      | "2" 
    66 # lai13_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=13]*maxvegetfrac[d=2,K=13])" | "lai (LANDS)"      | "1"      | "2" 
     50vegetn_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
     51vegetg_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
     52vegeta_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
     53maxveget_lands | "maxvegetfrac"   |  ""              | "((maxvegetfrac[d=1,K=12]+maxvegetfrac[d=1,K=13])*Areas[d=1]*Contfrac[d=1]/1e12)" | "maxveget surface[pft=12+13] "  | "Mkm^2"  | "2" 
     54nee_lands      | "nee maxvegetfrac" |  ""              | "(nee[d=1]*365*86400*maxvegetfrac[d=2]*Areas[d=1]*Contfrac[d=1]/1e15)"  | "Net Ecosystem Exchange"    | "PgC/yr" | "2" 
     55lai_lands      | "lai"              |  ""              | "(lai[d=1,K=2:13])"                      | "lai (LANDS)"      | "1"      | "2" 
     56# lai2_lands     | "lai"              |  ""              | "(lai[d=1,K=2])" | "lai (LANDS)"      | "1"      | "2" 
     57# lai3_lands     | "lai"              |  ""              | "(lai[d=1,K=3])" | "lai (LANDS)"      | "1"      | "2" 
     58# lai4_lands     | "lai"              |  ""              | "(lai[d=1,K=4])" | "lai (LANDS)"      | "1"      | "2" 
     59# lai5_lands     | "lai"              |  ""              | "(lai[d=1,K=5])" | "lai (LANDS)"      | "1"      | "2" 
     60# lai6_lands     | "lai"              |  ""              | "(lai[d=1,K=6])" | "lai (LANDS)"      | "1"      | "2" 
     61# lai7_lands     | "lai"              |  ""              | "(lai[d=1,K=7])" | "lai (LANDS)"      | "1"      | "2" 
     62# lai8_lands     | "lai"              |  ""              | "(lai[d=1,K=8])" | "lai (LANDS)"      | "1"      | "2" 
     63# lai9_lands     | "lai"              |  ""              | "(lai[d=1,K=9])" | "lai (LANDS)"      | "1"      | "2" 
     64# lai10_lands    | "lai"              |  ""              | "(lai[d=1,K=10])" | "lai (LANDS)"     | "1"      | "2" 
     65# lai11_lands    | "lai"              |  ""              | "(lai[d=1,K=11])" | "lai (LANDS)"     | "1"      | "2" 
     66# lai12_lands    | "lai"              |  ""              | "(lai[d=1,K=12])" | "lai (LANDS)"     | "1"      | "2" 
     67# lai13_lands    | "lai"              |  ""              | "(lai[d=1,K=13])" | "lai (LANDS)"     | "1"      | "2" 
    6768#------------------------------------------------------------------------------------------------------------------------------------------------------ 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC/POST/monitoring01_sechiba_LAND_USE_and_LAI_PFTs.cfg

    r119 r405  
    4848snownobio_lands | "snownobio"      |  ""               | "snownobio[d=1]"                 | "Snow Other Surfaces (LANDS)"  | "kg/m^2" | "Areas[d=1]*Contfrac[d=1]" 
    4949snowf_lands    | "snowf"           |  ""               | "snowf[d=1]"                     | "Snowfall (LANDS)"             | "mm/d"   | "Areas[d=1]*Contfrac[d=1]" 
    50 vegetn_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
    51 vegetg_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
    52 vegeta_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
     50vegetn_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
     51vegetg_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
     52vegeta_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
    5353maxveget_lands | "maxvegetfrac"    |  ""               | "maxvegetfrac[d=1,K=12:13]"      | "vegetmax[pft=12,13] (LANDS)"      | "1"      | "2" 
     54maxveget_forcing | "maxvegetfrac"   |  ""              | "((maxvegetfrac[d=1,K=12]+maxvegetfrac[d=1,K=13])*Areas[d=1]*Contfrac[d=1]/1e12)" | "maxveget surface[pft=12,13] "  | "Mkm^2"  | "2" 
    5455lai_lands      | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2:13]*maxvegetfrac[d=2,K=2:13])"  | "lai (LANDS)"      | "1"      | "2" 
    55 lai2_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2]*maxvegetfrac[d=2,K=2])" | "lai (LANDS)"      | "1"      | "2" 
    56 lai3_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=3]*maxvegetfrac[d=2,K=3])" | "lai (LANDS)"      | "1"      | "2" 
    57 lai4_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=4]*maxvegetfrac[d=2,K=4])" | "lai (LANDS)"      | "1"      | "2" 
    58 lai5_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=5]*maxvegetfrac[d=2,K=5])" | "lai (LANDS)"      | "1"      | "2" 
    59 lai6_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=6]*maxvegetfrac[d=2,K=6])" | "lai (LANDS)"      | "1"      | "2" 
    60 lai7_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=7]*maxvegetfrac[d=2,K=7])" | "lai (LANDS)"      | "1"      | "2" 
    61 lai8_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=8]*maxvegetfrac[d=2,K=8])" | "lai (LANDS)"      | "1"      | "2" 
    62 lai9_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=9]*maxvegetfrac[d=2,K=9])" | "lai (LANDS)"      | "1"      | "2" 
    63 lai10_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=10]*maxvegetfrac[d=2,K=10])" | "lai (LANDS)"      | "1"      | "2" 
    64 lai11_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=11]*maxvegetfrac[d=2,K=11])" | "lai (LANDS)"      | "1"      | "2" 
    65 lai12_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=12]*maxvegetfrac[d=2,K=12])" | "lai (LANDS)"      | "1"      | "2" 
    66 lai13_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=13]*maxvegetfrac[d=2,K=13])" | "lai (LANDS)"      | "1"      | "2" 
     56nee_lands      | "nee maxvegetfrac" |  ""              | "(nee[d=1]*365*86400*maxvegetfrac[d=2]*Areas[d=1]*Contfrac[d=1]/1e15)"  | "Net Ecosystem Exchange"    | "PgC/yr" | "2" 
     57lai2_lands     | "lai"              |  ""              | "(lai[d=1,K=2])" | "lai (LANDS)"      | "1"      | "2" 
     58lai3_lands     | "lai"              |  ""              | "(lai[d=1,K=3])" | "lai (LANDS)"      | "1"      | "2" 
     59lai4_lands     | "lai"              |  ""              | "(lai[d=1,K=4])" | "lai (LANDS)"      | "1"      | "2" 
     60lai5_lands     | "lai"              |  ""              | "(lai[d=1,K=5])" | "lai (LANDS)"      | "1"      | "2" 
     61lai6_lands     | "lai"              |  ""              | "(lai[d=1,K=6])" | "lai (LANDS)"      | "1"      | "2" 
     62lai7_lands     | "lai"              |  ""              | "(lai[d=1,K=7])" | "lai (LANDS)"      | "1"      | "2" 
     63lai8_lands     | "lai"              |  ""              | "(lai[d=1,K=8])" | "lai (LANDS)"      | "1"      | "2" 
     64lai9_lands     | "lai"              |  ""              | "(lai[d=1,K=9])" | "lai (LANDS)"      | "1"      | "2" 
     65lai10_lands    | "lai"              |  ""              | "(lai[d=1,K=10])" | "lai (LANDS)"     | "1"      | "2" 
     66lai11_lands    | "lai"              |  ""              | "(lai[d=1,K=11])" | "lai (LANDS)"     | "1"      | "2" 
     67lai12_lands    | "lai"              |  ""              | "(lai[d=1,K=12])" | "lai (LANDS)"     | "1"      | "2" 
     68lai13_lands    | "lai"              |  ""              | "(lai[d=1,K=13])" | "lai (LANDS)"     | "1"      | "2" 
    6769#------------------------------------------------------------------------------------------------------------------------------------------------------ 
    68 # lai2_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=2]*maxvegetfrac[d=2,K=2]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    69 # lai3_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=3]*maxvegetfrac[d=2,K=3]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    70 # lai4_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=4]*maxvegetfrac[d=2,K=4]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    71 # lai5_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=5]*maxvegetfrac[d=2,K=5]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    72 # lai6_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=6]*maxvegetfrac[d=2,K=6]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    73 # lai7_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=7]*maxvegetfrac[d=2,K=7]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    74 # lai8_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=8]*maxvegetfrac[d=2,K=8]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    75 # lai9_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=9]*maxvegetfrac[d=2,K=9]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    76 # lai10_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=10]*maxvegetfrac[d=2,K=10]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    77 # lai11_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=11]*maxvegetfrac[d=2,K=11]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    78 # lai12_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=12]*maxvegetfrac[d=2,K=12]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    79 # lai13_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=13]*maxvegetfrac[d=2,K=13]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/COMP/orchidee_ol.card

    r119 r405  
    88# If you want to use the same forcing file 
    99NORESTART=n 
     10# If you want use config.card PeriodLength for TIME_LENGTH 
     11TIMELENGTH=y 
    1012 
    1113[InitialStateFiles] 
    … …  
    2830 
    2931[OutputText] 
    30 List=   (used_driver.def, out_orchidee_ol) 
     32List=   (used_driver.def, used_run.def, out_orchidee_ol) 
    3133# avec la // : out_orchidee_* 
    3234 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/COMP/orchidee_ol.driver

    r119 r405  
    4545    IGCM_debug_PushStack "OOL_Update" 
    4646 
    47     case ${config_UserChoices_PeriodLength} in 
    48         *Y|*y|*M|*m|*D|*d) 
    49             DRIVER_sed TIME_LENGTH ${PeriodLengthInDays}D 
    50             ;; 
    51         *s) 
    52             DRIVER_sed TIME_LENGTH ${config_UserChoices_PeriodLength} 
    53     esac 
     47    if [ X"${orchidee_ol_UserChoices_TIMELENGTH}" = Xy ] ; then 
     48        case ${config_UserChoices_PeriodLength} in 
     49            *Y|*y|*M|*m|*D|*d) 
     50                DRIVER_sed TIME_LENGTH ${PeriodLengthInDays}D 
     51                ;; 
     52            *s) 
     53                DRIVER_sed TIME_LENGTH ${config_UserChoices_PeriodLength} 
     54        esac 
     55    fi 
    5456 
    5557    if ( ${FirstInitialize} ) ; then 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/COMP/sechiba.card

    r119 r405  
    55LAIMAP=n 
    66IMPOSE_VEG=n 
     7# if IMPOSE_VEG = n 
    78LAND_USE=n 
     9# if LAND_USE=y 
    810VEGET_UPDATE=1Y 
     11# if LAND_USE=n and we want to use carteveg5km.nc for maxvegetfrac map. 
     12# (instead of default PFTmap_1850to2005_AR5_LUHa.rc2 below) 
     13OLD_VEGET=n 
    914ROUTING=n 
    1015NEWHYDROL=n 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/COMP/sechiba.driver

    r119 r405  
    2626    RESOL_SRF=ALL 
    2727     
     28    typeset frequency 
    2829    for frequency in ${config_SRF_WriteFrequency} ; do 
    2930        case ${frequency} in 
    … …  
    6263    typeset SECHIBA_WRITE_STEP 
    6364 
     65    # Get WriteFrenquecies from config.card for SECHIBA 
    6466    SRF_WriteFrequency=$( echo ${config_SRF_WriteFrequency} | sed -e 's/\([0-9]*[yYmMdDs]\).*/\1/' )  
    6567    case ${SRF_WriteFrequency} in 
    … …  
    108110            IGCM_debug_Verif_Exit ;; 
    109111    esac 
    110  
    111     SECHIBA_sed STOMATE_OK_CO2 ${sechiba_UserChoices_OKCO2} 
    112  
    113     SECHIBA_sed RIVER_ROUTING ${sechiba_UserChoices_ROUTING} 
    114     SECHIBA_sed HYDROL_CWRR ${sechiba_UserChoices_NEWHYDROL} 
    115  
    116112    SECHIBA_sed WRITE_STEP ${SECHIBA_WRITE_STEP} 
    117113    SECHIBA_sed SECHIBA_HISTLEVEL ${sechiba_UserChoices_sechiba_LEVEL} 
    … …  
    122118    SECHIBA_sed WRITE_STEP2 10800.0 
    123119 
    124     if [ X${sechiba_UserChoices_LAND_USE} = Xy ] ; then 
    125       SECHIBA_sed LAND_USE ${sechiba_UserChoices_LAND_USE} 
    126       SECHIBA_sed VEGET_UPDATE ${sechiba_UserChoices_VEGET_UPDATE} 
     120    SECHIBA_sed STOMATE_OK_CO2 ${sechiba_UserChoices_OKCO2} 
    127121 
    128       ##MM : cutting PFTmaps of ORCHIDEE : for first year without restart, we must use this year map 
    129       ##     WARNING : the next year map must be avaible and the december month, then this device will 
    130       ##               only work with PeriodLength scrictly less than 1Y. 
    131       # If you want to come back to old BIG LAND USE file 
    132       # (to run on multipple years, just one time with LAND USE activated),  
    133       # you must  
    134       # comment all next 8 lines and check correct parameters in sechiba.def file 
    135       # for your LAND USE specific file. 
    136         SECHIBA_sed VEGET_REINIT y 
    137         if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
    138             SECHIBA_sed VEGET_YEAR 1 
    139         else 
    140             SECHIBA_sed VEGET_YEAR 0 
    141             IGCM_sys_Mv -f PFTmap_IPCC_${year_p1}.nc PFTmap.nc 
     122    SECHIBA_sed RIVER_ROUTING ${sechiba_UserChoices_ROUTING} 
     123    SECHIBA_sed HYDROL_CWRR ${sechiba_UserChoices_NEWHYDROL} 
     124 
     125    if [ X${sechiba_UserChoices_IMPOSE_VEG} = Xn ] ; then 
     126        if [ X${sechiba_UserChoices_LAND_USE} = Xy ] ; then 
     127            SECHIBA_sed VEGET_UPDATE ${sechiba_UserChoices_VEGET_UPDATE} 
     128 
     129            ##MM : cutting PFTmaps of ORCHIDEE : for first year without restart, we must use this year map 
     130            ##     WARNING : the next year map must be avaible and the december month, then this device will 
     131            ##               only work with PeriodLength scrictly less than 1Y. 
     132            # If you want to come back to old BIG LAND USE file 
     133            # (to run on multipple years, just one time with LAND USE activated),  
     134            # you must  
     135            # comment all next 8 lines and check correct parameters in sechiba.def file 
     136            # for your LAND USE specific file. 
     137            SECHIBA_sed VEGET_REINIT y 
     138            if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
     139                SECHIBA_sed VEGET_YEAR 1 
     140            else 
     141                SECHIBA_sed VEGET_YEAR 0 
     142                IGCM_sys_Mv -f PFTmap_IPCC_${year_p1}.nc PFTmap.nc 
     143            fi 
     144        elif [ X${sechiba_UserChoices_OLD_VEGET} = Xy ] ; then 
     145            SECHIBA_sed LAND_USE n 
    142146        fi 
     147    else 
     148        SECHIBA_sed IMPOSE_VEG y 
    143149    fi 
    144150 
    145     SECHIBA_sed IMPOSE_VEG ${sechiba_UserChoices_IMPOSE_VEG} 
    146      
    147151    if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
    148152        SECHIBA_sed SECHIBA_reset_time y 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/COMP/stomate.card

    r119 r405  
    3838TimeSeriesVars2D= (T2M_MONTH,CONTFRAC,RESOLUTION_X,RESOLUTION_Y,CONVFLUX,CFLUX_PROD10,CFLUX_PROD100,CO2FLUX_MONTHLY_SUM,HARVEST_ABOVE) 
    3939ChunckJob2D = NONE 
    40 TimeSeriesVars3D = (CO2FLUX,LAI,VEGET,VEGET_MAX,NPP,GPP,HET_RESP,MAINT_RESP,GROWTH_RESP,AGE,HEIGHT,TOTAL_M,TOTAL_BM_LITTER,TOTAL_SOIL_CARB) 
     40TimeSeriesVars3D= (CO2FLUX,LAI,VEGET,VEGET_MAX,NPP,GPP,HET_RESP,MAINT_RESP,GROWTH_RESP,AGE,HEIGHT,TOTAL_M,TOTAL_BM_LITTER,TOTAL_SOIL_CARB,ADAPTATION,REGENERATION) 
    4141ChunckJob3D = NONE 
    4242Seasonal=ON 
    … …  
    4545Patches= () 
    4646GatherWithInternal= (lon, lat, PFT, time_counter, Areas) 
    47 TimeSeriesVars2D=(cVeg, cLitter, cSoil, cProduct, lai, gpp, ra, npp, rh, fFire, fHarvest, fLuc, nbp, fVegLitter, fLitterSoil, cLeaf, cWood, cRoot, cMisc, cLitterAbove, cLitterBelow, cSoilFast, cSoilMedium, cSoilSlow, landCoverFrac, treeFracPrimDec, treeFracPrimEver, c3PftFrac, c4PftFrac, rGrowth, rMaint, nppLeaf, nppWood, nppRoot, nep) 
     47TimeSeriesVars2D=(cVeg, cLitter, cSoil, cProduct, cMassVariation, lai, gpp, ra, npp, rh, fFire, fHarvest, fLuc, nbp, fVegLitter, fLitterSoil, cLeaf, cWood, cRoot, cMisc, cLitterAbove, cLitterBelow, cSoilFast, cSoilMedium, cSoilSlow, landCoverFrac, treeFracPrimDec, treeFracPrimEver, c3PftFrac, c4PftFrac, rGrowth, rMaint, nppLeaf, nppWood, nppRoot, nep) 
    4848ChunckJob2D = NONE 
    4949TimeSeriesVars3D=() 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/COMP/stomate.driver

    r119 r405  
    2323 
    2424    RESOL_SBG=ALL 
     25 
     26    typeset frequency 
     27    for frequency in ${config_SBG_WriteFrequency} ; do 
     28        case ${frequency} in 
     29            HF|hf) SBG_ok_hf=y ;; 
     30        esac 
     31    done 
    2532     
    2633    IGCM_debug_PopStack "SBG_Initialize" 
     34} 
     35 
     36#----------------------------------------------------------------- 
     37function SBG_PeriodStart 
     38{ 
     39    IGCM_debug_PushStack "SBG_PeriodStart" 
     40 
     41    IGCM_debug_PopStack "SBG_PeriodStart" 
    2742} 
    2843 
    … …  
    86101    fi 
    87102 
     103    if [ X${SBG_ok_hf} = Xy ] ; then  
     104        STOMATE_sed STOMATE_IPCC_HIST_DT 1D 
     105    else 
     106        STOMATE_sed STOMATE_IPCC_HIST_DT ${STOMATE_WRITE_STEP} 
     107    fi 
     108 
    88109    IGCM_debug_PopStack "SBG_Update" 
    89110} 
    … …  
    92113function SBG_Finalize 
    93114{ 
    94 #set -vx 
    95115    IGCM_debug_PushStack "SBG_Finalize" 
    96116 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/POST/monitoring01_sechiba.cfg

    r119 r405  
    4848snownobio_lands | "snownobio"      |  ""               | "snownobio[d=1]"                 | "Snow Other Surfaces (LANDS)"  | "kg/m^2" | "Areas[d=1]*Contfrac[d=1]" 
    4949snowf_lands    | "snowf"           |  ""               | "snowf[d=1]"                     | "Snowfall (LANDS)"             | "mm/d"   | "Areas[d=1]*Contfrac[d=1]" 
    50 vegetn_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
    51 vegetg_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
    52 vegeta_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
    53 maxveget_lands | "maxvegetfrac"    |  ""               | "maxvegetfrac[d=1,K=12:13]"      | "vegetmax[pft=12,13] (LANDS)"      | "1"      | "2" 
    54 lai_lands      | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2:13]*maxvegetfrac[d=2,K=2:13])"  | "lai (LANDS)"      | "1"      | "2" 
    55 # lai2_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2]*maxvegetfrac[d=2,K=2])" | "lai (LANDS)"      | "1"      | "2" 
    56 # lai3_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=3]*maxvegetfrac[d=2,K=3])" | "lai (LANDS)"      | "1"      | "2" 
    57 # lai4_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=4]*maxvegetfrac[d=2,K=4])" | "lai (LANDS)"      | "1"      | "2" 
    58 # lai5_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=5]*maxvegetfrac[d=2,K=5])" | "lai (LANDS)"      | "1"      | "2" 
    59 # lai6_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=6]*maxvegetfrac[d=2,K=6])" | "lai (LANDS)"      | "1"      | "2" 
    60 # lai7_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=7]*maxvegetfrac[d=2,K=7])" | "lai (LANDS)"      | "1"      | "2" 
    61 # lai8_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=8]*maxvegetfrac[d=2,K=8])" | "lai (LANDS)"      | "1"      | "2" 
    62 # lai9_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=9]*maxvegetfrac[d=2,K=9])" | "lai (LANDS)"      | "1"      | "2" 
    63 # lai10_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=10]*maxvegetfrac[d=2,K=10])" | "lai (LANDS)"      | "1"      | "2" 
    64 # lai11_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=11]*maxvegetfrac[d=2,K=11])" | "lai (LANDS)"      | "1"      | "2" 
    65 # lai12_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=12]*maxvegetfrac[d=2,K=12])" | "lai (LANDS)"      | "1"      | "2" 
    66 # lai13_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=13]*maxvegetfrac[d=2,K=13])" | "lai (LANDS)"      | "1"      | "2" 
     50vegetn_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
     51vegetg_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
     52vegeta_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
     53maxveget_lands | "maxvegetfrac"   |  ""              | "((maxvegetfrac[d=1,K=12]+maxvegetfrac[d=1,K=13])*Areas[d=1]*Contfrac[d=1]/1e12)" | "maxveget surface[pft=12+13] "  | "Mkm^2"  | "2" 
     54nee_lands      | "nee maxvegetfrac" |  ""              | "(nee[d=1]*365*86400*maxvegetfrac[d=2]*Areas[d=1]*Contfrac[d=1]/1e15)"  | "Net Ecosystem Exchange"    | "PgC/yr" | "2" 
     55lai_lands      | "lai"              |  ""              | "(lai[d=1,K=2:13])"                      | "lai (LANDS)"      | "1"      | "2" 
     56# lai2_lands     | "lai"              |  ""              | "(lai[d=1,K=2])" | "lai (LANDS)"      | "1"      | "2" 
     57# lai3_lands     | "lai"              |  ""              | "(lai[d=1,K=3])" | "lai (LANDS)"      | "1"      | "2" 
     58# lai4_lands     | "lai"              |  ""              | "(lai[d=1,K=4])" | "lai (LANDS)"      | "1"      | "2" 
     59# lai5_lands     | "lai"              |  ""              | "(lai[d=1,K=5])" | "lai (LANDS)"      | "1"      | "2" 
     60# lai6_lands     | "lai"              |  ""              | "(lai[d=1,K=6])" | "lai (LANDS)"      | "1"      | "2" 
     61# lai7_lands     | "lai"              |  ""              | "(lai[d=1,K=7])" | "lai (LANDS)"      | "1"      | "2" 
     62# lai8_lands     | "lai"              |  ""              | "(lai[d=1,K=8])" | "lai (LANDS)"      | "1"      | "2" 
     63# lai9_lands     | "lai"              |  ""              | "(lai[d=1,K=9])" | "lai (LANDS)"      | "1"      | "2" 
     64# lai10_lands    | "lai"              |  ""              | "(lai[d=1,K=10])" | "lai (LANDS)"     | "1"      | "2" 
     65# lai11_lands    | "lai"              |  ""              | "(lai[d=1,K=11])" | "lai (LANDS)"     | "1"      | "2" 
     66# lai12_lands    | "lai"              |  ""              | "(lai[d=1,K=12])" | "lai (LANDS)"     | "1"      | "2" 
     67# lai13_lands    | "lai"              |  ""              | "(lai[d=1,K=13])" | "lai (LANDS)"     | "1"      | "2" 
    6768#------------------------------------------------------------------------------------------------------------------------------------------------------ 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/POST/monitoring01_sechiba_LAND_USE_and_LAI_PFTs.cfg

    r119 r405  
    4848snownobio_lands | "snownobio"      |  ""               | "snownobio[d=1]"                 | "Snow Other Surfaces (LANDS)"  | "kg/m^2" | "Areas[d=1]*Contfrac[d=1]" 
    4949snowf_lands    | "snowf"           |  ""               | "snowf[d=1]"                     | "Snowfall (LANDS)"             | "mm/d"   | "Areas[d=1]*Contfrac[d=1]" 
    50 vegetn_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
    51 vegetg_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
    52 vegeta_lands   | "_vegetfrac"      |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
     50vegetn_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=2:9]"           | "veget natural (LANDS)"        | "1"      | "2" 
     51vegetg_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=10:11]"         | "veget natural grass (LANDS)"  | "1"      | "2" 
     52vegeta_lands   | "vegetfrac"       |  ""               | "vegetfrac[d=1,K=12:13]"         | "veget agriculture (LANDS)"    | "1"      | "2" 
    5353maxveget_lands | "maxvegetfrac"    |  ""               | "maxvegetfrac[d=1,K=12:13]"      | "vegetmax[pft=12,13] (LANDS)"      | "1"      | "2" 
     54maxveget_forcing | "maxvegetfrac"   |  ""              | "((maxvegetfrac[d=1,K=12]+maxvegetfrac[d=1,K=13])*Areas[d=1]*Contfrac[d=1]/1e12)" | "maxveget surface[pft=12,13] "  | "Mkm^2"  | "2" 
    5455lai_lands      | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2:13]*maxvegetfrac[d=2,K=2:13])"  | "lai (LANDS)"      | "1"      | "2" 
    55 lai2_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=2]*maxvegetfrac[d=2,K=2])" | "lai (LANDS)"      | "1"      | "2" 
    56 lai3_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=3]*maxvegetfrac[d=2,K=3])" | "lai (LANDS)"      | "1"      | "2" 
    57 lai4_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=4]*maxvegetfrac[d=2,K=4])" | "lai (LANDS)"      | "1"      | "2" 
    58 lai5_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=5]*maxvegetfrac[d=2,K=5])" | "lai (LANDS)"      | "1"      | "2" 
    59 lai6_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=6]*maxvegetfrac[d=2,K=6])" | "lai (LANDS)"      | "1"      | "2" 
    60 lai7_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=7]*maxvegetfrac[d=2,K=7])" | "lai (LANDS)"      | "1"      | "2" 
    61 lai8_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=8]*maxvegetfrac[d=2,K=8])" | "lai (LANDS)"      | "1"      | "2" 
    62 lai9_lands     | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=9]*maxvegetfrac[d=2,K=9])" | "lai (LANDS)"      | "1"      | "2" 
    63 lai10_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=10]*maxvegetfrac[d=2,K=10])" | "lai (LANDS)"      | "1"      | "2" 
    64 lai11_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=11]*maxvegetfrac[d=2,K=11])" | "lai (LANDS)"      | "1"      | "2" 
    65 lai12_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=12]*maxvegetfrac[d=2,K=12])" | "lai (LANDS)"      | "1"      | "2" 
    66 lai13_lands    | "lai maxvegetfrac"|  ""               | "(lai[d=1,K=13]*maxvegetfrac[d=2,K=13])" | "lai (LANDS)"      | "1"      | "2" 
     56nee_lands      | "nee maxvegetfrac" |  ""              | "(nee[d=1]*365*86400*maxvegetfrac[d=2]*Areas[d=1]*Contfrac[d=1]/1e15)"  | "Net Ecosystem Exchange"    | "PgC/yr" | "2" 
     57lai02_lands    | "lai"              |  ""              | "(lai[d=1,K=2])" | "lai (LANDS)"      | "1"      | "2" 
     58lai03_lands    | "lai"              |  ""              | "(lai[d=1,K=3])" | "lai (LANDS)"      | "1"      | "2" 
     59lai04_lands    | "lai"              |  ""              | "(lai[d=1,K=4])" | "lai (LANDS)"      | "1"      | "2" 
     60lai05_lands    | "lai"              |  ""              | "(lai[d=1,K=5])" | "lai (LANDS)"      | "1"      | "2" 
     61lai06_lands    | "lai"              |  ""              | "(lai[d=1,K=6])" | "lai (LANDS)"      | "1"      | "2" 
     62lai07_lands    | "lai"              |  ""              | "(lai[d=1,K=7])" | "lai (LANDS)"      | "1"      | "2" 
     63lai08_lands    | "lai"              |  ""              | "(lai[d=1,K=8])" | "lai (LANDS)"      | "1"      | "2" 
     64lai09_lands    | "lai"              |  ""              | "(lai[d=1,K=9])" | "lai (LANDS)"      | "1"      | "2" 
     65lai10_lands    | "lai"              |  ""              | "(lai[d=1,K=10])" | "lai (LANDS)"     | "1"      | "2" 
     66lai11_lands    | "lai"              |  ""              | "(lai[d=1,K=11])" | "lai (LANDS)"     | "1"      | "2" 
     67lai12_lands    | "lai"              |  ""              | "(lai[d=1,K=12])" | "lai (LANDS)"     | "1"      | "2" 
     68lai13_lands    | "lai"              |  ""              | "(lai[d=1,K=13])" | "lai (LANDS)"     | "1"      | "2" 
    6769#------------------------------------------------------------------------------------------------------------------------------------------------------ 
    68 # lai2_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=2]*maxvegetfrac[d=2,K=2]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    69 # lai3_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=3]*maxvegetfrac[d=2,K=3]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    70 # lai4_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=4]*maxvegetfrac[d=2,K=4]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    71 # lai5_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=5]*maxvegetfrac[d=2,K=5]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    72 # lai6_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=6]*maxvegetfrac[d=2,K=6]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    73 # lai7_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=7]*maxvegetfrac[d=2,K=7]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    74 # lai8_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=8]*maxvegetfrac[d=2,K=8]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    75 # lai9_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=9]*maxvegetfrac[d=2,K=9]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    76 # lai10_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=10]*maxvegetfrac[d=2,K=10]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    77 # lai11_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=11]*maxvegetfrac[d=2,K=11]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    78 # lai12_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=12]*maxvegetfrac[d=2,K=12]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 
    79 # lai13_lands      | "lai maxvegetfrac"             |  ""               | "lai[d=1,K=13]*maxvegetfrac[d=2,K=13]*Areas[d=1]*Contfrac[d=1]"          | "lai (LANDS)"      | "1"      | "2" 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/OOL_SEC_STO/POST/monitoring01_stomate.cfg

    r119 r405  
    8787nppRoot_lands          | "nppRoot"          | "" | "(nppRoot[d=1])"         | "CO2 Flux from Atmosphere due to NPP Allocation to Root" | "kg C m-2 s-1" | "Areas[d=1]" 
    8888nep_lands              | "nep"              | "" | "(nep[d=1])"             | "Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity." | "kg C m-2 s-1" | "Areas[d=1]" 
     89cMassVariation_lands     | "cMassVariation"     | "" | "(cMassVariation[d=1])"    | "Carbon Mass Variation"                         | "kg C m-2 s-1" | "Areas[d=1]" 
     90cBal_lands             | "cMassVariation nbp" | "" | "(cMassVariation[d=1,L=2:1000]-nbp[d=2,L=2:1000])" | "Total Carbon Balance"                    | "kg C m-2 s-1" | "Areas[d=1]" 
    8991#------------------------------------------------------------------------------------------------------------------------------------------------------ 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/SPINUP/COMP/spinup.card

    r119 r405  
    1616# If you want to use the same forcing file 
    1717DRIVER_NORESTART=n 
     18# If you want use config.card PeriodLength for TIME_LENGTH 
     19DRIVER_TIMELENGTH=y 
    1820 
    1921# 
    … …  
    115117#                          Qs, Qsb, Qsm, DelSoilMoist, DelSWE, DelIntercept, AvgSurfT, RadT, Albedo, SWE, SoilMoist, SoilWet, SoilTemp, PotEvap, \ 
    116118#                          ECanop, TVeg, ESoil, RootMoist, SubSnow, ACond, SnowFrac, SAlbedo, SnowDepth, dis, GPP) 
    117 stomate_TimeSeriesVars2D=(T2M_MONTH, CONTFRAC, RESOLUTION_X, RESOLUTION_Y, CONVFLUX, CFLUX_PROD10, CFLUX_PROD100,HARVEST_ABOVE) 
    118 stomate_TimeSeriesVars3D=(CO2FLUX_MONTHLY,LAI,VEGET,VEGET_MAX,NPP,GPP,HET_RESP,MAINT_RESP,GROWTH_RESP,AGE,HEIGHT,TOTAL_M,TOTAL_BM_LITTER,TOTAL_SOIL_CARB) 
     119stomate_TimeSeriesVars2D=(T2M_MONTH, CONTFRAC, RESOLUTION_X, RESOLUTION_Y, CONVFLUX, CFLUX_PROD10, CFLUX_PROD100,CO2FLUX_MONTHLY_SUM,HARVEST_ABOVE) 
     120stomate_TimeSeriesVars3D=(CO2FLUX,LAI,VEGET,VEGET_MAX,NPP,GPP,HET_RESP,MAINT_RESP,GROWTH_RESP,AGE,HEIGHT,TOTAL_M,TOTAL_BM_LITTER,TOTAL_SOIL_CARB,ADAPTATION,REGENERATION) 
    119121 
    120122# !!! DO NOT MODIFY spinup.card AFTER THIS LINE !!!  

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/SPINUP/COMP/spinup.driver

    r119 r405  
    6464    if [ ! -f ${SUBMIT_DIR}/output.card ] ; then 
    6565        IGCM_sys_Cp ${SUBMIT_DIR}/output.card_init ${SUBMIT_DIR}/output.card 
    66         IGCM_card_WriteOption ${SUBMIT_DIR}/output.card Global Path "${SUBMIT_DIR}" 
    6766        iter=0 
    6867    else 
    … …  
    7473        StageName=${output_Stage_StageName} 
    7574    fi 
     75    IGCM_card_WriteOption ${SUBMIT_DIR}/output.card Global Path "${SUBMIT_DIR}" 
    7676 
    7777    # Compute DateEnd for ALL SPINUP 
    … …  
    235235    fi 
    236236 
     237    if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
     238        gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
     239            ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
     240        IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
     241        chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
     242    fi 
     243 
    237244    IGCM_debug_PopStack "SPIN_Cp_Job" 
    238245} 
    … …  
    267274 
    268275    IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/orchidee_ol.card UserChoices NORESTART ${spinup_UserChoices_DRIVER_NORESTART} 
     276    IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/orchidee_ol.card UserChoices TIMELENGTH ${spinup_UserChoices_DRIVER_TIMELENGTH} 
    269277 
    270278    spinup_SubJobForcingFile_List0=${spinup_SubJobForcingFile_List[0]} > /dev/null 2>&1 
    … …  
    291299 
    292300    IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card UserChoices sechiba_LEVEL ${spinup_UserChoices_sechiba_LEVEL} 
    293     spinup_SubJobPost_sechiba_TimeSeriesVars0=${spinup_SubJobPost_sechiba_TimeSeriesVars2D[0]} > /dev/null 2>&1 
     301    spinup_SubJobPost_sechiba_TimeSeriesVars0=${spinup_SubJobPost_sechiba_TimeSeriesVars2D[0]} 
    294302    if [ X${spinup_SubJobPost_sechiba_TimeSeriesVars0} != X${NULL_STR} ] ; then 
    295         IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card Post_1M_sechiba_history TimeSeriesVars2D "("$( echo ${spinup_SubJobPost_sechiba_TimeSeriesVars[@]} | sed -e "s/ /,/g" )")" 
     303        IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card Post_1M_sechiba_history TimeSeriesVars2D "("$( echo ${spinup_SubJobPost_sechiba_TimeSeriesVars2D[@]} | sed -e "s/ /,/g" )")" 
    296304    else 
    297305        IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card Post_1M_sechiba_history TimeSeriesVars2D "()" 
    298306    fi 
    299     spinup_SubJobPost_sechiba_TimeSeriesVars0=${spinup_SubJobPost_sechiba_TimeSeriesVars3D[0]} > /dev/null 2>&1 
     307    spinup_SubJobPost_sechiba_TimeSeriesVars0=${spinup_SubJobPost_sechiba_TimeSeriesVars3D[0]} 
    300308    if [ X${spinup_SubJobPost_sechiba_TimeSeriesVars0} != X${NULL_STR} ] ; then 
    301         IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card Post_1M_sechiba_history TimeSeriesVars3D "("$( echo ${spinup_SubJobPost_sechiba_TimeSeriesVars[@]} | sed -e "s/ /,/g" )")" 
     309        IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card Post_1M_sechiba_history TimeSeriesVars3D "("$( echo ${spinup_SubJobPost_sechiba_TimeSeriesVars3D[@]} | sed -e "s/ /,/g" )")" 
    302310    else 
    303311        IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card Post_1M_sechiba_history TimeSeriesVars3D "()" 
    … …  
    328336    # Nb years for forcing FORCESOIL 
    329337    STOMATE_sed FORCESOIL_NB_YEAR ${PeriodLengthInYears} 
     338    STOMATE_sed FORCESOIL_STEP_PER_YEAR 365 
     339    # Force creation of stomate_forcing.nc and stomate_Cforcing files 
     340    STOMATE_sed STOMATE_FORCING_NAME stomate_forcing.nc 
     341    STOMATE_sed STOMATE_CFORCING_NAME stomate_Cforcing.nc 
    330342     
    331343    IGCM_debug_PopStack "SPIN_OptionsStomate" 
    … …  
    575587            SPIN_Cp_Job ${spinup_UserChoices_SubJobPath}/OOL_SEC ${ExtName} 
    576588 
    577             # For some jobs : 
    578             if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
    579                 IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card UserChoices JobNumProcTot ${config_UserChoices_JobNumProcTot} 
    580                 gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
    581                     ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
    582                 IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
    583                 chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
    584                 if [ X"${config_UserChoices_JobRunOptions}" != X ] ; then 
    585                     sed -e "s/^JobRunOptions=.*/JobRunOptions=\'${config_UserChoices_JobRunOptions}\'/" ${New_SUBMIT_DIR}/config.card > temp.card 
    586                     IGCM_sys_Mv temp.card ${New_SUBMIT_DIR}/config.card  
    587                 fi 
    588             fi 
    589              
    590589            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF Restart n 
    591590     
    … …  
    604603            SPIN_Cp_Job ${spinup_UserChoices_SubJobPath}/OOL_SEC_STO ${ExtName} 
    605604 
    606             # For some jobs : 
    607             if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
    608                 IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card UserChoices JobNumProcTot ${config_UserChoices_JobNumProcTot} 
    609                 gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
    610                     ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
    611                 IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
    612                 chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
    613                 if [ X"${config_UserChoices_JobRunOptions}" != X ] ; then 
    614                     sed -e "s/^JobRunOptions=.*/JobRunOptions=\'${config_UserChoices_JobRunOptions}\'/" ${New_SUBMIT_DIR}/config.card > temp.card 
    615                     IGCM_sys_Mv temp.card ${New_SUBMIT_DIR}/config.card  
    616                 fi 
    617             fi 
    618              
    619605            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF Restart n 
    620606            if [ X"${spinup_UserChoices_ok_stomate}" = "Xy" ] ; then 
    … …  
    644630            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Restarts OverRule n 
    645631            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF Restart y 
    646             IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF RestartDate $( IGCM_date_ConvertFormatToHuman ${output_PreviousStage_LastRestartDate} ) 
     632            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF RestartDate ${output_PreviousStage_LastRestartDate} 
    647633            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG Restart y 
    648             IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG RestartDate $( IGCM_date_ConvertFormatToHuman ${output_PreviousStage_LastRestartDate} ) 
     634            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG RestartDate ${output_PreviousStage_LastRestartDate} 
    649635 
    650636            # Define restart simulation name 
    … …  
    660646 
    661647            # We Get the forcing file from the previous run of ORCHIDEE 
    662             ORCHIDEE_JobName=${LastJobName} 
    663             sed -e "s&(\${config_SBG_RestartPath}/\${config_SBG_RestartJobName}/SBG/Restart/\${config_SBG_RestartJobName}_\${Date_Restarts}_stomate_forcing.nc, stomate_forcing.nc)&(${config_SBG_RestartPath}/${ORCHIDEE_JobName}/SBG/Restart/${ORCHIDEE_JobName}_${output_PreviousStage_LastRestartDate}_stomate_forcing.nc, stomate_forcing.nc)&" ${New_SUBMIT_DIR}/COMP/sechiba.card > sechiba.card.tmp 
     648            sed -e "s&(\${config_SBG_RestartPath}/\${config_SBG_RestartJobName}/SBG/Restart/\${config_SBG_RestartJobName}_\${Date_Restarts}_stomate_forcing.nc, stomate_forcing.nc)&(${config_SBG_RestartPath}/${LastJobName}/SBG/Restart/${LastJobName}_${output_PreviousStage_LastRestartDate}_stomate_forcing.nc, stomate_forcing.nc)&" ${New_SUBMIT_DIR}/COMP/sechiba.card > sechiba.card.tmp 
    664649            IGCM_sys_Mv sechiba.card.tmp ${New_SUBMIT_DIR}/COMP/sechiba.card 
    665650 
    666651            IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card UserChoices IMPOSE_VEG ${spinup_UserChoices_impose_veg} 
    667652            IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card UserChoices LAND_USE ${spinup_UserChoices_land_use} 
     653 
     654            typeset option 
     655            for option in ${config_SubJobPost[*]} ; do 
     656                eval value=\${config_SubJobPost_${option}} 
     657                eval echo ${option} ${value} 
     658                if [ X${value} != X ] ; then 
     659                    eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Post ${option} \${config_SubJobPost_${option}} 
     660                fi 
     661            done 
     662            eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Post RebuildFrequency ${config_SubJob_PeriodLength} 
     663            eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Post TimeSeriesFrequency ${config_SubJob_PeriodLength} 
    668664 
    669665            SPIN_OptionsStomate 
    … …  
    682678            else 
    683679                SPIN_Cp_Job ${spinup_UserChoices_SubJobPath}/OOL_SEC ${ExtName} 
    684             fi 
    685  
    686             # For some jobs : 
    687             if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
    688                 IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card UserChoices JobNumProcTot ${config_UserChoices_JobNumProcTot} 
    689                 gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
    690                     ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
    691                 IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
    692                 chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
    693                 if [ X"${config_UserChoices_JobRunOptions}" != X ] ; then 
    694                     sed -e "s/^JobRunOptions=.*/JobRunOptions=\'${config_UserChoices_JobRunOptions}\'/" ${New_SUBMIT_DIR}/config.card > temp.card 
    695                     IGCM_sys_Mv temp.card ${New_SUBMIT_DIR}/config.card  
    696                 fi 
    697680            fi 
    698681 
    … …  
    751734            fi 
    752735 
     736            SPIN_OptionsSechiba 
    753737            if [ X"${spinup_UserChoices_ok_stomate}" = "Xy" ] ; then 
    754                 SPIN_OptionsSechiba 
    755738                SPIN_OptionsStomate 
    756             else 
    757                 SPIN_OptionsSechiba 
    758739            fi 
    759740 
    … …  
    774755            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Restarts OverRule n 
    775756            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF Restart y 
    776             IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF RestartDate $( IGCM_date_ConvertFormatToHuman ${output_PreviousStage_LastRestartDate} ) 
     757            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF RestartDate ${output_PreviousStage_LastRestartDate} 
    777758            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG Restart y 
    778             IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG RestartDate $( IGCM_date_ConvertFormatToHuman ${output_PreviousStage_LastRestartDate} ) 
     759            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG RestartDate ${output_PreviousStage_LastRestartDate} 
    779760 
    780761            # Define restart simulation name 
    … …  
    788769 
    789770            # We Get the forcing file from the previous run of ORCHIDEE 
    790             ORCHIDEE_JobName=${config_UserChoices_JobName}ORC_${iter} 
    791             sed -e "s&(\${config_SBG_RestartPath}/\${config_SBG_RestartJobName}/SBG/Restart/\${config_SBG_RestartJobName}_\${Date_Restarts}_stomate_forcing.nc, stomate_forcing.nc)&(${config_SBG_RestartPath}/${ORCHIDEE_JobName}/SBG/Restart/${ORCHIDEE_JobName}_${output_PreviousStage_LastRestartDate}_stomate_forcing.nc, stomate_forcing.nc)&" ${New_SUBMIT_DIR}/COMP/sechiba.card > sechiba.card.tmp 
     771            sed -e "s&(\${config_SBG_RestartPath}/\${config_SBG_RestartJobName}/SBG/Restart/\${config_SBG_RestartJobName}_\${Date_Restarts}_stomate_forcing.nc, stomate_forcing.nc)&(${config_SBG_RestartPath}/${LastJobName}/SBG/Restart/${LastJobName}_${output_PreviousStage_LastRestartDate}_stomate_forcing.nc, stomate_forcing.nc)&" ${New_SUBMIT_DIR}/COMP/sechiba.card > sechiba.card.tmp 
    792772            IGCM_sys_Mv sechiba.card.tmp ${New_SUBMIT_DIR}/COMP/sechiba.card 
    793773 
    794774            IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card UserChoices IMPOSE_VEG ${spinup_UserChoices_impose_veg} 
    795775            IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/sechiba.card UserChoices LAND_USE ${spinup_UserChoices_land_use} 
     776 
     777            typeset option 
     778            for option in ${config_SubJobPost[*]} ; do 
     779                eval value=\${config_SubJobPost_${option}} 
     780                eval echo ${option} ${value} 
     781                if [ X${value} != X ] ; then 
     782                    eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Post ${option} \${config_SubJobPost_${option}} 
     783                fi 
     784            done 
     785            eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Post RebuildFrequency ${config_SubJob_PeriodLength} 
     786            eval IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Post TimeSeriesFrequency ${config_SubJob_PeriodLength} 
     787 
    796788            SPIN_OptionsStomate 
    797789 
    … …  
    808800            SPIN_Cp_Job ${spinup_UserChoices_SubJobPath}/FORCESOIL ${ExtName} 
    809801 
    810             # For some jobs : 
    811             if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
    812                 IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card UserChoices JobNumProcTot ${config_UserChoices_JobNumProcTot} 
    813                 gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
    814                     ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
    815                 IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
    816                 chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
    817                 if [ X"${config_UserChoices_JobRunOptions}" != X ] ; then 
    818                     sed -e "s/^JobRunOptions=.*/JobRunOptions=\'${config_UserChoices_JobRunOptions}\'/" ${New_SUBMIT_DIR}/config.card > temp.card 
    819                     IGCM_sys_Mv temp.card ${New_SUBMIT_DIR}/config.card  
    820                 fi 
    821             fi 
    822  
    823802            # Always restart for forcesoil 
    824803            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card Restarts OverRule n 
    825804            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG Restart y 
    826             IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG RestartDate $( IGCM_date_ConvertFormatToHuman ${output_PreviousStage_LastRestartDate} ) 
     805            IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG RestartDate ${output_PreviousStage_LastRestartDate} 
    827806 
    828807            # Define restart simulation name 
    … …  
    833812 
    834813            # We Get the forcing file from the previous run of ORCHIDEE 
    835             ORCHIDEE_JobName=${config_UserChoices_JobName}ORC_${iter} 
    836             IGCM_card_DefineVariableFromOption ${SUBMIT_DIR}/output.card PreviousStage LastORCRestartDate 
    837             if ( [ X${spinup_UserChoices_DEBUG_SPIN} = Xn ] && [ X${output_PreviousStage_LastExtName} != XORC_${iter} ] ) ; then   
    838                 last_Cforcing=${config_SBG_RestartPath}/${config_UserChoices_JobName}/SPIN/Output/${ORCHIDEE_JobName}/SBG/Restart/${ORCHIDEE_JobName}_${output_PreviousStage_LastORCRestartDate}_stomate_Cforcing.nc 
    839             else 
    840                 last_Cforcing=${config_SBG_RestartPath}/${ORCHIDEE_JobName}/SBG/Restart/${ORCHIDEE_JobName}_${output_PreviousStage_LastORCRestartDate}_stomate_Cforcing.nc 
    841             fi 
    842             ls -lrt ${last_Cforcing} 
    843             IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/stomate.card BoundaryFiles ListNonDel "(${last_Cforcing}, stomate_Cforcing.nc), \\" 
     814            IGCM_card_DefineVariableFromOption ${SUBMIT_DIR}/output.card PreviousStage LastRestartDate 
     815 
     816            IGCM_card_WriteOption ${New_SUBMIT_DIR}/COMP/stomate.card BoundaryFiles ListNonDel \ 
     817                    "(${config_SBG_RestartPath}/${LastJobName}/SBG/Restart/${LastJobName}_${output_PreviousStage_LastRestartDate}_stomate_Cforcing.nc, stomate_Cforcing.nc), \\" 
    844818 
    845819            # Nb years for forcing FORCESOIL 
    846820            STOMATE_sed FORCESOIL_NB_YEAR ${PeriodLengthInYears} 
     821            STOMATE_sed FORCESOIL_STEP_PER_YEAR 365 
    847822 
    848823            ;; 
    … …  
    859834            else 
    860835                SPIN_Cp_Job ${spinup_UserChoices_SubJobPath}/OOL_SEC ${ExtName} 
    861             fi 
    862  
    863             # For some jobs : 
    864             if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
    865                 IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card UserChoices JobNumProcTot ${config_UserChoices_JobNumProcTot} 
    866                 gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
    867                     ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
    868                 IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
    869                 chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
    870                 if [ X"${config_UserChoices_JobRunOptions}" != X ] ; then 
    871                     sed -e "s/^JobRunOptions=.*/JobRunOptions=\'${config_UserChoices_JobRunOptions}\'/" ${New_SUBMIT_DIR}/config.card > temp.card 
    872                     IGCM_sys_Mv temp.card ${New_SUBMIT_DIR}/config.card  
    873                 fi 
    874836            fi 
    875837 
    … …  
    891853            fi 
    892854 
     855            SPIN_OptionsSechiba 
    893856            if [ X"${spinup_UserChoices_ok_stomate}" = "Xy" ] ; then 
    894                 SPIN_OptionsSechiba 
    895857                SPIN_OptionsStomate 
    896             else 
    897                 SPIN_OptionsSechiba 
    898858            fi 
    899859 
    … …  
    927887            fi 
    928888 
    929             # For some jobs : 
    930             if ( [ X${config_UserChoices_JobNumProcTot} != X ] && [ "${config_UserChoices_JobNumProcTot}" -gt 1 ] ) ; then 
    931                 IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card UserChoices JobNumProcTot ${config_UserChoices_JobNumProcTot} 
    932                 gawk -- "{if (! match(\$0,/^# .Date.*/) ) { print \$0 } else { printf(\"BATCH_NUM_PROC_TOT=%d \\n\\n\",${config_UserChoices_JobNumProcTot}) ; print \$0 } }" \ 
    933                     ${New_SUBMIT_DIR}/Job_${SubJobName} > ${New_SUBMIT_DIR}/Job_${SubJobName}_ 
    934                 IGCM_sys_Mv ${New_SUBMIT_DIR}/Job_${SubJobName}_ ${New_SUBMIT_DIR}/Job_${SubJobName} 
    935                 chmod u+x ${New_SUBMIT_DIR}/Job_${SubJobName} 
    936                 if [ X"${config_UserChoices_JobRunOptions}" != X ] ; then 
    937                     sed -e "s/^JobRunOptions=.*/JobRunOptions=\'${config_UserChoices_JobRunOptions}\'/" ${New_SUBMIT_DIR}/config.card > temp.card 
    938                     IGCM_sys_Mv temp.card ${New_SUBMIT_DIR}/config.card  
    939                 fi 
    940             fi 
    941  
    942889            SPIN_prepare 
    943890 
    … …  
    957904            fi 
    958905 
     906            SPIN_OptionsSechiba 
    959907            if [ X"${spinup_UserChoices_ok_stomate}" = "Xy" ] ; then 
    960                 SPIN_OptionsSechiba 
    961908                SPIN_OptionsStomate 
    962             else 
    963                 SPIN_OptionsSechiba 
    964909            fi 
    965910 
    … …  
    1009954    echo "SECHIBA WriteFrequency : " ${config_SRF_WriteFrequency} 
    1010955    if ( [ X${StageName} != X"TSTOINI" ] && [ X${StageName} != X"TSTO" ] && [ X${StageName} != X"FORC" ] ) ; then 
    1011     IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF WriteFrequency "${config_SRF_WriteFrequency}" 
     956        IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SRF WriteFrequency "${config_SRF_WriteFrequency}" 
    1012957    fi 
    1013958    if [ X"${spinup_UserChoices_ok_stomate}" = "Xy" ] ; then 
    1014959        echo "STOMATE WriteFrequency : " ${config_SBG_WriteFrequency} 
    1015         IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG WriteFrequency "${config_SBG_WriteFrequency}" 
     960        case $StageName in 
     961            "TSTOINI"|"TSTO") 
     962                IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG WriteFrequency "1Y" 
     963                ;; 
     964            *) 
     965                IGCM_card_WriteOption ${New_SUBMIT_DIR}/config.card SBG WriteFrequency "${config_SBG_WriteFrequency}" 
     966        esac 
    1016967    fi 
    1017968 
    … …  
    1019970    echo "cd ${New_SUBMIT_DIR}" >> ${RUN_DIR}/SubJob$$.ksh 
    1020971    echo "export SUBMIT_DIR=${New_SUBMIT_DIR}" >> ${RUN_DIR}/SubJob$$.ksh 
    1021     echo "./Job_${SubJobName} > ${New_SUBMIT_DIR}/Script_${SubJobName}.1 </dev/null 2>&1" >> ${RUN_DIR}/SubJob$$.ksh 
     972    echo "./Job_${SubJobName} > ${New_SUBMIT_DIR}/Script_Output_${SubJobName}.000001 </dev/null 2>&1" >> ${RUN_DIR}/SubJob$$.ksh 
    1022973    echo "echo 'End of Subjob : ' \$( date )" >> ${RUN_DIR}/SubJob$$.ksh 
    1023974    echo "echo 'finish.'" >> ${RUN_DIR}/SubJob$$.ksh 
    … …  
    10551006    # Did it finish ? 
    10561007    if [ X${run_Configuration_PeriodState} != X"Completed" ] ; then 
    1057         IGCM_debug_Exit "SPIN_update Error Run SubJob : " ${SubJobName} 
     1008        IGCM_debug_Exit "SPIN_update Error Run SubJob : " ${SubJobName} ${run_Configuration_PeriodState} 
    10581009    fi 
    10591010    IGCM_debug_Verif_Exit 
    … …  
    10681019    IGCM_card_WriteOption ${SUBMIT_DIR}/output.card PreviousStage LastExtName ${ExtName} 
    10691020    IGCM_card_WriteOption ${SUBMIT_DIR}/output.card PreviousStage LastRestartDate ${This_Job_DateEnd} 
    1070     if [ X${StageName} = X"SECSTO" ] ; then 
    1071         IGCM_card_WriteOption ${SUBMIT_DIR}/output.card PreviousStage LastORCRestartDate ${This_Job_DateEnd} 
    1072     fi 
     1021 
    10731022 
    10741023    # For forcesoil, we have to copy the sechiba restart of last Stage 
    10751024    if [ X${StageName} = X"FORC" ] ; then 
    10761025        # This must be done on the ARCHIVE HOST. 
    1077         if ( [ X${spinup_UserChoices_DEBUG_SPIN} = Xn ] && [ X${output_PreviousStage_LastExtName} != XORC_${iter} ] ) ; then   
    1078             last_restart=${config_SBG_RestartPath}/${config_UserChoices_JobName}/SPIN/Output/${ORCHIDEE_JobName}/SRF/Restart/${ORCHIDEE_JobName}_${output_PreviousStage_LastORCRestartDate}_sechiba_rest.nc 
    1079         else 
    1080             last_restart=${config_SBG_RestartPath}/${ORCHIDEE_JobName}/SRF/Restart/${ORCHIDEE_JobName}_${output_PreviousStage_LastORCRestartDate}_sechiba_rest.nc 
    1081         fi 
    1082         IGCM_sys_Get ${last_restart} sechiba_rest.nc 
    10831026        IGCM_sys_MkdirArchive ${config_SBG_RestartPath}/${SubJobName}/SRF/Restart 
    1084         IGCM_sys_Put_Rest sechiba_rest.nc ${config_SBG_RestartPath}/${SubJobName}/SRF/Restart/${SubJobName}_${This_Job_DateEnd}_sechiba_rest.nc  
    1085 #       FileToBeDeleted[${#FileToBeDeleted[@]}]=sechiba_rest.nc 
    1086         rm -f sechiba_rest.nc 
     1027        IGCM_sys_RshArchive \ 
     1028            "cp -fp ${config_SBG_RestartPath}/${LastJobName}/SRF/Restart/${LastJobName}_${output_PreviousStage_LastRestartDate}_sechiba_rest.nc"\ 
     1029                  " ${config_SBG_RestartPath}/${SubJobName}/SRF/Restart/${SubJobName}_${This_Job_DateEnd}_sechiba_rest.nc" 
    10871030    fi 
    10881031 
    … …  
    10911034    FileToBeDeleted[${#FileToBeDeleted[@]}]=output_out.card 
    10921035 
    1093 #set -vx 
     1036 
    10941037# If NOT DEBUG mode :  
    10951038# we can move Previous Job in SPINUP save DIR. 
    … …  
    11021045        fi 
    11031046 
    1104         IGCM_sys_RshArchive "mv -f ${R_OUT}/${config_UserChoices_TagName}/${config_UserChoices_JobName}${output_PreviousStage_LastExtName} ${R_OUT}/${config_UserChoices_TagName}/${config_UserChoices_JobName}/SPIN/Output/" 
     1047        IGCM_sys_RshArchive "mv -f ${R_OUT}/${config_UserChoices_TagName}/${config_UserChoices_JobName}${output_PreviousStage_LastExtName}"\ 
     1048                                 " ${R_OUT}/${config_UserChoices_TagName}/${config_UserChoices_JobName}/SPIN/Output/" 
    11051049    fi 
    11061050 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/SPINUP/output.card_init

    r119 r405  
    1717LastExtName= 
    1818LastRestartDate= 
    19 LastORCRestartDate= 
    2019 
    2120[Actions] 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/TESTSTOMATE/COMP/sechiba.card

    r119 r405  
    33 
    44[UserChoices] 
     5LAIMAP=n 
    56IMPOSE_VEG=n 
     7# if IMPOSE_VEG = n 
    68LAND_USE=n 
     9# if LAND_USE=y 
     10VEGET_UPDATE=1Y 
     11# if LAND_USE=n and we want to use carteveg5km.nc for maxvegetfrac map. 
     12# (instead of default PFTmap_1850to2005_AR5_LUHa.rc2 below) 
     13OLD_VEGET=n 
    714 
    815[InitialStateFiles] 
    9 List=   (${R_BC}/SRF/${config_UserChoices_TagName}/PFTmap_1850to2005_AR5_LUHa.rc2/PFTmap_IPCC_${year}.nc, .) 
     16List=   (${R_BC}/SRF/${config_UserChoices_TagName}/PFTmap_1850to2005_AR5_LUHa.rc2/PFTmap_IPCC_${year}.nc, PFTmap.nc) 
    1017         
    1118[BoundaryFiles] 
    … …  
    3340 
    3441[OutputText] 
    35 List=   (used_sechiba.def, used_driver.def, out_teststomate) 
     42List=   (used_sechiba.def, used_driver.def, out_teststomate, out_orchidee) 
    3643 
    3744[OutputFiles] 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/TESTSTOMATE/COMP/sechiba.driver

    r119 r405  
    3838    echo "ORCHIDEE Tag : " ${config_UserChoices_TagName} 
    3939 
     40    NUM_PROC=1 
     41#D- Number of processors used for lmdz and oasis coupler computed from PBS variable 
     42    if [ X"${BATCH_NUM_PROC_TOT}" != X ] ; then 
     43        NUM_PROC=${BATCH_NUM_PROC_TOT} 
     44    fi 
     45    echo BATCH_NUM_PROC_TOT=${BATCH_NUM_PROC_TOT} 
     46    echo NUM_PROC=${NUM_PROC} 
     47 
     48    if ( [ X${BATCH_NUM_PROC_TOT} != X ] && [ "${BATCH_NUM_PROC_TOT}" -gt 1 ] ) ; then 
     49        MPIRUN_COMMAND=${HOST_MPIRUN_COMMAND} 
     50    fi 
     51 
    4052    RESOL_SRF=ALL 
    4153     
     54    typeset frequency 
    4255    for frequency in ${config_SRF_WriteFrequency} ; do 
    4356        case ${frequency} in 
    … …  
    7487    IGCM_debug_PushStack "SRF_Update" 
    7588 
    76     SECHIBA_sed LAND_USE ${sechiba_UserChoices_LAND_USE} 
    77     if [ X${sechiba_UserChoices_LAND_USE} = Xy ] ; then 
     89    typeset SECHIBA_WRITE_STEP 
    7890 
    79       ##MM : cutting PFTmaps of ORCHIDEE : for first year without restart, we must use this year map 
    80       ##     WARNING : the next year map must be avaible and the december month, then this device will 
    81       ##               only work with PeriodLength scrictly less than 1Y. 
    82       # If you want to come back to old BIG LAND USE file 
    83       # (to run on multipple years, just one time with LAND USE activated),  
    84       # you must  
    85       # comment all next 8 lines and check correct parameters in sechiba.def file 
    86       # for your LAND USE specific file. 
    87         SECHIBA_sed VEGET_REINIT y 
    88         if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
    89             SECHIBA_sed VEGET_YEAR 1 
    90             IGCM_sys_Mv PFTmap_IPCC_${year}.nc PFTmap.nc 
    91         else 
    92             SECHIBA_sed VEGET_YEAR 0 
    93             IGCM_sys_Mv -f PFTmap_IPCC_${year_p1}.nc PFTmap.nc 
     91    # Get WriteFrenquecies from config.card for SECHIBA 
     92    SRF_WriteFrequency=$( echo ${config_SRF_WriteFrequency} | sed -e 's/\([0-9]*[yYmMdDs]\).*/\1/' )  
     93    case ${SRF_WriteFrequency} in 
     94        *Y|*y)  
     95            WriteInYears=$( echo ${SRF_WriteFrequency} | awk -F '[yY]' '{print $1}' ) 
     96            PeriodLengthInYears=$( echo ${config_UserChoices_PeriodLength} | awk -F '[yY]' '{print $1}' ) 
     97            (( SECHIBA_WRITE_STEP = PeriodLengthInDays * WriteInYears / PeriodLengthInYears * 86400 )) ;; 
     98        1M) 
     99            case ${config_UserChoices_PeriodLength} in 
     100            *Y|*y) 
     101                SECHIBA_WRITE_STEP=-1. 
     102                ;; 
     103            *M|*m) 
     104                SECHIBA_WRITE_STEP=-1. 
     105                ;; 
     106            *) 
     107                (( SECHIBA_WRITE_STEP = $( IGCM_date_DaysInMonth $year $month ) * 86400 )) 
     108                ;; 
     109            esac 
     110            ;; 
     111        *M|*m)  
     112            WriteInMonths=$( echo ${SRF_WriteFrequency} | awk -F '[mM]' '{print $1}' ) 
     113            case ${config_UserChoices_PeriodLength} in 
     114            *Y|*y) 
     115                PeriodLengthInYears=$( echo ${config_UserChoices_PeriodLength} | awk -F '[yY]' '{print $1}' ) 
     116                (( SECHIBA_WRITE_STEP = PeriodLengthInDays * 86400 / PeriodLengthInYears / 12 )) 
     117                ;; 
     118            *M|*m) 
     119                PeriodLengthInMonths=$( echo ${config_UserChoices_PeriodLength} | awk -F '[mM]' '{print $1}' ) 
     120                (( SECHIBA_WRITE_STEP = PeriodLengthInDays * WriteInMonths  * 86400 / PeriodLengthInMonths  )) 
     121                ;; 
     122            *) 
     123                (( SECHIBA_WRITE_STEP = $( IGCM_date_DaysInMonth $year $month ) * 86400 )) 
     124                ;; 
     125            esac 
     126            ;; 
     127        5D|5d)  
     128            (( SECHIBA_WRITE_STEP = 5 * 86400 )) ;; 
     129        1D|1d)  
     130            (( SECHIBA_WRITE_STEP = 86400 )) ;; 
     131        *s) 
     132            WriteInSeconds=$( echo ${SRF_WriteFrequency} | awk -F '[s]' '{print $1}' ) 
     133            (( SECHIBA_WRITE_STEP = WriteInSeconds )) ;; 
     134        *)  
     135            IGCM_debug_Exit "SRF_Update " ${SRF_WriteFrequency} " invalid WriteFrequency : choose in 1Y, 1M, 5D, 1D."  
     136            IGCM_debug_Verif_Exit ;; 
     137    esac 
     138    SECHIBA_sed WRITE_STEP ${SECHIBA_WRITE_STEP} 
     139 
     140    if [ X${sechiba_UserChoices_IMPOSE_VEG} = Xn ] ; then 
     141        if [ X${sechiba_UserChoices_LAND_USE} = Xy ] ; then 
     142            SECHIBA_sed VEGET_UPDATE ${sechiba_UserChoices_VEGET_UPDATE} 
     143 
     144            ##MM : cutting PFTmaps of ORCHIDEE : for first year without restart, we must use this year map 
     145            ##     WARNING : the next year map must be avaible and the december month, then this device will 
     146            ##               only work with PeriodLength scrictly less than 1Y. 
     147            # If you want to come back to old BIG LAND USE file 
     148            # (to run on multipple years, just one time with LAND USE activated),  
     149            # you must  
     150            # comment all next 8 lines and check correct parameters in sechiba.def file 
     151            # for your LAND USE specific file. 
     152            SECHIBA_sed VEGET_REINIT y 
     153            if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
     154                SECHIBA_sed VEGET_YEAR 1 
     155            else 
     156                SECHIBA_sed VEGET_YEAR 0 
     157                IGCM_sys_Mv -f PFTmap_IPCC_${year_p1}.nc PFTmap.nc 
     158            fi 
     159        elif [ X${sechiba_UserChoices_OLD_VEGET} = Xy ] ; then 
     160            SECHIBA_sed LAND_USE n 
    94161        fi 
     162    else 
     163        SECHIBA_sed IMPOSE_VEG y 
    95164    fi 
    96165 
    97     SECHIBA_sed IMPOSE_VEG ${sechiba_UserChoices_IMPOSE_VEG} 
    98      
    99166    if ( [ ${CumulPeriod} -eq 1 ] && [ "${config_SRF_Restart}" = "n" ] ) ; then 
    100167        echo "Error in teststomate !" 
    … …  
    106173        SECHIBA_sed SECHIBA_restart_in sechiba_rest_in.nc 
    107174    fi 
     175    FileToBeDeleted[${#FileToBeDeleted[@]}]=sechiba.def 
    108176 
    109177    DRIVER_sed TIME_LENGTH ${PeriodLengthInDays}D 
    110178#    DRIVER_sed TIME_SKIP ${OldSimulationLengthInDays}D 
     179    FileToBeDeleted[${#FileToBeDeleted[@]}]=driver.def 
    111180 
    112181    IGCM_debug_PopStack "SRF_Update" 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/TESTSTOMATE/COMP/stomate.card

    r119 r405  
    3636Patches= () 
    3737GatherWithInternal= (lon, lat, PFT, time_counter, Areas) 
    38 TimeSeriesVars2D= (T2M_MONTH,CONTFRAC,RESOLUTION_X,RESOLUTION_Y,CONVFLUX,CFLUX_PROD10,CFLUX_PROD100,HARVEST_ABOVE) 
     38TimeSeriesVars2D= (T2M_MONTH,CONTFRAC,RESOLUTION_X,RESOLUTION_Y,CONVFLUX,CFLUX_PROD10,CFLUX_PROD100,CO2FLUX_MONTHLY_SUM,HARVEST_ABOVE) 
    3939ChunckJob2D = NONE 
    40 TimeSeriesVars3D = (CO2FLUX_MONTHLY,LAI,VEGET,VEGET_MAX,NPP,GPP,HET_RESP,MAINT_RESP,GROWTH_RESP,AGE,HEIGHT,TOTAL_M,TOTAL_BM_LITTER,TOTAL_SOIL_CARB) 
     40TimeSeriesVars3D= (CO2FLUX,LAI,VEGET,VEGET_MAX,NPP,GPP,HET_RESP,MAINT_RESP,GROWTH_RESP,AGE,HEIGHT,TOTAL_M,TOTAL_BM_LITTER,TOTAL_SOIL_CARB,ADAPTATION,REGENERATION) 
    4141ChunckJob3D = NONE 
    4242Seasonal=ON 
    … …  
    4545Patches= () 
    4646GatherWithInternal= (lon, lat, PFT, time_counter, Areas) 
    47 TimeSeriesVars2D=(cVeg, cLitter, cSoil, cProduct, lai, gpp, ra, npp, rh, fFire, fHarvest, fLuc, nbp, fVegLitter, fLitterSoil, cLeaf, cWood, cRoot, cMisc, cLitterAbove, cLitterBelow, cSoilFast, cSoilMedium, cSoilSlow, landCoverFrac, treeFracPrimDec, treeFracPrimEver, c3PftFrac, c4PftFrac, rGrowth, rMaint, nppLeaf, nppWood, nppRoot, nep) 
     47TimeSeriesVars2D=(cVeg, cLitter, cSoil, cProduct, cMassVariation, lai, gpp, ra, npp, rh, fFire, fHarvest, fLuc, nbp, fVegLitter, fLitterSoil, cLeaf, cWood, cRoot, cMisc, cLitterAbove, cLitterBelow, cSoilFast, cSoilMedium, cSoilSlow, landCoverFrac, treeFracPrimDec, treeFracPrimEver, c3PftFrac, c4PftFrac, rGrowth, rMaint, nppLeaf, nppWood, nppRoot, nep) 
    4848ChunckJob2D = NONE 
    4949TimeSeriesVars3D=() 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/TESTSTOMATE/COMP/stomate.driver

    r119 r405  
    2424    RESOL_SBG=ALL 
    2525     
     26    typeset frequency 
     27    for frequency in ${config_SBG_WriteFrequency} ; do 
     28        case ${frequency} in 
     29            HF|hf) SBG_ok_hf=y ;; 
     30        esac 
     31    done 
     32     
    2633    IGCM_debug_PopStack "SBG_Initialize" 
     34} 
     35 
     36#----------------------------------------------------------------- 
     37function SBG_PeriodStart 
     38{ 
     39    IGCM_debug_PushStack "SBG_PeriodStart" 
     40 
     41    IGCM_debug_PopStack "SBG_PeriodStart" 
    2742} 
    2843 
    … …  
    7792 
    7893    STOMATE_sed STOMATE_OK_STOMATE y 
    79     STOMATE_sed STOMATE_OK_CO2 y 
    8094 
    8195    STOMATE_sed STOMATE_HIST_DT ${STOMATE_WRITE_STEP} 
    … …  
    87101    fi 
    88102 
     103    if [ X${SBG_ok_hf} = Xy ] ; then  
     104        STOMATE_sed STOMATE_IPCC_HIST_DT 1D 
     105    else 
     106        STOMATE_sed STOMATE_IPCC_HIST_DT ${STOMATE_WRITE_STEP} 
     107    fi 
     108 
    89109    IGCM_debug_PopStack "SBG_Update" 
    90110} 
    … …  
    93113function SBG_Finalize 
    94114{ 
    95 #set -vx 
    96115    IGCM_debug_PushStack "SBG_Finalize" 
    97116 
    … …  
    101120#     NbYearsDone=$(( NbDaysDone / 360 )) 
    102121     
    103 # #     echo $NbDaysDone, $NbYearsDone, $(( NbYearsDone % 10 )) 
    104 # #    if [ $(( NbYearsDone % 10 )) = 0 ] ; then 
    105 #     if [ $( IGCM_date_DaysBetweenGregorianDate ${PeriodDateEnd} ${DateEnd} ) -ge 0 ] ; then 
    106 #       IGCM_sys_Put_Out stomate_Cforcing.nc ${R_OUT_SBG_R}/${config_UserChoices_JobName}_${PeriodDateEnd}_stomate_Cforcing.nc 
    107 #       IGCM_sys_Put_Out stomate_forcing.nc  ${R_OUT_SBG_R}/${config_UserChoices_JobName}_${PeriodDateEnd}_stomate_forcing.nc 
    108 #       rm -f stomate_Cforcing.nc 
    109 #       rm -f stomate_forcing.nc 
    110 #     fi 
     122#     echo $NbDaysDone, $NbYearsDone, $(( NbYearsDone % 10 )) 
     123#    if [ $(( NbYearsDone % 10 )) = 0 ] ; then 
     124    if [ $( IGCM_date_DaysBetweenGregorianDate ${PeriodDateEnd} ${DateEnd} ) -ge 0 ] ; then 
     125        IGCM_sys_Put_Out stomate_Cforcing.nc ${R_OUT_SBG_R}/${config_UserChoices_JobName}_${PeriodDateEnd}_stomate_Cforcing.nc 
     126        rm -f stomate_Cforcing.nc 
     127    fi 
    111128 
    112129    IGCM_debug_PopStack "SBG_Finalize" 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/TESTSTOMATE/POST/monitoring01_stomate.cfg

    r119 r405  
    4646BIOMASS_lands       | "TOTAL_M VEGET_MAX CONTFRAC"         | "" | "(TOTAL_M[d=1]*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"             | "Total Biomass (LANDS)"                                       | "PgC"    | "2" 
    4747LITTER_lands        | "TOTAL_BM_LITTER VEGET_MAX CONTFRAC" | "" | "(TOTAL_BM_LITTER[d=1]*365*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)" | "Total Litter (LANDS)"                                        | "PgC/yr" | "2" 
    48 CO2FLUX_lands       | "CO2FLUX_MONTHLY VEGET_MAX CONTFRAC" | "" | "(CO2FLUX_MONTHLY[d=1]*12*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"  | "NEE (LANDS)"                                                 | "PgC/yr" | "2" 
     48CO2FLUX_lands       | "CO2FLUX VEGET_MAX CONTFRAC"         | "" | "(CO2FLUX[d=1]*12*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"          | "NEE (LANDS)"                                                 | "PgC/yr" | "2" 
     49CO2FLUX_MONTHLY_SUM_lands | "CO2FLUX_MONTHLY_SUM VEGET_MAX CONTFRAC" | "" | "(CO2FLUX_MONTHLY_SUM[d=1]*12)"                                 | "NEE Sum (LANDS)"                                             | "PgC/yr" | "Areas[d=1]" 
    4950NPP_lands           | "NPP VEGET_MAX CONTFRAC"             | "" | "(NPP[d=1]*365*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"             | "Net Primary Produc (LANDS)"                                  | "PgC/yr" | "2" 
    5051GPP_lands           | "GPP VEGET_MAX CONTFRAC"             | "" | "(GPP[d=1]*365*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"             | "Gross Primary Produc (LANDS)"                                | "PgC/yr" | "2" 
    … …  
    5253MAINT_RESP_lands    | "MAINT_RESP VEGET_MAX CONTFRAC"      | "" | "(MAINT_RESP[d=1]*365*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"      | "Maintenance Resp. (LANDS)"                                   | "PgC/yr" | "2" 
    5354GROWTH_RESP_lands   | "GROWTH_RESP VEGET_MAX CONTFRAC"     | "" | "(GROWTH_RESP[d=1]*365*VEGET_MAX[d=2]*AREAS[d=1]*CONTFRAC[d=3]/1e15)"     | "Growth Resp. (LANDS)"                                        | "PgC/yr" | "2" 
     55cVeg_lands             | "cVeg"             | "" | "(cVeg[d=1])"            | "Carbon in Vegetation"                        | "kg C m-2" | "Areas[d=1]" 
     56cLitter_lands          | "cLitter"          | "" | "(cLitter[d=1])"         | "Carbon in Litter Pool"                       | "kg C m-2" | "Areas[d=1]" 
     57cSoil_lands            | "cSoil"            | "" | "(cSoil[d=1])"           | "Carbon in Soil Pool"                         | "kg C m-2" | "Areas[d=1]" 
     58cProduct_lands         | "cProduct"         | "" | "(cProduct[d=1])"        | "Carbon in Products of Land Use Change"       | "kg C m-2" | "Areas[d=1]" 
     59lai_lands              | "lai"              | "" | "(lai[d=1])"             | "Leaf Area Fraction"                          | "1"        | "Areas[d=1]" 
     60gpp_lands              | "gpp"              | "" | "(gpp[d=1])"             | "Gross Primary Production"                    | "kg C m-2 s-1" | "Areas[d=1]" 
     61ra_lands               | "ra"               | "" | "(ra[d=1])"              | "Autotrophic Respiration"                     | "kg C m-2 s-1" | "Areas[d=1]" 
     62npp_lands              | "npp"              | "" | "(npp[d=1])"             | "Net Primary Production"                      | "kg C m-2 s-1" | "Areas[d=1]" 
     63rh_lands               | "rh"               | "" | "(rh[d=1])"              | "Heterotrophic Respiration"                   | "kg C m-2 s-1" | "Areas[d=1]" 
     64fFire_lands            | "fFire"            | "" | "(fFire[d=1])"           | "CO2 Emission from Fire"                      | "kg C m-2 s-1" | "Areas[d=1]" 
     65fHarvest_lands         | "fHarvest"         | "" | "(fHarvest[d=1])"        | "CO2 Flux to Atmosphere from Crop Harvesting" | "kg C m-2 s-1" | "Areas[d=1]" 
     66fLuc_lands             | "fLuc"             | "" | "(fLuc[d=1])"            | "CO2 Flux to Atmosphere from Land Use Change" | "kg C m-2 s-1" | "Areas[d=1]" 
     67nbp_lands              | "nbp"              | "" | "(nbp[d=1])"             | "Net Biospheric Production"                   | "kg C m-2 s-1" | "Areas[d=1]" 
     68fVegLitter_lands       | "fVegLitter"       | "" | "(fVegLitter[d=1])"      | "Total Carbon Flux from Vegetation to Litter" | "kg C m-2 s-1" | "Areas[d=1]" 
     69fLitterSoil_lands      | "fLitterSoil"      | "" | "(fLitterSoil[d=1])"     | "Total Carbon Flux from Litter to Soil"       | "kg C m-2 s-1" | "Areas[d=1]" 
     70cLeaf_lands            | "cLeaf"            | "" | "(cLeaf[d=1])"           | "Carbon in Leaves"                            | "kg C m-2" | "Areas[d=1]" 
     71cWood_lands            | "cWood"            | "" | "(cWood[d=1])"           | "Carbon in Wood"                              | "kg C m-2" | "Areas[d=1]" 
     72cRoot_lands            | "cRoot"            | "" | "(cRoot[d=1])"           | "Carbon in Roots"                             | "kg C m-2" | "Areas[d=1]" 
     73cMisc_lands            | "cMisc"            | "" | "(cMisc[d=1])"           | "Carbon in Other Living Compartments"         | "kg C m-2" | "Areas[d=1]" 
     74cLitterAbove_lands     | "cLitterAbove"     | "" | "(cLitterAbove[d=1])"    | "Carbon in Above-Ground Litter"               | "kg C m-2" | "Areas[d=1]" 
     75cLitterBelow_lands     | "cLitterBelow"     | "" | "(cLitterBelow[d=1])"    | "Carbon in Below-Ground Litter"               | "kg C m-2" | "Areas[d=1]" 
     76cSoilFast_lands        | "cSoilFast"        | "" | "(cSoilFast[d=1])"       | "Carbon in Fast Soil Pool"                    | "kg C m-2" | "Areas[d=1]" 
     77cSoilMedium_lands      | "cSoilMedium"      | "" | "(cSoilMedium[d=1])"     | "Carbon in Medium Soil Pool"                  | "kg C m-2" | "Areas[d=1]" 
     78cSoilSlow_lands        | "cSoilSlow"        | "" | "(cSoilSlow[d=1])"       | "Carbon in Slow Soil Pool"                    | "kg C m-2" | "Areas[d=1]" 
     79treeFracPrimDec_lands  | "treeFracPrimDec"  | "" | "(treeFracPrimDec[d=1])" | "Total Primary Deciduous Tree Cover Fraction" | "%"       | "Areas[d=1]" 
     80treeFracPrimEver_lands | "treeFracPrimEver" | "" | "(treeFracPrimEver[d=1])"| "Total Primary Evergreen Tree Cover Fraction" | "%"       | "Areas[d=1]" 
     81c3PftFrac_lands        | "c3PftFrac"        | "" | "(c3PftFrac[d=1])"       | "Total C3 PFT Cover Fraction"                 | "%"       | "Areas[d=1]" 
     82c4PftFrac_lands        | "c4PftFrac"        | "" | "(c4PftFrac[d=1])"       | "Total C4 PFT Cover Fraction"                 | "%"       | "Areas[d=1]" 
     83rGrowth_lands          | "rGrowth"          | "" | "(rGrowth[d=1])"         | "Growth Autotrophic Respiration"              | "kg C m-2 s-1" | "Areas[d=1]" 
     84rMaint_lands           | "rMaint"           | "" | "(rMaint[d=1])"          | "Maintenance Autotrophic Respiration"         | "kg C m-2 s-1" | "Areas[d=1]" 
     85nppLeaf_lands          | "nppLeaf"          | "" | "(nppLeaf[d=1])"         | "CO2 Flux from Atmosphere due to NPP Allocation to Leaf" | "kg C m-2 s-1" | "Areas[d=1]" 
     86nppWood_lands          | "nppWood"          | "" | "(nppWood[d=1])"         | "CO2 Flux from Atmosphere due to NPP Allocation to Wood" | "kg C m-2 s-1" | "Areas[d=1]" 
     87nppRoot_lands          | "nppRoot"          | "" | "(nppRoot[d=1])"         | "CO2 Flux from Atmosphere due to NPP Allocation to Root" | "kg C m-2 s-1" | "Areas[d=1]" 
     88nep_lands              | "nep"              | "" | "(nep[d=1])"             | "Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity." | "kg C m-2 s-1" | "Areas[d=1]" 
     89cMassVariation_lands     | "cMassVariation"     | "" | "(cMassVariation[d=1])"    | "Carbon Mass Variation"                         | "kg C m-2 s-1" | "Areas[d=1]" 
     90cBal_lands             | "cMassVariation nbp" | "" | "(cMassVariation[d=1,L=2:1000]-nbp[d=2,L=2:1000])" | "Total Carbon Balance"                    | "kg C m-2 s-1" | "Areas[d=1]" 
    5491#------------------------------------------------------------------------------------------------------------------------------------------------------ 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/dim2_driver.f90

    r119 r405  
    122122 
    123123  CALL init_para(.FALSE.) 
     124  CALL init_timer 
    124125   
    125126! driver only for process root 
    … …  
    341342  itau_dep = 0 
    342343  itau_dep_rest = 0 
    343   itau_fin = tm-1 
     344  itau_fin = tm 
    344345!- 
    345346  CALL gather2D(lon,lon_g) 
    … …  
    362363     IF (itau_dep /= itau_dep_rest) THEN 
    363364        itau_dep = itau_dep_rest 
    364         itau_fin = itau_dep+tm-1 
     365        itau_fin = itau_dep+tm 
    365366     ENDIF 
    366367  ENDIF 
    … …  
    461462  IF ( (dt_rest /= dt_force).AND.(itau_dep > 1) ) THEN 
    462463    itau_dep = NINT((itau_dep*dt_rest )/dt_force) 
    463     itau_fin = itau_dep+tm-1 
     464    itau_fin = itau_dep+tm 
    464465    if (debug) WRITE(numout,*) & 
    465466 & 'The time steping of the restart is different from the one ',& 
    … …  
    687688! This means loading the prognostic variables from the restart file. 
    688689!- 
    689   IF (is_root_prc) & 
    690        ALLOCATE(fluxsens_g(iim_g,jjm_g)) 
     690  Flag=.FALSE. 
    691691  IF (is_root_prc) THEN 
     692     ALLOCATE(fluxsens_g(iim_g,jjm_g)) 
    692693     var_name= 'fluxsens' 
    693694     CALL restget & 
    694695 &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., fluxsens_g) 
    695696     IF (ALL(fluxsens_g(:,:) == val_exp)) THEN 
    696         fluxsens_g(:,:) = zero 
     697        Flag=.TRUE. 
     698     ELSE 
     699        Flag=.FALSE. 
    697700     ENDIF 
    698   ENDIF 
    699   CALL scatter2D(fluxsens_g,fluxsens) 
    700   IF (is_root_prc) & 
    701        DEALLOCATE(fluxsens_g) 
    702 !- 
    703   IF (is_root_prc) & 
    704        ALLOCATE(vevapp_g(iim_g,jjm_g)) 
     701  ELSE 
     702     ALLOCATE(fluxsens_g(0,1)) 
     703  ENDIF 
     704  CALL bcast(Flag) 
     705  IF (.NOT. Flag) THEN 
     706     CALL scatter2D(fluxsens_g,fluxsens) 
     707  ELSE 
     708     fluxsens(:,:) = zero 
     709  ENDIF 
     710  DEALLOCATE(fluxsens_g) 
     711!- 
    705712  IF (is_root_prc) THEN 
     713     ALLOCATE(vevapp_g(iim_g,jjm_g)) 
    706714     var_name= 'vevapp' 
    707715     CALL restget & 
    708716 &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., vevapp_g) 
    709717     IF (ALL(vevapp_g(:,:) == val_exp)) THEN 
    710         vevapp(:,:) = 0. 
     718        Flag=.TRUE. 
     719     ELSE 
     720        Flag=.FALSE. 
    711721     ENDIF 
    712   ENDIF 
    713   CALL scatter2D(vevapp_g,vevapp) 
    714   IF (is_root_prc) & 
    715        DEALLOCATE(vevapp_g) 
    716 !- 
    717   IF (is_root_prc) & 
    718        ALLOCATE(old_zlev_g(iim_g,jjm_g)) 
     722  ELSE 
     723     ALLOCATE(vevapp_g(0,1)) 
     724  ENDIF 
     725  CALL bcast(Flag) 
     726  IF (.NOT. Flag) THEN 
     727     CALL scatter2D(vevapp_g,vevapp) 
     728  ELSE 
     729     vevapp(:,:) = zero 
     730  ENDIF 
     731  DEALLOCATE(vevapp_g) 
     732!- 
    719733  IF (is_root_prc) THEN 
     734     ALLOCATE(old_zlev_g(iim_g,jjm_g)) 
    720735     var_name= 'zlev_old' 
    721736     CALL restget & 
    … …  
    726741        Flag=.FALSE. 
    727742     ENDIF 
    728   ENDIF 
    729   CALL scatter2D(old_zlev_g,old_zlev) 
    730   IF (is_root_prc) & 
    731        DEALLOCATE(old_zlev_g) 
     743  ELSE 
     744     ALLOCATE(old_zlev_g(0,1)) 
     745  ENDIF 
    732746  CALL bcast(Flag) 
    733   IF ( Flag ) old_zlev(:,:)=zlev_vec(:,:) 
    734 !- 
    735   IF (is_root_prc) & 
    736        ALLOCATE(old_qair_g(iim_g,jjm_g)) 
     747  IF ( .NOT. Flag ) THEN 
     748     CALL scatter2D(old_zlev_g,old_zlev) 
     749  ELSE 
     750     old_zlev(:,:)=zlev_vec(:,:) 
     751  ENDIF 
     752  DEALLOCATE(old_zlev_g) 
     753!- 
    737754  IF (is_root_prc) THEN 
     755     ALLOCATE(old_qair_g(iim_g,jjm_g)) 
    738756     var_name= 'qair_old' 
    739757     CALL restget & 
    … …  
    744762      Flag=.FALSE. 
    745763    ENDIF 
    746   ENDIF 
    747   CALL scatter2D(old_qair_g,old_qair) 
    748   IF (is_root_prc) & 
    749        DEALLOCATE(old_qair_g) 
     764  ELSE 
     765     ALLOCATE(old_qair_g(0,1)) 
     766  ENDIF 
    750767  CALL bcast(Flag) 
    751   IF (Flag) old_qair(:,:) = qair_obs(:,:) 
    752 !- 
    753   IF (is_root_prc) & 
    754        ALLOCATE(old_eair_g(iim_g,jjm_g)) 
     768  IF ( .NOT. Flag ) THEN 
     769     CALL scatter2D(old_qair_g,old_qair) 
     770  ELSE 
     771     old_qair(:,:) = qair_obs(:,:) 
     772  ENDIF 
     773  DEALLOCATE(old_qair_g) 
     774!- 
    755775  IF (is_root_prc) THEN 
     776     ALLOCATE(old_eair_g(iim_g,jjm_g)) 
    756777     var_name= 'eair_old' 
    757778     CALL restget & 
    … …  
    762783      Flag=.FALSE. 
    763784    ENDIF 
    764   ENDIF 
    765   CALL scatter2D(old_eair_g,old_eair) 
    766   IF (is_root_prc) & 
    767        DEALLOCATE(old_eair_g) 
     785  ELSE 
     786     ALLOCATE(old_eair_g(0,1)) 
     787  ENDIF 
    768788  CALL bcast(Flag) 
    769   IF (Flag) THEN 
     789  IF ( .NOT. Flag ) THEN 
     790     CALL scatter2D(old_eair_g,old_eair) 
     791  ELSE 
    770792     DO ik=1,nbindex 
    771793        i=ilandindex(ik) 
    … …  
    774796     ENDDO 
    775797  ENDIF 
     798  DEALLOCATE(old_eair_g) 
    776799!- 
    777800! old density is also needed because we do not yet have the right pb 
    778801!- 
    779802!=> obsolète ??!! (tjrs calculé après forcing_read)  
    780   IF (is_root_prc) & 
    781        ALLOCATE(for_rau_g(iim_g,jjm_g)) 
    782803  IF (is_root_prc) THEN 
     804     ALLOCATE(for_rau_g(iim_g,jjm_g)) 
    783805     var_name= 'rau_old' 
    784806     CALL restget & 
    … …  
    789811      Flag=.FALSE. 
    790812    ENDIF 
    791   ENDIF 
    792   CALL scatter2D(for_rau_g,for_rau) 
    793   IF (is_root_prc) & 
    794        DEALLOCATE(for_rau_g) 
     813  ELSE 
     814     ALLOCATE(for_rau_g(0,1)) 
     815  ENDIF 
    795816  CALL bcast(Flag) 
    796   IF (Flag) THEN 
     817  IF ( .NOT. Flag ) THEN 
     818     CALL scatter2D(for_rau_g,for_rau) 
     819  ELSE 
    797820     DO ik=1,nbindex 
    798821        i=ilandindex(ik) 
    … …  
    801824     ENDDO 
    802825  ENDIF 
     826  DEALLOCATE(for_rau_g) 
    803827!- 
    804828! For this variable the restart is extracted by SECHIBA 
    … …  
    810834!   This does not yield a correct restart in the case of relaxation 
    811835!- 
    812      IF (is_root_prc) & 
    813           ALLOCATE(petAcoef_g(iim_g,jjm_g)) 
    814836     IF (is_root_prc) THEN 
     837        ALLOCATE(petAcoef_g(iim_g,jjm_g)) 
    815838        var_name= 'petAcoef' 
    816839        CALL restget & 
    … …  
    821844           Flag=.FALSE. 
    822845        ENDIF 
     846     ELSE 
     847        ALLOCATE(petAcoef_g(0,1)) 
    823848     ENDIF 
    824      CALL scatter2D(petAcoef_g,petAcoef) 
    825      IF (is_root_prc) & 
    826           DEALLOCATE(petAcoef_g) 
    827849     CALL bcast(Flag) 
    828      IF (Flag)  petAcoef(:,:) = zero 
     850     IF ( .NOT. Flag ) THEN 
     851        CALL scatter2D(petAcoef_g,petAcoef) 
     852     ELSE 
     853        petAcoef(:,:) = zero 
     854     ENDIF 
     855     DEALLOCATE(petAcoef_g) 
    829856!-- 
    830      IF (is_root_prc) & 
    831           ALLOCATE(petBcoef_g(iim_g,jjm_g)) 
    832857     IF (is_root_prc) THEN 
     858        ALLOCATE(petBcoef_g(iim_g,jjm_g)) 
    833859        var_name= 'petBcoef' 
    834860        CALL restget & 
    … …  
    839865           Flag=.FALSE. 
    840866        ENDIF 
     867     ELSE 
     868        ALLOCATE(petBcoef_g(0,1)) 
    841869     ENDIF 
    842      CALL scatter2D(petBcoef_g,petBcoef) 
    843      IF (is_root_prc) & 
    844           DEALLOCATE(petBcoef_g) 
    845870     CALL bcast(Flag) 
    846      IF (Flag) petBcoef(:,:) = old_eair(:,:) 
     871     IF ( .NOT. Flag ) THEN 
     872        CALL scatter2D(petBcoef_g,petBcoef) 
     873     ELSE 
     874        petBcoef(:,:) = old_eair(:,:) 
     875     ENDIF 
     876     DEALLOCATE(petBcoef_g) 
    847877!-- 
    848      IF (is_root_prc) & 
    849           ALLOCATE(peqAcoef_g(iim_g,jjm_g)) 
    850878     IF (is_root_prc) THEN 
     879        ALLOCATE(peqAcoef_g(iim_g,jjm_g)) 
    851880        var_name= 'peqAcoef' 
    852881        CALL restget & 
    … …  
    857886           Flag=.FALSE. 
    858887        ENDIF 
     888     ELSE 
     889        ALLOCATE(peqAcoef_g(0,1)) 
    859890     ENDIF 
    860      CALL scatter2D(peqAcoef_g,peqAcoef) 
    861      IF (is_root_prc) & 
    862           DEALLOCATE(peqAcoef_g) 
    863891     CALL bcast(Flag) 
    864      IF (Flag) peqAcoef(:,:) = zero 
     892     IF ( .NOT. Flag ) THEN 
     893        CALL scatter2D(peqAcoef_g,peqAcoef) 
     894     ELSE 
     895        peqAcoef(:,:) = zero 
     896     ENDIF 
     897     DEALLOCATE(peqAcoef_g) 
    865898!-- 
    866      IF (is_root_prc) & 
    867           ALLOCATE(peqBcoef_g(iim_g,jjm_g)) 
    868899     IF (is_root_prc) THEN 
     900        ALLOCATE(peqBcoef_g(iim_g,jjm_g)) 
    869901        var_name= 'peqBcoef' 
    870902        CALL restget & 
    … …  
    875907           Flag=.FALSE. 
    876908        ENDIF 
     909     ELSE 
     910        ALLOCATE(peqBcoef_g(0,1)) 
    877911     ENDIF 
    878      CALL scatter2D(peqBcoef_g,peqBcoef) 
    879      IF (is_root_prc) & 
    880           DEALLOCATE(peqBcoef_g) 
    881912     CALL bcast(Flag) 
    882      IF (Flag) peqBcoef(:,:) = old_qair(:,:) 
     913     IF ( .NOT. Flag ) THEN 
     914        CALL scatter2D(peqBcoef_g,peqBcoef) 
     915     ELSE 
     916        peqBcoef(:,:) = old_qair(:,:) 
     917     ENDIF 
     918     DEALLOCATE(peqBcoef_g) 
    883919  ENDIF 
    884920!- 
    … …  
    952988      IF (longprint) THEN 
    953989         WRITE(numout,*) "dim2_driver 0 ",it_force  
    954          WRITE(numout,*) ">> Index of land points =",kindex 
     990         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex) 
    955991         WRITE(numout,*) "Lowest level wind speed North = ", & 
    956992              & (/ ( u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
    … …  
    11611197        IF (longprint) THEN 
    11621198           WRITE(numout,*) "dim2_driver first_CALL ",it_force  
    1163            WRITE(numout,*) ">> Index of land points =",kindex 
     1199           WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex) 
    11641200           WRITE(numout,*) "Lowest level wind speed North = ", & 
    11651201             &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
    … …  
    12341270!------- 
    12351271        ! albedo  
    1236         IF (is_root_prc) & 
    1237              ALLOCATE(albedo_g(iim_g,jjm_g)) 
     1272        IF (is_root_prc) THEN 
     1273           ALLOCATE(albedo_g(iim_g,jjm_g)) 
     1274        ELSE 
     1275           ALLOCATE(albedo_g(0,1)) 
     1276        ENDIF 
    12381277        ! 
    12391278        IF (is_root_prc) THEN 
    … …  
    12471286           ENDIF 
    12481287        ENDIF 
    1249         CALL scatter2D(albedo_g,albedo_vis) 
    12501288        CALL bcast(Flag) 
    1251         IF (.NOT. Flag) albedo(:,:,1)=albedo_vis(:,:) 
     1289        IF ( .NOT. Flag ) THEN 
     1290           CALL scatter2D(albedo_g,albedo_vis) 
     1291           albedo(:,:,1)=albedo_vis(:,:) 
     1292        ELSE 
     1293           albedo_vis(:,:)=albedo(:,:,1) 
     1294        ENDIF 
    12521295        ! 
    12531296        IF (is_root_prc) THEN 
    … …  
    12611304           ENDIF 
    12621305        ENDIF 
    1263         CALL scatter2D(albedo_g,albedo_nir) 
    12641306        CALL bcast(Flag) 
    1265         IF (.NOT. Flag) albedo(:,:,2)=albedo_nir(:,:) 
     1307        IF ( .NOT. Flag ) THEN 
     1308           CALL scatter2D(albedo_g,albedo_nir) 
     1309           albedo(:,:,2)=albedo_nir(:,:) 
     1310        ELSE 
     1311           albedo_nir(:,:)=albedo(:,:,2) 
     1312        ENDIF 
    12661313        ! 
    1267         IF (is_root_prc) & 
    1268              DEALLOCATE(albedo_g) 
     1314        DEALLOCATE(albedo_g) 
    12691315        !-- 
    12701316        ! z0  
    1271         IF (is_root_prc) & 
    1272              ALLOCATE(z0_g(iim_g,jjm_g)) 
    12731317        IF (is_root_prc) THEN 
     1318           ALLOCATE(z0_g(iim_g,jjm_g)) 
    12741319           var_name= 'z0' 
    12751320           CALL restget & 
    … …  
    12801325              Flag=.FALSE. 
    12811326           ENDIF 
     1327        ELSE 
     1328           ALLOCATE(z0_g(0,1)) 
    12821329        ENDIF 
    12831330        CALL bcast(Flag) 
    1284         IF (.NOT. Flag) CALL scatter2D(z0_g,z0) 
    1285         IF (is_root_prc) & 
    1286              DEALLOCATE(z0_g) 
     1331        IF (.NOT. Flag) & 
     1332             CALL scatter2D(z0_g,z0) 
     1333        DEALLOCATE(z0_g) 
    12871334!------- 
    12881335        DO ik=1,nbindex 
    … …  
    13811428      IF (longprint) THEN 
    13821429         WRITE(numout,*) "dim2_driver ",it_force  
    1383          WRITE(numout,*) ">> Index of land points =",kindex 
     1430         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex) 
    13841431         WRITE(numout,*) "Lowest level wind speed North = ", & 
    13851432           &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
    … …  
    15471594!- 
    15481595  var_name = 'fluxsens' 
    1549   IF (is_root_prc) & 
    1550        ALLOCATE(fluxsens_g(iim_g,jjm_g)) 
     1596  IF (is_root_prc) THEN 
     1597     ALLOCATE(fluxsens_g(iim_g,jjm_g)) 
     1598  ELSE 
     1599     ALLOCATE(fluxsens_g(0,1)) 
     1600  ENDIF 
    15511601  CALL gather2D(fluxsens , fluxsens_g) 
    15521602  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, fluxsens_g) 
    1553   IF (is_root_prc) & 
    1554        DEALLOCATE(fluxsens_g) 
     1603  DEALLOCATE(fluxsens_g) 
    15551604   
    15561605  var_name = 'vevapp' 
    1557   IF (is_root_prc) & 
    1558        ALLOCATE(vevapp_g(iim_g,jjm_g)) 
     1606  IF (is_root_prc) THEN 
     1607     ALLOCATE(vevapp_g(iim_g,jjm_g)) 
     1608  ELSE 
     1609     ALLOCATE(vevapp_g(0,1)) 
     1610  ENDIF 
    15591611  CALL gather2D( vevapp, vevapp_g) 
    15601612  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, vevapp_g) 
    1561   IF (is_root_prc) & 
    1562        DEALLOCATE(vevapp_g) 
     1613  DEALLOCATE(vevapp_g) 
    15631614   
    15641615  var_name = 'zlev_old' 
    1565   IF (is_root_prc) & 
    1566        ALLOCATE(old_zlev_g(iim_g,jjm_g)) 
     1616  IF (is_root_prc) THEN 
     1617     ALLOCATE(old_zlev_g(iim_g,jjm_g)) 
     1618  ELSE 
     1619     ALLOCATE(old_zlev_g(0,1)) 
     1620  ENDIF 
    15671621  CALL gather2D( old_zlev, old_zlev_g) 
    15681622  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_zlev_g) 
    1569   IF (is_root_prc) & 
    1570        DEALLOCATE(old_zlev_g) 
     1623  DEALLOCATE(old_zlev_g) 
    15711624   
    15721625  var_name = 'qair_old' 
    1573   IF (is_root_prc) & 
    1574        ALLOCATE(old_qair_g(iim_g,jjm_g)) 
     1626  IF (is_root_prc) THEN 
     1627     ALLOCATE(old_qair_g(iim_g,jjm_g)) 
     1628  ELSE 
     1629     ALLOCATE(old_qair_g(0,1)) 
     1630  ENDIF 
    15751631  CALL gather2D( old_qair, old_qair_g) 
    15761632  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_qair_g) 
    1577   IF (is_root_prc) & 
    1578        DEALLOCATE(old_qair_g) 
     1633  DEALLOCATE(old_qair_g) 
    15791634   
    15801635  var_name = 'eair_old' 
    1581   IF (is_root_prc) & 
    1582        ALLOCATE(old_eair_g(iim_g,jjm_g)) 
     1636  IF (is_root_prc) THEN 
     1637     ALLOCATE(old_eair_g(iim_g,jjm_g)) 
     1638  ELSE 
     1639     ALLOCATE(old_eair_g(0,1)) 
     1640  ENDIF 
    15831641  CALL gather2D( old_eair, old_eair_g) 
    15841642  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_eair_g) 
    1585   IF (is_root_prc) & 
    1586        DEALLOCATE(old_eair_g) 
     1643  DEALLOCATE(old_eair_g) 
    15871644   
    15881645  var_name = 'rau_old' 
    1589   IF (is_root_prc) & 
    1590        ALLOCATE(for_rau_g(iim_g,jjm_g)) 
     1646  IF (is_root_prc) THEN 
     1647     ALLOCATE(for_rau_g(iim_g,jjm_g)) 
     1648  ELSE 
     1649     ALLOCATE(for_rau_g(0,1)) 
     1650  ENDIF 
    15911651  CALL gather2D( for_rau, for_rau_g) 
    15921652  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, for_rau_g) 
    1593   IF (is_root_prc) & 
    1594        DEALLOCATE(for_rau_g) 
     1653  DEALLOCATE(for_rau_g) 
    15951654   
    1596   IF (is_root_prc) & 
    1597        ALLOCATE(albedo_g(iim_g,jjm_g)) 
     1655  IF (is_root_prc) THEN 
     1656     ALLOCATE(albedo_g(iim_g,jjm_g)) 
     1657  ELSE 
     1658     ALLOCATE(albedo_g(0,1)) 
     1659  ENDIF 
    15981660  var_name= 'albedo_vis' 
    15991661  albedo_vis(:,:)=albedo(:,:,1) 
    … …  
    16051667  CALL gather2D(albedo_nir,albedo_g) 
    16061668  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)   
    1607   IF (is_root_prc) & 
    1608        DEALLOCATE(albedo_g) 
     1669  DEALLOCATE(albedo_g) 
    16091670 
    1610   IF (is_root_prc) & 
    1611        ALLOCATE(z0_g(iim_g,jjm_g)) 
     1671  IF (is_root_prc) THEN 
     1672     ALLOCATE(z0_g(iim_g,jjm_g)) 
     1673  ELSE 
     1674     ALLOCATE(z0_g(0,1)) 
     1675  ENDIF 
    16121676  var_name= 'z0' 
    16131677  CALL gather2D(z0,z0_g) 
    16141678  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, z0_g)   
    1615   IF (is_root_prc) & 
    1616        DEALLOCATE(z0_g) 
     1679  DEALLOCATE(z0_g) 
    16171680 
    16181681  if (.NOT. is_watchout) THEN 
    1619   var_name = 'petAcoef' 
    1620      IF (is_root_prc) & 
    1621           ALLOCATE(petAcoef_g(iim_g,jjm_g)) 
     1682     var_name = 'petAcoef' 
     1683     IF (is_root_prc) THEN 
     1684        ALLOCATE(petAcoef_g(iim_g,jjm_g)) 
     1685     ELSE 
     1686        ALLOCATE(petAcoef_g(0,1)) 
     1687     ENDIF 
    16221688     CALL gather2D( petAcoef, petAcoef_g) 
    16231689     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petAcoef_g) 
    1624      IF (is_root_prc) & 
    1625           DEALLOCATE(petAcoef_g) 
     1690     DEALLOCATE(petAcoef_g) 
    16261691   
    1627   var_name = 'petBcoef' 
    1628      IF (is_root_prc) & 
    1629           ALLOCATE(petBcoef_g(iim_g,jjm_g)) 
     1692     var_name = 'petBcoef' 
     1693     IF (is_root_prc) THEN 
     1694        ALLOCATE(petBcoef_g(iim_g,jjm_g)) 
     1695     ELSE 
     1696        ALLOCATE(petBcoef_g(0,1)) 
     1697     ENDIF 
    16301698     CALL gather2D( petBcoef, petBcoef_g) 
    16311699     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petBcoef_g) 
    1632      IF (is_root_prc) & 
    1633           DEALLOCATE(petBcoef_g) 
     1700     DEALLOCATE(petBcoef_g) 
    16341701   
    1635   var_name = 'peqAcoef' 
    1636      IF (is_root_prc) & 
    1637           ALLOCATE(peqAcoef_g(iim_g,jjm_g)) 
     1702     var_name = 'peqAcoef' 
     1703     IF (is_root_prc) THEN 
     1704        ALLOCATE(peqAcoef_g(iim_g,jjm_g)) 
     1705     ELSE 
     1706        ALLOCATE(peqAcoef_g(0,1)) 
     1707     ENDIF 
    16381708     CALL gather2D( peqAcoef, peqAcoef_g) 
    16391709     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqAcoef_g) 
    1640      IF (is_root_prc) & 
    1641           DEALLOCATE(peqAcoef_g) 
     1710     DEALLOCATE(peqAcoef_g) 
    16421711   
    1643   var_name = 'peqBcoef' 
    1644      IF (is_root_prc) & 
    1645           ALLOCATE(peqBcoef_g(iim_g,jjm_g)) 
     1712     var_name = 'peqBcoef' 
     1713     IF (is_root_prc) THEN 
     1714        ALLOCATE(peqBcoef_g(iim_g,jjm_g)) 
     1715     ELSE 
     1716        ALLOCATE(peqBcoef_g(0,1)) 
     1717     ENDIF 
    16461718     CALL gather2D( peqBcoef, peqBcoef_g) 
    16471719     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqBcoef_g) 
    1648      IF (is_root_prc) & 
    1649           DEALLOCATE(peqBcoef_g) 
     1720     DEALLOCATE(peqBcoef_g) 
    16501721  ENDIF 
    16511722!- 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/forcesoil.f90

    r119 r405  
    2121  IMPLICIT NONE 
    2222  !- 
    23   CHARACTER(LEN=80) :: sto_restname_in,sto_restname_out,var_name 
     23  CHARACTER(LEN=80) :: sto_restname_in,sto_restname_out 
    2424  INTEGER(i_std)                             :: iim,jjm 
     25 
    2526  INTEGER(i_std),PARAMETER                   :: llm = 1 
    2627  INTEGER(i_std)                             :: kjpindex 
     28 
    2729  INTEGER(i_std)                             :: itau_dep,itau_len 
    2830  CHARACTER(LEN=30)                         :: time_str 
    29   INTEGER(i_std)                             :: ier,iret 
    3031  REAL(r_std)                                :: dt_files 
    3132  REAL(r_std)                                :: date0 
    3233  INTEGER(i_std)                             :: rest_id_sto 
    33   INTEGER(i_std)                             :: ncfid 
    34   REAL(r_std)                                :: dt_force,dt_forcesoil 
     34  CHARACTER(LEN=20), SAVE                    :: thecalendar = 'noleap' 
     35  !- 
     36  CHARACTER(LEN=100) :: Cforcing_name 
     37  INTEGER            :: Cforcing_id 
     38  INTEGER            :: v_id 
     39  REAL(r_std)                                :: dt_forcesoil 
    3540  INTEGER                                   :: nparan 
    36   INTEGER,PARAMETER                         :: nparanmax=36 
    37   REAL(r_std)                                :: xbid1,xbid2 
    38   INTEGER(i_std)                             :: ibid 
     41 
    3942  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices 
     43  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices_g 
     44  REAL(r_std),DIMENSION(:),ALLOCATABLE       :: x_indices_g 
     45  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: lon, lat 
    4046  REAL(r_std),DIMENSION(llm)                 :: lev 
    41   REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE :: soilcarbon_input 
    42   REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: & 
    43        &  carbon,control_moist,control_temp 
    44   REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: & 
    45        &  lon,lat,resp_hetero_soil,var_3d 
    46   REAL(r_std),DIMENSION(:),ALLOCATABLE       :: & 
    47        &  x_indices 
    48   REAL(r_std)                                :: time 
    49   INTEGER                                   :: i,j,m,iatt,iv 
     47 
     48 
     49  INTEGER                                   :: i,m,iatt,iv,iyear 
     50 
     51  CHARACTER(LEN=80)                         :: var_name 
    5052  CHARACTER(LEN=400)                        :: taboo_vars 
    5153  REAL(r_std),DIMENSION(1)                   :: xtmp 
    … …  
    5759  INTEGER,DIMENSION(varnbdim_max)           :: vardims 
    5860  LOGICAL                                   :: l1d 
     61  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: var_3d 
    5962  REAL(r_std)                                :: x_tmp 
    60   ! clay fraction 
    61   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: clay 
    62   !- 
    6363  ! string suffix indicating an index 
    6464  CHARACTER(LEN=10)  :: part_str 
    6565  ! 
    66   CHARACTER(LEN=100) :: Cforcing_name 
    67   INTEGER            :: Cforcing_id 
    68   INTEGER            :: v_id 
    69  
    70   REAL(r_std),ALLOCATABLE :: clay_loc(:) 
    71   REAL(r_std),ALLOCATABLE :: soilcarbon_input_loc(:,:,:,:) 
    72   REAL(r_std),ALLOCATABLE :: control_temp_loc(:,:,:) 
    73   REAL(r_std),ALLOCATABLE :: control_moist_loc(:,:,:) 
    74   REAL(r_std),ALLOCATABLE :: carbon_loc(:,:,:) 
    75   INTEGER :: ierr 
     66  ! clay fraction 
     67  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: clay_g 
     68  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE :: soilcarbon_input_g 
     69  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: control_temp_g 
     70  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: control_moist_g 
     71  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE   :: carbon_g 
     72 
     73  REAL(r_std),ALLOCATABLE :: clay(:) 
     74  REAL(r_std),ALLOCATABLE :: soilcarbon_input(:,:,:,:) 
     75  REAL(r_std),ALLOCATABLE :: control_temp(:,:,:) 
     76  REAL(r_std),ALLOCATABLE :: control_moist(:,:,:) 
     77  REAL(r_std),ALLOCATABLE :: carbon(:,:,:) 
     78  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: resp_hetero_soil 
     79 
     80  INTEGER(i_std)                             :: ier,iret 
     81 
     82  LOGICAL :: debug 
    7683 
    7784  CALL Init_para(.FALSE.)  
    78  
     85  CALL init_timer 
     86 
     87!--------------------------------------------------------------------- 
     88!- 
     89! set debug to have more information 
     90!- 
     91  !Config  Key  = DEBUG_INFO 
     92  !Config  Desc = Flag for debug information 
     93  !Config  Def  = n 
     94  !Config  Help = This option allows to switch on the output of debug 
     95  !Config         information without recompiling the code. 
     96!- 
     97  debug = .FALSE. 
     98  CALL getin_p('DEBUG_INFO',debug) 
    7999  !- 
    80100  ! Stomate's restart files 
    … …  
    83103     sto_restname_in = 'stomate_start.nc' 
    84104     CALL getin ('STOMATE_RESTART_FILEIN',sto_restname_in) 
    85      WRITE(*,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in) 
    86      sto_restname_out = 'stomate_restart.nc' 
     105     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in) 
     106     sto_restname_out = 'stomate_rest_out.nc' 
    87107     CALL getin ('STOMATE_RESTART_FILEOUT',sto_restname_out) 
    88      WRITE(*,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out) 
    89      !- 
    90      ! We need to know iim, jjm. 
     108     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out) 
     109     !- 
     110     ! We need to know iim_g, jjm. 
    91111     ! Get them from the restart files themselves. 
    92112     !- 
    93      iret = NF90_OPEN (sto_restname_in, NF90_NOWRITE, ncfid) 
    94      iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim) 
    95      iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm) 
    96      iret = NF90_CLOSE (ncfid) 
     113     iret = NF90_OPEN (sto_restname_in, NF90_NOWRITE, rest_id_sto) 
     114     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,1,len=iim_g) 
     115     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,2,len=jjm_g) 
     116     iret = NF90_INQ_VARID (rest_id_sto, "time", iv) 
     117     iret = NF90_GET_ATT (rest_id_sto, iv, 'calendar',thecalendar) 
     118     iret = NF90_CLOSE (rest_id_sto) 
     119     i=INDEX(thecalendar,ACHAR(0)) 
     120     IF ( i > 0 ) THEN 
     121        thecalendar(i:20)=' ' 
     122     ENDIF 
    97123     !- 
    98124     ! Allocate longitudes and latitudes 
    99125     !- 
    100      ALLOCATE (lon(iim,jjm)) 
    101      ALLOCATE (lat(iim,jjm)) 
     126     ALLOCATE (lon(iim_g,jjm_g)) 
     127     ALLOCATE (lat(iim_g,jjm_g)) 
    102128     lon(:,:) = 0.0 
    103129     lat(:,:) = 0.0 
    … …  
    105131     !- 
    106132     CALL restini & 
    107           & (sto_restname_in, iim, jjm, lon, lat, llm, lev, & 
     133          & (sto_restname_in, iim_g, jjm_g, lon, lat, llm, lev, & 
    108134          &  sto_restname_out, itau_dep, date0, dt_files, rest_id_sto) 
    109135  ENDIF 
     136  CALL bcast(date0) 
     137  CALL bcast(thecalendar) 
     138  WRITE(numout,*) "calendar = ",thecalendar 
    110139  !- 
    111140  ! calendar 
    112141  !- 
    113   CALL bcast(date0) 
    114 !!! MM : à revoir : choix du calendrier dans forcesoil ?? Il est dans le restart de stomate ! 
    115   !  CALL ioconf_calendar ('noleap') 
     142  CALL ioconf_calendar (thecalendar) 
    116143  CALL ioget_calendar  (one_year,one_day) 
    117  
    118144  CALL ioconf_startdate(date0) 
    119  
     145  ! 
    120146  IF (is_root_prc) THEN 
    121147     !- 
    122148     ! open FORCESOIL's forcing file to read some basic info 
    123149     !- 
    124      Cforcing_name = 'stomate_Cforcing.nc' 
     150     Cforcing_name = 'NONE' 
    125151     CALL getin ('STOMATE_CFORCING_NAME',Cforcing_name) 
    126152     !- 
    127      ier = NF90_OPEN (TRIM(Cforcing_name),NF90_NOWRITE,Cforcing_id) 
     153     iret = NF90_OPEN (TRIM(Cforcing_name),NF90_NOWRITE,Cforcing_id) 
     154     IF (iret /= NF90_NOERR) THEN 
     155        CALL ipslerr (3,'forcesoil', & 
     156             &        'Could not open file : ', & 
     157             &          Cforcing_name,'(Do you have forget it ?)') 
     158     ENDIF 
    128159     !- 
    129160     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'kjpindex',x_tmp) 
    130      kjpindex = NINT(x_tmp) 
     161     nbp_glo = NINT(x_tmp) 
    131162     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nparan',x_tmp) 
    132163     nparan = NINT(x_tmp) 
    133164     !- 
    134      ALLOCATE (indices(kjpindex)) 
    135      ALLOCATE (clay(kjpindex)) 
    136      !- 
    137      ALLOCATE (x_indices(kjpindex),stat=ier) 
     165     ALLOCATE (indices_g(nbp_glo)) 
     166     ALLOCATE (clay_g(nbp_glo)) 
     167     !- 
     168     ALLOCATE (x_indices_g(nbp_glo),stat=ier) 
    138169     ier = NF90_INQ_VARID (Cforcing_id,'index',v_id) 
    139      ier = NF90_GET_VAR   (Cforcing_id,v_id,x_indices) 
    140      indices(:) = NINT(x_indices(:)) 
    141      DEALLOCATE (x_indices) 
     170     ier = NF90_GET_VAR   (Cforcing_id,v_id,x_indices_g) 
     171     indices_g(:) = NINT(x_indices_g(:)) 
     172     WRITE(numout,*) mpi_rank,"indices globaux : ",indices_g 
     173     DEALLOCATE (x_indices_g) 
    142174     !- 
    143175     ier = NF90_INQ_VARID (Cforcing_id,'clay',v_id) 
    144      ier = NF90_GET_VAR   (Cforcing_id,v_id,clay) 
     176     ier = NF90_GET_VAR   (Cforcing_id,v_id,clay_g) 
    145177     !- 
    146178     ! time step of forcesoil 
    147179     !- 
    148180     dt_forcesoil = one_year / FLOAT(nparan) 
    149      WRITE(*,*) 'time step (d): ',dt_forcesoil 
     181     WRITE(numout,*) 'time step (d): ',dt_forcesoil 
    150182     !- 
    151183     ! read (and partially write) the restart file 
    … …  
    182214                &      (rest_id_sto, varnames(iv), varnbdim_max, varnbdim, vardims) 
    183215           l1d = ALL(vardims(1:varnbdim) == 1) 
    184            !---- 
    185            ALLOCATE( var_3d(kjpindex,vardims(3)), stat=ier) 
    186            IF (ier /= 0) STOP 'ALLOCATION PROBLEM' 
    187216           !---- read it 
    188217           IF (l1d) THEN 
    … …  
    191220                   &         1, itau_dep, .TRUE., xtmp) 
    192221           ELSE 
     222              ALLOCATE( var_3d(nbp_glo,vardims(3)), stat=ier) 
     223              IF (ier /= 0) STOP 'ALLOCATION PROBLEM' 
     224              !---- 
    193225              CALL restget & 
    194                    &        (rest_id_sto, TRIM(varnames(iv)), kjpindex, vardims(3), & 
    195                    &         1, itau_dep, .TRUE., var_3d, "gather", kjpindex, indices) 
     226                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), & 
     227                   &         1, itau_dep, .TRUE., var_3d, "gather", nbp_glo, indices_g) 
    196228           ENDIF 
    197229           !---- write it 
    … …  
    202234           ELSE 
    203235              CALL restput & 
    204                    &        (rest_id_sto, TRIM(varnames(iv)), kjpindex, vardims(3), & 
    205                    &         1, itau_dep, var_3d, 'scatter',  kjpindex, indices) 
     236                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), & 
     237                   &         1, itau_dep, var_3d, 'scatter',  nbp_glo, indices_g) 
     238              !---- 
     239              DEALLOCATE(var_3d) 
    206240           ENDIF 
    207            !---- 
    208            DEALLOCATE(var_3d) 
    209241        ENDIF 
    210242     ENDDO 
    … …  
    212244     ! read soil carbon 
    213245     !- 
    214      ALLOCATE(carbon(kjpindex,ncarb,nvm)) 
    215      carbon(:,:,:) = val_exp 
     246     ALLOCATE(carbon_g(nbp_glo,ncarb,nvm)) 
     247     carbon_g(:,:,:) = val_exp 
    216248     DO m = 1, nvm 
    217249        WRITE (part_str, '(I2)') m 
    … …  
    219251        var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str)) 
    220252        CALL restget & 
    221              &    (rest_id_sto, var_name, kjpindex, ncarb , 1, itau_dep, & 
    222              &     .TRUE., carbon(:,:,m), 'gather', kjpindex, indices) 
    223         IF (ALL(carbon(:,:,m) == val_exp)) carbon(:,:,m) = zero 
     253             &    (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, & 
     254             &     .TRUE., carbon_g(:,:,m), 'gather', nbp_glo, indices_g) 
     255        IF (ALL(carbon_g(:,:,m) == val_exp)) carbon_g(:,:,m) = zero 
    224256        !-- do not write this variable: it will be modified. 
    225257     ENDDO 
     258     WRITE(numout,*) "date0 : ",date0, itau_dep 
    226259     !- 
    227260     ! Length of run 
    … …  
    229262     WRITE(time_str,'(a)') '10000Y' 
    230263     CALL getin('TIME_LENGTH', time_str) 
     264     write(numout,*) 'Number of years for carbon spinup : ',time_str 
    231265     ! transform into itau 
    232      CALL tlen2itau(time_str, dt_forcesoil*one_year, date0, itau_len) 
    233      write(*,*) 'Number of time steps to do: ',itau_len 
     266     CALL tlen2itau(time_str, dt_forcesoil*one_day, date0, itau_len) 
     267     write(numout,*) 'Number of time steps to do: ',itau_len 
    234268     !- 
    235269     ! read the rest of the forcing file and store forcing in an array. 
    236270     ! We read an average year. 
    237271     !- 
    238      ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan)) 
    239      ALLOCATE(control_temp(kjpindex,nlevs,nparan)) 
    240      ALLOCATE(control_moist(kjpindex,nlevs,nparan)) 
     272     ALLOCATE(soilcarbon_input_g(nbp_glo,ncarb,nvm,nparan)) 
     273     ALLOCATE(control_temp_g(nbp_glo,nlevs,nparan)) 
     274     ALLOCATE(control_moist_g(nbp_glo,nlevs,nparan)) 
    241275     !- 
    242276     ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',v_id) 
    243      ier = NF90_GET_VAR   (Cforcing_id,v_id,soilcarbon_input) 
     277     ier = NF90_GET_VAR   (Cforcing_id,v_id,soilcarbon_input_g) 
    244278     ier = NF90_INQ_VARID (Cforcing_id,   'control_moist',v_id) 
    245      ier = NF90_GET_VAR   (Cforcing_id,v_id,control_moist) 
     279     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_moist_g) 
    246280     ier = NF90_INQ_VARID (Cforcing_id,    'control_temp',v_id) 
    247      ier = NF90_GET_VAR   (Cforcing_id,v_id,control_temp) 
     281     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_temp_g) 
    248282     !- 
    249283     ier = NF90_CLOSE (Cforcing_id) 
    250284     !- 
    251      !MM Problem here with dpu which depends on soil type            
    252      DO iv = 1, nbdl-1 
    253         ! first 2.0 is dpu  
    254         ! second 2.0 is average 
    255         diaglev(iv) = 2.0/(2**(nbdl-1) -1) * ( ( 2**(iv-1) -1) + ( 2**(iv) -1) ) / 2.0 
    256      ENDDO 
    257      diaglev(nbdl) = 2.0 
    258      !- 
    259      ! For sequential use only, we must initialize data_para : 
     285  ENDIF 
     286  CALL bcast(nparan) 
     287  CALL bcast(dt_forcesoil) 
     288  CALL bcast(iim_g) 
     289  CALL bcast(jjm_g) 
     290  call bcast(nbp_glo) 
     291  CALL bcast(itau_dep) 
     292  CALL bcast(itau_len) 
     293  ! 
     294  ! We must initialize data_para : 
    260295     ! 
    261296     ! 
    262   ENDIF 
    263  
    264   CALL bcast(iim) 
    265   CALL bcast(jjm) 
    266   call bcast(kjpindex) 
    267   CALL init_data_para(iim,jjm,kjpindex,indices) 
    268  
     297  CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g) 
     298 
     299  kjpindex=nbp_loc 
     300  jjm=jj_nb 
     301  iim=iim_g 
     302  IF (debug) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm 
     303 
     304  !--- 
     305  !--- Create the index table 
     306  !--- 
     307  !--- This job return a LOCAL kindex 
     308  !--- 
     309  ALLOCATE (indices(kjpindex),stat=ier) 
     310  CALL scatter(indices_g,indices) 
     311  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g 
     312  IF (debug) WRITE(numout,*) mpi_rank,"indices locaux = ",indices(1:kjpindex) 
    269313  !- 
    270314  !- 
    271315  ! there we go: time loop 
    272316  !- 
    273   CALL bcast(nparan) 
    274   ALLOCATE(clay_loc(nbp_loc)) 
    275   ALLOCATE(soilcarbon_input_loc(nbp_loc,ncarb,nvm,nparan)) 
    276   ALLOCATE(control_temp_loc(nbp_loc,nlevs,nparan)) 
    277   ALLOCATE(control_moist_loc(nbp_loc,nlevs,nparan)) 
    278   ALLOCATE(carbon_loc(nbp_loc,ncarb,nvm)) 
    279   ALLOCATE(resp_hetero_soil(nbp_loc,nvm)) 
     317  ALLOCATE(clay(kjpindex)) 
     318  ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan)) 
     319  ALLOCATE(control_temp(kjpindex,nlevs,nparan)) 
     320  ALLOCATE(control_moist(kjpindex,nlevs,nparan)) 
     321  ALLOCATE(carbon(kjpindex,ncarb,nvm)) 
     322  ALLOCATE(resp_hetero_soil(kjpindex,nvm)) 
    280323  iatt = 0 
    281324 
    282   CALL bcast(itau_len) 
    283   CALL bcast(nparan) 
    284   CALL bcast(dt_forcesoil) 
    285   CALL Scatter(clay,clay_loc) 
    286   CALL Scatter(soilcarbon_input,soilcarbon_input_loc) 
    287   CALL Scatter(control_temp,control_temp_loc) 
    288   CALL Scatter(control_moist,control_moist_loc) 
    289   CALL Scatter(carbon,carbon_loc) 
    290  
     325  CALL Scatter(clay_g,clay) 
     326  CALL Scatter(soilcarbon_input_g,soilcarbon_input) 
     327  CALL Scatter(control_temp_g,control_temp) 
     328  CALL Scatter(control_moist_g,control_moist) 
     329  CALL Scatter(carbon_g,carbon) 
     330 
     331  iyear=1 
    291332  DO i=1,itau_len 
    292333     iatt = iatt+1 
    293      IF (iatt > nparan) iatt = 1 
     334     IF (iatt > nparan) THEN 
     335        IF (debug) WRITE(numout,*) iyear 
     336        iatt = 1 
     337        iyear=iyear+1 
     338     ENDIF 
    294339     CALL soilcarbon & 
    295           &    (nbp_loc, dt_forcesoil, clay_loc, & 
    296           &     soilcarbon_input_loc(:,:,:,iatt), & 
    297           &     control_temp_loc(:,:,iatt), control_moist_loc(:,:,iatt), & 
    298           &     carbon_loc, resp_hetero_soil) 
     340          &    (kjpindex, dt_forcesoil, clay, & 
     341          &     soilcarbon_input(:,:,:,iatt), & 
     342          &     control_temp(:,:,iatt), control_moist(:,:,iatt), & 
     343          &     carbon, resp_hetero_soil) 
    299344  ENDDO 
    300  
    301   CALL Gather(carbon_loc,carbon) 
     345  WRITE(numout,*) "End of soilcarbon LOOP." 
     346  CALL Gather(carbon,carbon_g) 
    302347  !- 
    303348  ! write new carbon into restart file 
    … …  
    309354        var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str)) 
    310355        CALL restput & 
    311              &    (rest_id_sto, var_name, kjpindex, ncarb , 1, itau_dep, & 
    312              &     carbon(:,:,m), 'scatter', kjpindex, indices) 
     356             &    (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, & 
     357             &     carbon_g(:,:,m), 'scatter', nbp_glo, indices_g) 
    313358     ENDDO 
    314359     !- 
    … …  
    317362  ENDIF 
    318363#ifdef CPP_PARA 
    319   CALL MPI_FINALIZE(ierr) 
     364  CALL MPI_FINALIZE(ier) 
    320365#endif 
     366  WRITE(numout,*) "End of forcesoil." 
    321367  !-------------------- 
    322368END PROGRAM forcesoil 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/readdim2.f90

    r119 r405  
    132132    !- 
    133133    CALL ioget_calendar(calendar_str) 
     134    i=INDEX(calendar_str,ACHAR(0)) 
     135    IF ( i > 0 ) THEN 
     136       calendar_str(i:20)=' ' 
     137    ENDIF 
    134138    !  WRITE(numout,*) "forcing_info : Calendar used : ",calendar_str 
    135139    IF ( calendar_str == 'XXXX' ) THEN 

  • tags/ORCHIDEE_1_9_5_2/ORCHIDEE_OL/teststomate.f90

    r119 r405  
    2323  USE slowproc 
    2424  USE stomate 
    25   USE intersurf, ONLY: stom_define_history , intsurf_time 
     25  USE intersurf, ONLY: stom_define_history, stom_ipcc_define_history, intsurf_time, l_first_intersurf, check_time 
    2626  USE parallel 
    2727!- 
    … …  
    3030! Declarations 
    3131!- 
    32   INTEGER(i_std) :: vegax_id 
    3332  INTEGER(i_std)                            :: kjpij,kjpindex 
    3433  REAL(r_std)                               :: dtradia,dt_force 
     34 
    3535  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices 
    3636  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indexveg 
    … …  
    4343  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_force_x 
    4444  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_force_x 
    45   REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lon,lat 
    4645  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: t2m,t2m_min,temp_sol 
    4746  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltemp,soilhum 
    … …  
    5554  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: qsintmax_x 
    5655  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: co2_flux 
     56  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: fco2_lu 
     57 
     58  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices_g 
     59  REAL(r_std),DIMENSION(:),ALLOCATABLE   :: x_indices_g 
     60  REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: x_neighbours_g 
     61 
    5762  INTEGER    :: ier,iret 
    5863  INTEGER    :: ncfid 
     64  CHARACTER(LEN=20),SAVE                      :: thecalendar='noleap' 
     65 
    5966  LOGICAL    :: a_er 
    6067  CHARACTER(LEN=80) :: & 
    6168 &  dri_restname_in,dri_restname_out, & 
    6269 &  sec_restname_in,sec_restname_out, & 
    63  &  sto_restname_in,sto_restname_out, stom_histname 
    64   INTEGER(i_std)                    :: iim,jjm 
    65   INTEGER(i_std),PARAMETER          :: llm = 1 
    66   REAL(r_std),DIMENSION(llm)        :: lev 
    67   REAL(r_std)                       :: dt_files 
    68   INTEGER(i_std)                    :: itau_dep,itau,itau_len,itau_step 
     70 &  sto_restname_in,sto_restname_out, & 
     71 &  stom_histname, stom_ipcc_histname 
     72  INTEGER(i_std)                    :: iim,jjm,llm 
     73  REAL, ALLOCATABLE, DIMENSION(:,:)  :: lon, lat 
     74  REAL, ALLOCATABLE, DIMENSION(:)    :: lev 
     75  LOGICAL                            :: rectilinear 
     76  REAL, ALLOCATABLE, DIMENSION(:)    :: lon_rect, lat_rect 
     77  REAL(r_std)                       :: dt 
     78  INTEGER(i_std)                    :: itau_dep,itau_fin,itau,itau_len,itau_step 
    6979  REAL(r_std)                       :: date0 
    7080  INTEGER(i_std)                    :: rest_id_sec,rest_id_sto 
    71   INTEGER(i_std)                    :: hist_id_sec,hist_id_sec2,hist_id_sto,hist_id_stom_IPCC 
     81  INTEGER(i_std)                    :: hist_id_sec,hist_id_sec2,hist_id_stom,hist_id_stom_IPCC 
    7282  CHARACTER(LEN=30)                :: time_str 
    73   REAL                             :: hist_days_stom,hist_dt_stom 
     83  REAL(r_std)                       :: dt_slow_ 
     84  REAL                             :: hist_days_stom,hist_days_stom_ipcc,hist_dt_stom,hist_dt_stom_ipcc 
    7485  REAL,DIMENSION(nvm)              :: hist_PFTaxis 
    7586  REAL(r_std),DIMENSION(10)         :: hist_pool_10axis      
    … …  
    7788  REAL(r_std),DIMENSION(11)         :: hist_pool_11axis      
    7889  REAL(r_std),DIMENSION(101)        :: hist_pool_101axis      
    79   INTEGER                          :: hist_PFTaxis_id,hori_id 
     90  INTEGER                          :: hist_PFTaxis_id,hist_IPCC_PFTaxis_id,hori_id 
    8091  INTEGER                          :: hist_pool_10axis_id 
    8192  INTEGER                          :: hist_pool_100axis_id 
    8293  INTEGER                          :: hist_pool_11axis_id 
    8394  INTEGER                          :: hist_pool_101axis_id 
    84   INTEGER                          :: hist_level 
    85   INTEGER,PARAMETER                :: max_hist_level = 10 
    86   INTEGER(i_std)                    :: i,j,iv,id 
    87   CHARACTER*80                     :: var_name 
    88   CHARACTER(LEN=40),DIMENSION(10)  ::  fluxop 
     95  INTEGER(i_std)                    :: i,j,iv 
    8996  LOGICAL                          :: ldrestart_read,ldrestart_write 
    9097  LOGICAL                          :: l1d 
    … …  
    98105  REAL(r_std),DIMENSION(1)         :: xtmp 
    99106  INTEGER                          :: nsfm,nsft 
    100   INTEGER                          :: iisf 
    101   INTEGER(i_std)                    :: max_totsize,totsize_1step 
    102   INTEGER(i_std),DIMENSION(0:2)     :: ifirst,ilast 
    103   INTEGER(i_std)                    :: iblocks,nblocks 
    104   INTEGER,PARAMETER                :: ndm = 10 
    105   INTEGER,DIMENSION(ndm)           :: start,count 
    106   INTEGER                          :: ndim,v_id 
    107   INTEGER                          :: force_id 
     107  INTEGER                          :: iisf,iiisf 
     108  INTEGER(i_std)                    :: max_totsize,totsize_1step,totsize_tmp 
     109 
     110  INTEGER                          :: vid 
    108111  CHARACTER(LEN=100)               :: forcing_name 
    109112  REAL                             :: x 
    110   REAL(r_std),DIMENSION(:),ALLOCATABLE   :: x_indices 
    111   REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: x_neighbours 
     113 
    112114  REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: var_3d 
     115  REAL(r_std) :: var_1d(1) 
     116 
    113117!- 
    114118  REAL(r_std)                             :: time_sec,time_step_sec 
    … …  
    116120  REAL(r_std),DIMENSION(1)                :: r1d 
    117121  REAL(r_std)                             :: julian,djulian 
    118 ! REAL(r_std),DIMENSION(:,:),ALLOCATABLE  :: soiltype 
    119 !- 
    120 ! the following variables contain the forcing data 
    121 !- 
    122   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: clay_fm 
    123   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: humrel_x_fm 
    124   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: litterhum_fm 
    125   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: t2m_fm 
    126   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: t2m_min_fm 
    127   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: temp_sol_fm 
    128   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soiltemp_fm 
    129   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soilhum_fm 
    130   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: precip_fm 
    131   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: gpp_x_fm 
    132   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: veget_force_x_fm 
    133   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: veget_max_force_x_fm 
    134   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: lai_force_x_fm 
    135   INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: isf 
    136   LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:)         :: nf_written 
    137   INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nf_cumul 
    138   INTEGER(i_std)                                :: ji,jv 
     122 
     123  INTEGER(i_std)                                :: ji,jv,l 
     124 
     125  LOGICAL :: debug 
     126 
    139127!--------------------------------------------------------------------- 
    140 !- No parallelisation yet in teststomate ! 
    141 #ifdef CPP_PARA 
     128 
     129  CALL init_para(.FALSE.) 
     130  CALL init_timer 
     131 
     132  IF (is_root_prc) THEN 
     133     !- 
     134     ! open STOMATE's forcing file to read some basic info 
     135     !- 
     136     forcing_name = 'stomate_forcing.nc' 
     137     CALL getin ('STOMATE_FORCING_NAME',forcing_name) 
     138     iret = NF90_OPEN (TRIM(forcing_name),NF90_NOWRITE,forcing_id) 
     139     IF (iret /= NF90_NOERR) THEN 
     140        CALL ipslerr (3,'teststomate', & 
     141             &        'Could not open file : ', & 
     142             &          forcing_name,'(Do you have forget it ?)') 
     143     ENDIF 
     144     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dtradia',dtradia) 
     145     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_slow',dt_force) 
     146     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'nsft',x) 
     147     nsft = NINT(x) 
     148     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpij',x) 
     149     kjpij = NINT(x) 
     150     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpindex',x) 
     151     nbp_glo = NINT(x) 
     152  ENDIF 
     153  CALL bcast(dtradia) 
     154  CALL bcast(dt_force) 
     155  CALL bcast(nsft) 
     156  CALL bcast(nbp_glo) 
     157  !- 
     158  write(numout,*) 'ATTENTION',dtradia,dt_force 
     159  !- 
     160  ! read info about land points 
     161  !- 
     162  IF (is_root_prc) THEN 
     163     a_er=.FALSE. 
     164     ALLOCATE (indices_g(nbp_glo),stat=ier) 
     165     a_er = a_er .OR. (ier.NE.0) 
     166     IF (a_er) THEN 
     167        CALL ipslerr (3,'teststomate', & 
     168             &        'PROBLEM WITH ALLOCATION', & 
     169             &        'for local variables 1','') 
     170     ENDIF 
     171     ! 
     172     ALLOCATE (x_indices_g(nbp_glo),stat=ier) 
     173     a_er = a_er .OR. (ier.NE.0) 
     174     IF (a_er) THEN 
     175        CALL ipslerr (3,'teststomate', & 
     176             &        'PROBLEM WITH ALLOCATION', & 
     177             &        'for global variables 1','') 
     178     ENDIF 
     179     ier = NF90_INQ_VARID (forcing_id,'index',vid) 
     180     IF (ier .NE. 0) THEN 
     181        CALL ipslerr (3,'teststomate', & 
     182             &        'PROBLEM WITH ALLOCATION', & 
     183             &        'for global variables 1','') 
     184     ENDIF 
     185     ier = NF90_GET_VAR   (forcing_id,vid,x_indices_g) 
     186     IF (iret /= NF90_NOERR) THEN 
     187        CALL ipslerr (3,'teststomate', & 
     188             &        'PROBLEM WITH variable "index" in file ', & 
     189             &        forcing_name,'(check this file)') 
     190     ENDIF 
     191     indices_g(:) = NINT(x_indices_g(:)) 
     192     DEALLOCATE (x_indices_g) 
     193  ELSE 
     194     ALLOCATE (indices_g(0)) 
     195  ENDIF 
     196!--------------------------------------------------------------------- 
     197!- 
     198! set debug to have more information 
     199!- 
     200  !Config  Key  = DEBUG_INFO 
     201  !Config  Desc = Flag for debug information 
     202  !Config  Def  = n 
     203  !Config  Help = This option allows to switch on the output of debug 
     204  !Config         information without recompiling the code. 
     205!- 
     206  debug = .FALSE. 
     207  CALL getin_p('DEBUG_INFO',debug) 
     208  ! 
     209  !Config Key  = LONGPRINT 
     210  !Config Desc = ORCHIDEE will print more messages 
     211  !Config Def  = n 
     212  !Config Help = This flag permits to print more debug messages in the run. 
     213  ! 
     214  long_print = .FALSE. 
     215  CALL getin_p('LONGPRINT',long_print) 
     216  !- 
     217  ! activate CO2, STOMATE, but not sechiba 
     218  !- 
     219  control%river_routing = .FALSE. 
     220  control%hydrol_cwrr = .FALSE. 
     221  control%ok_sechiba = .FALSE. 
     222  ! 
     223  control%stomate_watchout = .TRUE. 
     224  control%ok_co2 = .TRUE. 
     225  control%ok_stomate = .TRUE. 
     226  !- 
     227  ! is DGVM activated? 
     228  !- 
     229  control%ok_dgvm = .FALSE. 
     230  CALL getin_p('STOMATE_OK_DGVM',control%ok_dgvm) 
     231  WRITE(numout,*) 'LPJ is activated: ',control%ok_dgvm 
     232 
     233  !- 
     234  ! restart files 
     235  !- 
     236  IF (is_root_prc) THEN 
     237     ! Sechiba's restart files 
     238     sec_restname_in = 'sechiba_start.nc' 
     239     CALL getin('SECHIBA_restart_in',sec_restname_in) 
     240     WRITE(numout,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in) 
     241     IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN 
     242        STOP 'Need a restart file for Sechiba' 
     243     ENDIF 
     244     sec_restname_out = 'sechiba_rest_out.nc' 
     245     CALL getin('SECHIBA_rest_out',sec_restname_out) 
     246     WRITE(numout,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out) 
     247     ! Stomate's restart files 
     248     sto_restname_in = 'stomate_start.nc' 
     249     CALL getin('STOMATE_RESTART_FILEIN',sto_restname_in) 
     250     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in) 
     251     sto_restname_out = 'stomate_rest_out.nc' 
     252     CALL getin('STOMATE_RESTART_FILEOUT',sto_restname_out) 
     253     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out) 
     254 
     255     !- 
     256     ! We need to know iim, jjm. 
     257     ! Get them from the restart files themselves. 
     258     !- 
     259     iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid) 
     260     IF (iret /= NF90_NOERR) THEN 
     261        CALL ipslerr (3,'teststomate', & 
     262             &        'Could not open file : ', & 
     263             &          sec_restname_in,'(Do you have forget it ?)') 
     264     ENDIF 
     265     iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim_g) 
     266     iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm_g) 
     267     iret = NF90_INQ_VARID (ncfid, "time", iv) 
     268     iret = NF90_GET_ATT (ncfid, iv, 'calendar',thecalendar) 
     269     iret = NF90_CLOSE (ncfid) 
     270     i=INDEX(thecalendar,ACHAR(0)) 
     271     IF ( i > 0 ) THEN 
     272        thecalendar(i:20)=' ' 
     273     ENDIF 
     274  ENDIF 
     275  CALL bcast(iim_g) 
     276  CALL bcast(jjm_g) 
     277  CALL bcast(thecalendar) 
     278  !- 
     279  ! calendar 
     280  !- 
     281  CALL ioconf_calendar (thecalendar) 
     282  CALL ioget_calendar  (one_year,one_day) 
     283  ! 
     284  ! Parallelization : 
     285  ! 
     286  CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g) 
     287  kjpindex=nbp_loc 
     288  jjm=jj_nb 
     289  iim=iim_g 
     290  kjpij=iim*jjm 
     291  IF (debug) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm 
     292  !- 
     293  !- 
     294  ! read info about grids 
     295  !- 
     296  !- 
     297  llm=1 
     298  ALLOCATE(lev(llm)) 
     299  IF (is_root_prc) THEN 
     300     !- 
     301     ier = NF90_INQ_VARID (forcing_id,'lalo',vid) 
     302     ier = NF90_GET_VAR   (forcing_id,vid,lalo_g) 
     303     !- 
     304     ALLOCATE (x_neighbours_g(nbp_glo,8),stat=ier) 
     305     ier = NF90_INQ_VARID (forcing_id,'neighbours',vid) 
     306     ier = NF90_GET_VAR   (forcing_id,vid,x_neighbours_g) 
     307     neighbours_g(:,:) = NINT(x_neighbours_g(:,:)) 
     308     DEALLOCATE (x_neighbours_g) 
     309     !- 
     310     ier = NF90_INQ_VARID (forcing_id,'resolution',vid) 
     311     ier = NF90_GET_VAR   (forcing_id,vid,resolution_g) 
     312     !- 
     313     ier = NF90_INQ_VARID (forcing_id,'contfrac',vid) 
     314     ier = NF90_GET_VAR   (forcing_id,vid,contfrac_g) 
     315 
     316     lon_g(:,:) = 0.0 
     317     lat_g(:,:) = 0.0 
     318     lev(1)   = 0.0 
     319     !- 
     320     CALL restini & 
     321          & (sec_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, & 
     322          &  sec_restname_out, itau_dep, date0, dt, rest_id_sec) 
     323     !- 
     324     IF ( dt .NE. dtradia ) THEN 
     325        WRITE(numout,*) 'dt',dt 
     326        WRITE(numout,*) 'dtradia',dtradia 
     327        CALL ipslerr (3,'teststomate', & 
     328             &        'PROBLEM with time steps.', & 
     329             &          sec_restname_in,'(dt .NE. dtradia)') 
     330     ENDIF 
     331     !- 
     332     CALL restini & 
     333          & (sto_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, & 
     334          &  sto_restname_out, itau_dep, date0, dt, rest_id_sto) 
     335     !- 
     336     IF ( dt .NE. dtradia ) THEN 
     337        WRITE(numout,*) 'dt',dt 
     338        WRITE(numout,*) 'dtradia',dtradia 
     339        CALL ipslerr (3,'teststomate', & 
     340             &        'PROBLEM with time steps.', & 
     341             &          sto_restname_in,'(dt .NE. dtradia)') 
     342     ENDIF 
     343  ENDIF 
     344  CALL bcast(rest_id_sec) 
     345  CALL bcast(rest_id_sto) 
     346  CALL bcast(itau_dep) 
     347  CALL bcast(date0) 
     348  CALL bcast(dt) 
     349  CALL bcast(lev) 
     350  !--- 
     351  !--- Create the index table 
     352  !--- 
     353  !--- This job return a LOCAL kindex 
     354  !--- 
     355  ALLOCATE (indices(kjpindex),stat=ier) 
     356  IF (debug .AND. is_root_prc) WRITE(numout,*) "indices_g = ",indices_g(1:nbp_glo) 
     357  CALL scatter(indices_g,indices) 
     358  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g 
     359  IF (debug) WRITE(numout,*) "indices = ",indices(1:kjpindex) 
     360 
     361  !--- 
     362  !--- initialize global grid 
     363  !--- 
     364  CALL init_grid( kjpindex )  
     365  CALL grid_stuff (nbp_glo, iim_g, jjm_g, lon_g, lat_g, indices_g) 
     366 
     367  !--- 
     368  !--- initialize local grid 
     369  !--- 
     370  jlandindex = (((indices(1:kjpindex)-1)/iim) + 1) 
     371  if (debug) WRITE(numout,*) "jlandindex = ",jlandindex(1:kjpindex) 
     372  ilandindex = (indices(1:kjpindex) - (jlandindex(1:kjpindex)-1)*iim) 
     373  IF (debug) WRITE(numout,*) "ilandindex = ",ilandindex(1:kjpindex) 
     374  ALLOCATE(lon(iim,jjm)) 
     375  ALLOCATE(lat(iim,jjm)) 
     376  lon=zero 
     377  lat=zero 
     378  CALL scatter2D(lon_g,lon) 
     379  CALL scatter2D(lat_g,lat) 
     380 
     381  DO ji=1,kjpindex 
     382 
     383     j = jlandindex(ji) 
     384     i = ilandindex(ji) 
     385 
     386     !- Create the internal coordinate table 
     387!- 
     388     lalo(ji,1) = lat(i,j) 
     389     lalo(ji,2) = lon(i,j) 
     390  ENDDO 
     391  CALL scatter(neighbours_g,neighbours) 
     392  CALL scatter(resolution_g,resolution) 
     393  CALL scatter(contfrac_g,contfrac) 
     394  CALL scatter(area_g,area) 
     395  !- 
     396  !- Check if we have by any change a rectilinear grid. This would allow us to  
     397  !- simplify the output files. 
     398  ! 
     399  rectilinear = .FALSE. 
     400  IF (is_root_prc) THEN 
     401     IF ( ALL(lon_g(:,:) == SPREAD(lon_g(:,1), 2, SIZE(lon_g,2))) .AND. & 
     402       & ALL(lat_g(:,:) == SPREAD(lat_g(1,:), 1, SIZE(lat_g,1))) ) THEN 
     403        rectilinear = .TRUE. 
     404     ENDIF 
     405  ENDIF 
     406  CALL bcast(rectilinear) 
     407  IF (rectilinear) THEN 
     408     ALLOCATE(lon_rect(iim),stat=ier) 
     409     IF (ier .NE. 0) THEN 
     410        WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim 
     411        STOP 'intersurf_history' 
     412     ENDIF 
     413     ALLOCATE(lat_rect(jjm),stat=ier) 
     414     IF (ier .NE. 0) THEN 
     415        WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm 
     416        STOP 'intersurf_history' 
     417     ENDIF 
     418     lon_rect(:) = lon(:,1) 
     419     lat_rect(:) = lat(1,:) 
     420  ENDIF 
     421  !- 
     422  ! allocate arrays 
     423  !- 
     424  ! 
     425  a_er = .FALSE. 
     426  ALLOCATE (indexveg(kjpindex*nvm), stat=ier) 
     427  a_er = a_er .OR. (ier.NE.0) 
     428  ALLOCATE (soiltype(kjpindex,nstm),stat=ier) 
     429  a_er = a_er .OR. (ier.NE.0) 
     430  ALLOCATE (veget_x(kjpindex,nvm),stat=ier) 
     431  a_er = a_er .OR. (ier.NE.0) 
     432  ALLOCATE (totfrac_nobio(kjpindex),stat=ier) 
     433  a_er = a_er .OR. (ier.NE.0) 
     434  ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier) 
     435  a_er = a_er .OR. (ier.NE.0) 
     436  ALLOCATE (veget_max_x(kjpindex,nvm),stat=ier) 
     437  a_er = a_er .OR. (ier.NE.0) 
     438  ALLOCATE (lai_x(kjpindex,nvm),stat=ier) 
     439  a_er = a_er .OR. (ier.NE.0) 
     440  ALLOCATE (veget_force_x(kjpindex,nvm),stat=ier) 
     441  a_er = a_er .OR. (ier.NE.0) 
     442  ALLOCATE (veget_max_force_x(kjpindex,nvm),stat=ier) 
     443  a_er = a_er .OR. (ier.NE.0) 
     444  ALLOCATE (lai_force_x(kjpindex,nvm),stat=ier) 
     445  a_er = a_er .OR. (ier.NE.0) 
     446  ALLOCATE (t2m(kjpindex),stat=ier) 
     447  a_er = a_er .OR. (ier.NE.0) 
     448  ALLOCATE (t2m_min(kjpindex),stat=ier) 
     449  a_er = a_er .OR. (ier.NE.0) 
     450  ALLOCATE (temp_sol(kjpindex),stat=ier) 
     451  a_er = a_er .OR. (ier.NE.0) 
     452  ALLOCATE (soiltemp(kjpindex,nbdl),stat=ier) 
     453  a_er = a_er .OR. (ier.NE.0) 
     454  ALLOCATE (soilhum(kjpindex,nbdl),stat=ier) 
     455  a_er = a_er .OR. (ier.NE.0) 
     456  ALLOCATE (humrel_x(kjpindex,nvm),stat=ier) 
     457  a_er = a_er .OR. (ier.NE.0) 
     458  ALLOCATE (litterhum(kjpindex),stat=ier) 
     459  a_er = a_er .OR. (ier.NE.0) 
     460  ALLOCATE (precip_rain(kjpindex),stat=ier) 
     461  a_er = a_er .OR. (ier.NE.0) 
     462  ALLOCATE (precip_snow(kjpindex),stat=ier) 
     463  a_er = a_er .OR. (ier.NE.0) 
     464  ALLOCATE (gpp_x(kjpindex,nvm),stat=ier) 
     465  a_er = a_er .OR. (ier.NE.0) 
     466  ALLOCATE (deadleaf_cover(kjpindex),stat=ier) 
     467  a_er = a_er .OR. (ier.NE.0) 
     468  ALLOCATE (assim_param_x(kjpindex,nvm,npco2),stat=ier) 
     469  a_er = a_er .OR. (ier.NE.0) 
     470  ALLOCATE (height_x(kjpindex,nvm),stat=ier) 
     471  a_er = a_er .OR. (ier.NE.0) 
     472  ALLOCATE (qsintmax_x(kjpindex,nvm),stat=ier) 
     473  a_er = a_er .OR. (ier.NE.0) 
     474  ALLOCATE (co2_flux(kjpindex,nvm),stat=ier) 
     475  a_er = a_er .OR. (ier.NE.0) 
     476  ALLOCATE (fco2_lu(kjpindex),stat=ier) 
     477  a_er = a_er .OR. (ier.NE.0) 
     478  IF (a_er) THEN 
    142479     CALL ipslerr (3,'teststomate', & 
    143  &        'You try to run testsomate compiled with parallelisation. (CPP_PARA key)', & 
    144  &        'But it wasn''t programmed yet and teststomate will stop.','You must compiled it without CPP_PARA key.') 
    145 #endif 
    146  
    147 !- 
    148 ! calendar 
    149 !- 
    150   CALL ioconf_calendar ('noleap') 
    151   CALL ioget_calendar  (one_year,one_day) 
    152 !- 
    153 ! open STOMATE's forcing file to read some basic info 
    154 !- 
    155   forcing_name = 'stomate_forcing.nc' 
    156   CALL getin ('STOMATE_FORCING_NAME',forcing_name) 
    157   iret = NF90_OPEN (TRIM(forcing_name),NF90_NOWRITE,force_id) 
    158   IF (iret /= NF90_NOERR) THEN 
     480          &        'PROBLEM WITH ALLOCATION', & 
     481          &        'for local variables 1','') 
     482  ENDIF 
     483  ! 
     484  ! prepare forcing 
     485  ! 
     486  max_totsize = 50 
     487  CALL getin_p ('STOMATE_FORCING_MEMSIZE',max_totsize) 
     488  max_totsize = max_totsize * 1000000 
     489 
     490  totsize_1step = SIZE(soiltype(:,3))*KIND(soiltype(:,3)) + & 
     491       SIZE(humrel_x)*KIND(humrel_x) + & 
     492       SIZE(litterhum)*KIND(litterhum) + & 
     493       SIZE(t2m)*KIND(t2m) + & 
     494       SIZE(t2m_min)*KIND(t2m_min) + & 
     495       SIZE(temp_sol)*KIND(temp_sol) + & 
     496       SIZE(soiltemp)*KIND(soiltemp) + & 
     497       SIZE(soilhum)*KIND(soilhum) + & 
     498       SIZE(precip_rain)*KIND(precip_rain) + & 
     499       SIZE(precip_snow)*KIND(precip_snow) + & 
     500       SIZE(gpp_x)*KIND(gpp_x) + & 
     501       SIZE(veget_force_x)*KIND(veget_force_x) + & 
     502       SIZE(veget_max_force_x)*KIND(veget_max_force_x) + & 
     503       SIZE(lai_force_x)*KIND(lai_force_x) 
     504  CALL reduce_sum(totsize_1step,totsize_tmp) 
     505  CALL bcast(totsize_tmp) 
     506  totsize_1step=totsize_tmp  
     507 
     508! total number of forcing steps 
     509  IF ( nsft .NE. INT(one_year/(dt_force/one_day)) ) THEN 
    159510     CALL ipslerr (3,'teststomate', & 
    160  &        'Could not open file : ', & 
    161  &          forcing_name,'(Do you have forget it ?)') 
    162   ENDIF 
    163   ier = NF90_GET_ATT (force_id,NF90_GLOBAL,'dtradia',dtradia) 
    164   ier = NF90_GET_ATT (force_id,NF90_GLOBAL,'dt_slow',dt_force) 
    165   ier = NF90_GET_ATT (force_id,NF90_GLOBAL,'nsft',x) 
    166   nsft = NINT(x) 
    167   ier = NF90_GET_ATT (force_id,NF90_GLOBAL,'kjpij',x) 
    168   kjpij = NINT(x) 
    169   ier = NF90_GET_ATT (force_id,NF90_GLOBAL,'kjpindex',x) 
    170   kjpindex = NINT(x) 
    171   CALL init_grid( kjpindex )  
    172 !- 
    173   write(*,*) 'ATTENTION',dtradia,dt_force 
    174 !- 
    175 ! allocate arrays 
    176 !- 
    177   a_er = .FALSE. 
    178   ALLOCATE (indices(kjpindex),stat=ier) 
    179   a_er = a_er .OR. (ier.NE.0) 
    180   ALLOCATE (indexveg(kjpindex*nvm), stat=ier) 
    181   a_er = a_er .OR. (ier.NE.0) 
    182   ALLOCATE (soiltype(kjpindex,nstm),stat=ier) 
    183   a_er = a_er .OR. (ier.NE.0) 
    184   ALLOCATE (veget_x(kjpindex,nvm),stat=ier) 
    185   a_er = a_er .OR. (ier.NE.0) 
    186   ALLOCATE (totfrac_nobio(kjpindex),stat=ier) 
    187   a_er = a_er .OR. (ier.NE.0) 
    188   ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier) 
    189   a_er = a_er .OR. (ier.NE.0) 
    190   ALLOCATE (veget_max_x(kjpindex,nvm),stat=ier) 
    191   a_er = a_er .OR. (ier.NE.0) 
    192   ALLOCATE (lai_x(kjpindex,nvm),stat=ier) 
    193   a_er = a_er .OR. (ier.NE.0) 
    194   ALLOCATE (veget_force_x(kjpindex,nvm),stat=ier) 
    195   a_er = a_er .OR. (ier.NE.0) 
    196   ALLOCATE (veget_max_force_x(kjpindex,nvm),stat=ier) 
    197   a_er = a_er .OR. (ier.NE.0) 
    198   ALLOCATE (lai_force_x(kjpindex,nvm),stat=ier) 
    199   a_er = a_er .OR. (ier.NE.0) 
    200   ALLOCATE (t2m(kjpindex),stat=ier) 
    201   a_er = a_er .OR. (ier.NE.0) 
    202   ALLOCATE (t2m_min(kjpindex),stat=ier) 
    203   a_er = a_er .OR. (ier.NE.0) 
    204   ALLOCATE (temp_sol(kjpindex),stat=ier) 
    205   a_er = a_er .OR. (ier.NE.0) 
    206   ALLOCATE (soiltemp(kjpindex,nbdl),stat=ier) 
    207   a_er = a_er .OR. (ier.NE.0) 
    208   ALLOCATE (soilhum(kjpindex,nbdl),stat=ier) 
    209   a_er = a_er .OR. (ier.NE.0) 
    210   ALLOCATE (humrel_x(kjpindex,nvm),stat=ier) 
    211   a_er = a_er .OR. (ier.NE.0) 
    212   ALLOCATE (litterhum(kjpindex),stat=ier) 
    213   a_er = a_er .OR. (ier.NE.0) 
    214   ALLOCATE (precip_rain(kjpindex),stat=ier) 
    215   a_er = a_er .OR. (ier.NE.0) 
    216   ALLOCATE (precip_snow(kjpindex),stat=ier) 
    217   a_er = a_er .OR. (ier.NE.0) 
    218   ALLOCATE (gpp_x(kjpindex,nvm),stat=ier) 
    219   a_er = a_er .OR. (ier.NE.0) 
    220   ALLOCATE (deadleaf_cover(kjpindex),stat=ier) 
    221   a_er = a_er .OR. (ier.NE.0) 
    222   ALLOCATE (assim_param_x(kjpindex,nvm,npco2),stat=ier) 
    223   a_er = a_er .OR. (ier.NE.0) 
    224   ALLOCATE (height_x(kjpindex,nvm),stat=ier) 
    225   a_er = a_er .OR. (ier.NE.0) 
    226   ALLOCATE (qsintmax_x(kjpindex,nvm),stat=ier) 
    227   a_er = a_er .OR. (ier.NE.0) 
    228   ALLOCATE (co2_flux(kjpindex,nvm),stat=ier) 
    229   a_er = a_er .OR. (ier.NE.0) 
    230   IF ( a_er ) STOP 'PROBLEM WITH ALLOCATION' 
    231   ! 
    232   ! prepare forcing 
    233   ! 
    234   max_totsize = 50 
    235   CALL getin ('STOMATE_FORCING_MEMSIZE',max_totsize) 
    236   max_totsize = max_totsize * 1000000 
    237   totsize_1step = SIZE(soiltype(:,3))*KIND(soiltype(:,3)) + & 
    238                   SIZE(humrel_x)*KIND(humrel_x) + & 
    239                   SIZE(litterhum)*KIND(litterhum) + & 
    240                   SIZE(t2m)*KIND(t2m) + & 
    241                   SIZE(t2m_min)*KIND(t2m_min) + & 
    242                   SIZE(temp_sol)*KIND(temp_sol) + & 
    243                   SIZE(soiltemp)*KIND(soiltemp) + & 
    244                   SIZE(soilhum)*KIND(soilhum) + & 
    245                   SIZE(precip_rain)*KIND(precip_rain) + & 
    246                   SIZE(precip_snow)*KIND(precip_snow) + & 
    247                   SIZE(gpp_x)*KIND(gpp_x) + & 
    248                   SIZE(veget_force_x)*KIND(veget_force_x) + & 
    249                   SIZE(veget_max_force_x)*KIND(veget_max_force_x) + & 
    250                   SIZE(lai_force_x)*KIND(lai_force_x) 
    251 ! total number of forcing steps 
    252   nsft =  INT(one_year/(dt_force/one_day)) 
     511          &        'stomate: error with total number of forcing steps', & 
     512          &        'nsft','teststomate computation different with forcing file value.') 
     513  ENDIF 
    253514! number of forcing steps in memory 
    254   nsfm = MIN(nsft,MAX(1,NINT(FLOAT(max_totsize)/FLOAT(totsize_1step)))) 
     515  nsfm = MIN(nsft, & 
     516       &       MAX(1,NINT( REAL(max_totsize,r_std) & 
     517       &                  /REAL(totsize_1step,r_std)))) 
    255518!- 
    256519  WRITE(numout,*) 'Offline forcing of Stomate:' 
    … …  
    258521  WRITE(numout,*) '  Number of forcing steps in memory:',nsfm 
    259522!- 
    260   a_er = .FALSE. 
    261   ALLOCATE (clay_fm(kjpindex,nsfm),stat=ier) 
    262   a_er = a_er.OR.(ier.NE.0) 
    263   ALLOCATE (humrel_x_fm(kjpindex,nvm,nsfm),stat=ier) 
    264   a_er = a_er.OR.(ier.NE.0) 
    265   ALLOCATE (litterhum_fm(kjpindex,nsfm),stat=ier) 
    266   a_er = a_er.OR.(ier.NE.0) 
    267   ALLOCATE (t2m_fm(kjpindex,nsfm),stat=ier) 
    268   a_er = a_er.OR.(ier.NE.0) 
    269   ALLOCATE (t2m_min_fm(kjpindex,nsfm),stat=ier) 
    270   a_er = a_er.OR.(ier.NE.0) 
    271   ALLOCATE (temp_sol_fm(kjpindex,nsfm),stat=ier) 
    272   a_er = a_er.OR.(ier.NE.0) 
    273   ALLOCATE (soiltemp_fm(kjpindex,nbdl,nsfm),stat=ier) 
    274   a_er = a_er.OR.(ier.NE.0) 
    275   ALLOCATE (soilhum_fm(kjpindex,nbdl,nsfm),stat=ier) 
    276   a_er = a_er.OR.(ier.NE.0) 
    277   ALLOCATE (precip_fm(kjpindex,nsfm),stat=ier) 
    278   a_er = a_er.OR.(ier.NE.0) 
    279   ALLOCATE (gpp_x_fm(kjpindex,nvm,nsfm),stat=ier) 
    280   a_er = a_er.OR.(ier.NE.0) 
    281   ALLOCATE (veget_force_x_fm(kjpindex,nvm,nsfm),stat=ier) 
    282   a_er = a_er.OR.(ier.NE.0) 
    283   ALLOCATE (veget_max_force_x_fm(kjpindex,nvm,nsfm),stat=ier) 
    284   a_er = a_er.OR.(ier.NE.0) 
    285   ALLOCATE (lai_force_x_fm(kjpindex,nvm,nsfm),stat=ier) 
    286   a_er = a_er.OR.(ier.NE.0) 
    287   ALLOCATE (isf(nsfm),stat=ier) 
    288   a_er = a_er.OR.(ier.NE.0) 
    289   ALLOCATE (nf_written(nsft),stat=ier) 
    290   a_er = a_er.OR.(ier.NE.0) 
    291   ALLOCATE (nf_cumul(nsft),stat=ier) 
    292   a_er = a_er.OR.(ier.NE.0) 
    293   IF (a_er) THEN 
    294     STOP 'stomate: error in memory allocation for forcing data' 
    295   ENDIF 
     523  CALL init_forcing(kjpindex,nsfm,nsft) 
     524  !- 
    296525! ensure that we read all new forcing states 
    297526  iisf = nsfm 
    … …  
    299528! of the forcing states that will be in memory 
    300529  isf(:) = (/ (i,i=1,nsfm) /) 
    301 !- 
    302 ! read info about grids 
    303 !- 
    304   contfrac(:) = 1.0 
    305 !- 
    306   ALLOCATE (x_indices(kjpindex),stat=ier) 
    307   ier = NF90_INQ_VARID (force_id,'index',v_id) 
    308   ier = NF90_GET_VAR   (force_id,v_id,x_indices) 
    309   indices(:) = NINT(x_indices(:)) 
    310   DEALLOCATE (x_indices) 
    311 !- 
    312   DO ji=1,kjpindex 
    313     DO jv=1,nvm 
    314       indexveg((jv-1)*kjpindex+ji) = indices(ji)+(jv-1)*kjpij 
    315     ENDDO 
    316   ENDDO 
    317 !- 
    318   ier = NF90_INQ_VARID (force_id,'lalo',v_id) 
    319   ier = NF90_GET_VAR   (force_id,v_id,lalo) 
    320 !- 
    321   ALLOCATE (x_neighbours(kjpindex,8),stat=ier) 
    322   ier = NF90_INQ_VARID (force_id,'neighbours',v_id) 
    323   ier = NF90_GET_VAR   (force_id,v_id,x_neighbours) 
    324   neighbours(:,:) = NINT(x_neighbours(:,:)) 
    325   DEALLOCATE (x_neighbours) 
    326 !- 
    327   ier = NF90_INQ_VARID (force_id,'resolution',v_id) 
    328   ier = NF90_GET_VAR   (force_id,v_id,resolution) 
    329 !- 
    330   ier = NF90_INQ_VARID (force_id,'contfrac',v_id) 
    331   ier = NF90_GET_VAR   (force_id,v_id,contfrac) 
    332 !- 
    333 ! activate CO2, STOMATE, but not sechiba 
    334 !- 
    335   control%river_routing = .FALSE. 
    336   control%hydrol_cwrr = .FALSE. 
    337   control%ok_sechiba = .FALSE. 
    338   ! 
    339   control%stomate_watchout = .TRUE. 
    340   control%ok_co2 = .TRUE. 
    341   control%ok_stomate = .TRUE. 
    342 !- 
    343 ! is DGVM activated? 
    344 !- 
    345   control%ok_dgvm = .FALSE. 
    346   CALL getin('STOMATE_OK_DGVM',control%ok_dgvm) 
    347   WRITE(*,*) 'LPJ is activated: ',control%ok_dgvm 
    348 !- 
    349 ! restart files 
    350 !- 
    351 ! Sechiba's restart files 
    352   sec_restname_in = 'sechiba_start.nc' 
    353   CALL getin('SECHIBA_restart_in',sec_restname_in) 
    354   WRITE(*,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in) 
    355   IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN 
    356     STOP 'Need a restart file for Sechiba' 
    357   ENDIF 
    358   sec_restname_out = 'sechiba_restart.nc' 
    359   CALL getin('SECHIBA_rest_out',sec_restname_out) 
    360   WRITE(*,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out) 
    361 ! Stomate's restart files 
    362   sto_restname_in = 'stomate_start.nc' 
    363   CALL getin ('STOMATE_RESTART_FILEIN',sto_restname_in) 
    364   WRITE(*,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in) 
    365   sto_restname_out = 'stomate_restart.nc' 
    366   CALL getin ('STOMATE_RESTART_FILEOUT',sto_restname_out) 
    367   WRITE(*,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out) 
    368 !- 
    369 ! We need to know iim, jjm. 
    370 ! Get them from the restart files themselves. 
    371 !- 
    372   iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid) 
    373   IF (iret /= NF90_NOERR) THEN 
    374      CALL ipslerr (3,'teststomate', & 
    375  &        'Could not open file : ', & 
    376  &          sec_restname_in,'(Do you have forget it ?)') 
    377   ENDIF 
    378   iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim) 
    379   iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm) 
    380   iret = NF90_CLOSE (ncfid) 
    381   ! Allocate longitudes and latitudes 
    382   ALLOCATE (lon(iim,jjm),stat=ier) 
    383   a_er = a_er.OR.(ier.NE.0) 
    384   ALLOCATE (lat(iim,jjm),stat=ier) 
    385   a_er = a_er.OR.(ier.NE.0) 
    386   lon(:,:) = 0.0 
    387   lat(:,:) = 0.0 
    388   lev(1)   = 0.0 
    389 !- 
    390   CALL restini & 
    391   & (sec_restname_in, iim, jjm, lon, lat, llm, lev, & 
    392   &  sec_restname_out, itau_dep, date0, dt_files, rest_id_sec) 
    393 !- 
    394   CALL restini & 
    395   & (sto_restname_in, iim, jjm, lon, lat, llm, lev, & 
    396   &  sto_restname_out, itau_dep, date0, dt_files, rest_id_sto) 
    397 !- 
    398   IF ( dt_files .NE. dtradia ) THEN 
    399     WRITE(*,*) 'dt_files',dt_files 
    400     WRITE(*,*) 'dtradia',dtradia 
    401     STOP 'PROBLEM with time steps.' 
    402   ENDIF 
     530 
     531  nf_written(:) = .FALSE. 
     532  nf_written(isf(:)) = .TRUE. 
     533 
    403534!- 
    404535! a time step for STOMATE corresponds to itau_step timesteps in SECHIBA 
    405536!- 
    406537  itau_step = NINT(dt_force/dtradia) 
     538  IF (debug) WRITE(numout,*) "dtradia, dt_rest, dt_force, itau_step",dtradia, dt, dt_force, itau_step 
    407539  ! 
    408540  CALL ioconf_startdate(date0) 
    … …  
    412544!- 
    413545  WRITE(time_str,'(a)') '1Y' 
    414   CALL getin ('TIME_LENGTH', time_str) 
     546  CALL getin_p ('TIME_LENGTH', time_str) 
    415547! transform into itau 
    416   CALL tlen2itau(time_str, dt_files, date0, itau_len) 
     548  CALL tlen2itau(time_str, dt, date0, itau_len) 
    417549! itau_len*dtradia must be a multiple of dt_force 
    418550  itau_len = NINT( MAX(1.,FLOAT(NINT(itau_len*dtradia/dt_force))) & 
    419  &                *dt_force/dtradia) 
    420 !- 
    421 ! set up STOMATE history file 
    422        !- 
    423        !Config  Key  = STOMATE_OUTPUT_FILE 
    424        !Config  Desc = Name of file in which STOMATE's output is going 
    425        !Config         to be written 
    426        !Config  Def  = stomate_history.nc 
    427        !Config  Help = This file is going to be created by the model 
    428        !Config         and will contain the output from the model. 
    429        !Config         This file is a truly COADS compliant netCDF file. 
    430        !Config         It will be generated by the hist software from 
    431        !Config         the IOIPSL package. 
    432 !- 
     551       &                *dt_force/dtradia) 
     552  !- 
     553  itau_fin = itau_dep+itau_len 
     554  !- 
     555  ! set up STOMATE history file 
     556  !- 
     557  !Config  Key  = STOMATE_OUTPUT_FILE 
     558  !Config  Desc = Name of file in which STOMATE's output is going 
     559  !Config         to be written 
     560  !Config  Def  = stomate_history.nc 
     561  !Config  Help = This file is going to be created by the model 
     562  !Config         and will contain the output from the model. 
     563  !Config         This file is a truly COADS compliant netCDF file. 
     564  !Config         It will be generated by the hist software from 
     565  !Config         the IOIPSL package. 
     566  !- 
    433567  stom_histname='stomate_history.nc' 
    434   CALL getin ('STOMATE_OUTPUT_FILE', stom_histname) 
    435   WRITE(*,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname) 
    436        !- 
    437        !Config  Key  = STOMATE_HIST_DT 
    438        !Config  Desc = STOMATE history time step (d) 
    439        !Config  Def  = 10. 
    440        !Config  Help = Time step of the STOMATE history file 
    441 !- 
     568  CALL getin_p ('STOMATE_OUTPUT_FILE', stom_histname) 
     569  WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname) 
     570  !- 
     571  !Config  Key  = STOMATE_HIST_DT 
     572  !Config  Desc = STOMATE history time step (d) 
     573  !Config  Def  = 10. 
     574  !Config  Help = Time step of the STOMATE history file 
     575  !- 
    442576  hist_days_stom = 10. 
    443   CALL getin ('STOMATE_HIST_DT', hist_days_stom) 
     577  CALL getin_p ('STOMATE_HIST_DT', hist_days_stom) 
    444578  IF ( hist_days_stom == -1. ) THEN 
    445579     hist_dt_stom = -1. 
    … …  
    451585  ENDIF 
    452586!- 
    453 ! initialize 
    454   CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, & 
    455  &     itau_dep, date0, dt_files, hori_id, hist_id_sto) 
    456 ! define PFT axis 
     587  !- 
     588  !- initialize 
     589  WRITE(numout,*) "before histbeg : ",date0,dt 
     590  IF ( rectilinear ) THEN 
     591#ifdef CPP_PARA 
     592     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, & 
     593          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id) 
     594#else 
     595     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, & 
     596          &     itau_dep, date0, dt, hori_id, hist_id_stom) 
     597#endif 
     598  ELSE 
     599#ifdef CPP_PARA 
     600     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, & 
     601          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id) 
     602#else 
     603     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, & 
     604          &     itau_dep, date0, dt, hori_id, hist_id_stom) 
     605#endif 
     606  ENDIF 
     607  !- define PFT axis 
    457608  hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /) 
    458 ! declare this axis 
    459   CALL histvert (hist_id_sto, 'PFT', 'Plant functional type', & 
    460  & '-', nvm, hist_PFTaxis, hist_PFTaxis_id) 
     609  !- declare this axis 
     610  CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', & 
     611       & '1', nvm, hist_PFTaxis, hist_PFTaxis_id) 
    461612!- define Pool_10 axis 
    462613   hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /) 
    463614!- declare this axis 
    464    CALL histvert (hist_id_sto, 'P10', 'Pool 10 years', & 
    465  & '-', 10, hist_pool_10axis, hist_pool_10axis_id) 
     615  CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', & 
     616       & '1', 10, hist_pool_10axis, hist_pool_10axis_id) 
     617 
    466618!- define Pool_100 axis 
    467619   hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /) 
    468620!- declare this axis 
    469    CALL histvert (hist_id_sto, 'P100', 'Pool 100 years', & 
    470  & '-', 100, hist_pool_100axis, hist_pool_100axis_id) 
     621  CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', & 
     622       & '1', 100, hist_pool_100axis, hist_pool_100axis_id) 
     623 
    471624!- define Pool_11 axis 
    472625   hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /) 
    473626!- declare this axis 
    474    CALL histvert (hist_id_sto, 'P11', 'Pool 10 years + 1', & 
    475  & '-', 11, hist_pool_11axis, hist_pool_11axis_id) 
     627  CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', & 
     628       & '1', 11, hist_pool_11axis, hist_pool_11axis_id) 
    476629!- define Pool_101 axis 
    477630   hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /) 
    478631!- declare this axis 
    479    CALL histvert (hist_id_sto, 'P101', 'Pool 100 years + 1', & 
    480  & '-', 101, hist_pool_101axis, hist_pool_101axis_id) 
    481 ! define STOMATE history file 
    482   CALL stom_define_history (hist_id_sto, nvm, iim, jjm, & 
    483  & dt_files, hist_dt_stom, hori_id, hist_PFTaxis_id, & 
     632  CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', & 
     633       & '1', 101, hist_pool_101axis, hist_pool_101axis_id) 
     634 
     635  !- define STOMATE history file 
     636  CALL stom_define_history (hist_id_stom, nvm, iim, jjm, & 
     637       & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, & 
    484638 & hist_pool_10axis_id, hist_pool_100axis_id, & 
    485639 & hist_pool_11axis_id, hist_pool_101axis_id) 
    486 ! end definition 
    487   CALL histend(hist_id_sto) 
     640 
     641  !- end definition 
     642  CALL histend(hist_id_stom) 
     643  !- 
     644  !- 
     645  ! STOMATE IPCC OUTPUTS IS ACTIVATED 
     646  !- 
     647  !Config  Key  = STOMATE_IPCC_OUTPUT_FILE 
     648  !Config  Desc = Name of file in which STOMATE's output is going 
     649  !Config         to be written 
     650  !Config  Def  = stomate_ipcc_history.nc 
     651  !Config  Help = This file is going to be created by the model 
     652  !Config         and will contain the output from the model. 
     653  !Config         This file is a truly COADS compliant netCDF file. 
     654  !Config         It will be generated by the hist software from 
     655  !Config         the IOIPSL package. 
     656  !- 
     657  stom_ipcc_histname='stomate_ipcc_history.nc' 
     658  CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)        
     659  WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname) 
     660  !- 
     661  !Config  Key  = STOMATE_IPCC_HIST_DT 
     662  !Config  Desc = STOMATE IPCC history time step (d) 
     663  !Config  Def  = 0. 
     664  !Config  Help = Time step of the STOMATE IPCC history file 
     665  !- 
     666  hist_days_stom_ipcc = zero 
     667  CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)        
     668  IF ( hist_days_stom_ipcc == moins_un ) THEN 
     669     hist_dt_stom_ipcc = moins_un 
     670     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.' 
     671  ELSE 
     672     hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day 
     673     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', & 
     674          hist_dt_stom_ipcc/one_day 
     675  ENDIF 
     676 
     677  ! test consistency between STOMATE_IPCC_HIST_DT and DT_SLOW parameters 
     678  dt_slow_ = one_day 
     679  CALL getin_p('DT_SLOW', dt_slow_) 
     680  IF ( hist_days_stom_ipcc > zero ) THEN 
     681     IF (dt_slow_ > hist_dt_stom_ipcc) THEN 
     682        WRITE(numout,*) "DT_SLOW = ",dt_slow_,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc 
     683        CALL ipslerr (3,'intsurf_history', & 
     684             &          'Problem with DT_SLOW > STOMATE_IPCC_HIST_DT','', & 
     685             &          '(must be less or equal)') 
     686     ENDIF 
     687  ENDIF 
     688 
     689  IF ( hist_dt_stom_ipcc == 0 ) THEN 
     690     hist_id_stom_ipcc = -1 
     691  ELSE 
     692     !- 
     693     !- initialize 
     694     IF ( rectilinear ) THEN 
     695#ifdef CPP_PARA 
     696        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, & 
     697             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id) 
     698#else 
     699        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, & 
     700             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc) 
     701#endif 
     702     ELSE 
     703#ifdef CPP_PARA 
     704        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, & 
     705             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id) 
     706#else 
     707        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, & 
     708             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc) 
     709#endif 
     710     ENDIF 
     711     !- declare this axis 
     712     CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', & 
     713          & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id) 
     714 
     715     !- define STOMATE history file 
     716     CALL stom_IPCC_define_history (hist_id_stom_IPCC, nvm, iim, jjm, & 
     717          & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id) 
     718 
     719     !- end definition 
     720     CALL histend(hist_id_stom_IPCC) 
     721 
     722  ENDIF 
     723  ! 
     724  CALL histwrite(hist_id_stom, 'Areas',  itau_dep+itau_step, area, kjpindex, indices) 
     725  IF ( hist_id_stom_IPCC > 0 ) THEN 
     726     CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_dep+itau_step, area, kjpindex, indices) 
     727  ENDIF 
     728  ! 
    488729  hist_id_sec = -1 
    489730  hist_id_sec2 = -1 
    490   hist_id_stom_IPCC = -1 
    491 !- 
    492 ! read some variables we need from SECHIBA's restart file 
    493 !- 
     731!- 
     732! first call of slowproc to initialize variables 
     733!- 
     734  itau = itau_dep 
     735  !   
     736  DO ji=1,kjpindex 
     737     DO jv=1,nvm 
     738        indexveg((jv-1)*kjpindex + ji) = indices(ji) + (jv-1)*kjpij 
     739     ENDDO 
     740  ENDDO 
     741  !- 
     742  !MM Problem here with dpu which depends on soil type            
     743  DO l = 1, nbdl-1 
     744     ! first 2.0 is dpu  
     745     ! second 2.0 is average 
     746     diaglev(l) = dpu_cste/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0 
     747  ENDDO 
     748  diaglev(nbdl) = dpu_cste 
     749  ! 
    494750  CALL ioget_expval(val_exp) 
    495 !- 
    496 ! first call of slowproc to initialize variables 
    497 !- 
    498   itau = itau_dep 
    499751  ldrestart_read = .TRUE. 
    500752  ldrestart_write = .FALSE. 
    501 !- 
    502 !MM Problem here with dpu which depends on soil type            
    503   DO jv = 1, nbdl-1 
    504      ! first 2.0 is dpu  
    505      ! second 2.0 is average 
    506      diaglev(jv) = 2.0/(2**(nbdl-1) -1) * ( ( 2**(jv-1) -1) + ( 2**(jv) -1) ) / 2.0 
    507   ENDDO 
    508   diaglev(nbdl) = 2.0 
    509 !- 
    510   ! For sequential use only, we must initialize data_para : 
    511   ! 
    512   CALL init_para(.FALSE.) 
    513   ! 
    514   CALL init_data_para(iim,jjm,kjpindex,indices)   
    515   ! 
    516   !- global index index_g is the index_l of root proc  
    517   IF (is_root_prc) index_g(:)=indices(1:kjpindex) 
    518 !- 
     753  !- 
     754  ! read some variables we need from SECHIBA's restart file 
     755  !- 
    519756  CALL slowproc_main & 
    520757 &  (itau, kjpij, kjpindex, dt_force, date0, & 
    … …  
    525762 &   deadleaf_cover, assim_param_x, lai_x, height_x, veget_x, & 
    526763 &   frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, & 
    527  &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_sto, hist_id_stom_IPCC, co2_flux) 
     764 &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu) 
    528765  ! correct date 
    529766  day_counter = one_day - dt_force 
    … …  
    532769! time loop 
    533770!- 
    534   DO itau = itau_dep+itau_step,itau_dep+itau_len,itau_step 
     771  IF (debug) check_time=.TRUE. 
     772  CALL intsurf_time( itau_dep+itau_step, date0, dtradia ) 
     773  l_first_intersurf=.FALSE. 
     774  ! 
     775  DO itau = itau_dep+itau_step,itau_fin,itau_step 
     776    ! 
     777    CALL intsurf_time( itau, date0, dtradia ) 
     778     ! 
    535779!-- next forcing state 
    536780    iisf = iisf+1 
     781    IF (debug) WRITE(numout,*) "itau,iisf : ",itau,iisf 
    537782!--- 
    538783    IF (iisf .GT. nsfm) THEN 
    … …  
    542787!---- determine blocks of forcing states that are contiguous in memory 
    543788!----- 
    544       nblocks = 0 
    545       ifirst(:) = 1 
    546       ilast(:) = 1 
    547 !----- 
    548       DO iisf=1,nsfm 
    549          IF (     (nblocks .NE. 0) ) THEN 
    550             IF ( (isf(iisf) .EQ. isf(ilast(nblocks))+1) ) THEN 
    551 !-------- element is contiguous with last element found 
    552                ilast(nblocks) = iisf 
    553             ELSE 
    554 !-------- found first element of new block 
    555                nblocks = nblocks+1 
    556                IF (nblocks .GT. nsfm) THEN 
    557 !               IF (nblocks .GT. 2) THEN 
    558                   STOP 'Problem in teststomate' 
    559                ENDIF 
    560                ifirst(nblocks) = iisf 
    561                ilast(nblocks) = iisf 
    562             ENDIF 
    563          ELSE 
    564 !-------- found first element of new block 
    565             nblocks = nblocks+1 
    566             IF (nblocks .GT. nsfm) THEN 
    567 !           IF (nblocks .GT. 2) THEN 
    568                STOP 'Problem in teststomate' 
    569             ENDIF 
    570             ifirst(nblocks) = iisf 
    571             ilast(nblocks) = iisf 
    572         ENDIF 
    573       ENDDO 
    574 !----- 
    575       DO iblocks=1,nblocks 
    576         IF (ifirst(iblocks) .NE. ilast(iblocks)) THEN 
    577           ndim = 2; 
    578           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    579           count(1:ndim) = SHAPE(clay_fm) 
    580           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    581           ier = NF90_INQ_VARID (force_id,'clay',v_id) 
    582           a_er = a_er.OR.(ier.NE.0) 
    583           ier = NF90_GET_VAR   (force_id,v_id, & 
    584  &         clay_fm(:,ifirst(iblocks):ilast(iblocks)), & 
    585  &         start=start(1:ndim), count=count(1:ndim)) 
    586           a_er = a_er.OR.(ier.NE.0) 
    587 !--------- 
    588           ndim = 3; 
    589           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    590           count(1:ndim) = SHAPE(humrel_x_fm) 
    591           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    592           ier = NF90_INQ_VARID (force_id,'humrel',v_id) 
    593           a_er = a_er.OR.(ier.NE.0) 
    594           ier = NF90_GET_VAR   (force_id,v_id, & 
    595  &         humrel_x_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    596  &         start=start(1:ndim), count=count(1:ndim)) 
    597           a_er = a_er.OR.(ier.NE.0) 
    598 !--------- 
    599           ndim = 2; 
    600           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    601           count(1:ndim) = SHAPE(litterhum_fm) 
    602           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    603           ier = NF90_INQ_VARID (force_id,'litterhum',v_id) 
    604           a_er = a_er.OR.(ier.NE.0) 
    605           ier = NF90_GET_VAR   (force_id,v_id, & 
    606  &         litterhum_fm(:,ifirst(iblocks):ilast(iblocks)), & 
    607  &         start=start(1:ndim), count=count(1:ndim)) 
    608           a_er = a_er.OR.(ier.NE.0) 
    609 !--------- 
    610           ndim = 2; 
    611           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    612           count(1:ndim) = SHAPE(t2m_fm) 
    613           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    614           ier = NF90_INQ_VARID (force_id,'t2m',v_id) 
    615           a_er = a_er.OR.(ier.NE.0) 
    616           ier = NF90_GET_VAR   (force_id,v_id, & 
    617  &         t2m_fm(:,ifirst(iblocks):ilast(iblocks)), & 
    618  &         start=start(1:ndim), count=count(1:ndim)) 
    619           a_er = a_er.OR.(ier.NE.0) 
    620 !--------- 
    621           ndim = 2; 
    622           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    623           count(1:ndim) = SHAPE(t2m_min_fm) 
    624           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    625           ier = NF90_INQ_VARID (force_id,'t2m_min',v_id) 
    626           a_er = a_er.OR.(ier.NE.0) 
    627           ier = NF90_GET_VAR   (force_id,v_id, & 
    628  &         t2m_min_fm(:,ifirst(iblocks):ilast(iblocks)), & 
    629  &         start=start(1:ndim), count=count(1:ndim)) 
    630           a_er = a_er.OR.(ier.NE.0) 
    631 !--------- 
    632           ndim = 2; 
    633           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    634           count(1:ndim) = SHAPE(temp_sol_fm) 
    635           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    636           ier = NF90_INQ_VARID (force_id,'tsurf',v_id) 
    637           a_er = a_er.OR.(ier.NE.0) 
    638           ier = NF90_GET_VAR   (force_id,v_id, & 
    639  &         temp_sol_fm(:,ifirst(iblocks):ilast(iblocks)), & 
    640  &         start=start(1:ndim), count=count(1:ndim)) 
    641           a_er = a_er.OR.(ier.NE.0) 
    642 !--------- 
    643           ndim = 3; 
    644           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    645           count(1:ndim) = SHAPE(soiltemp_fm) 
    646           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    647           ier = NF90_INQ_VARID (force_id,'tsoil',v_id) 
    648           a_er = a_er.OR.(ier.NE.0) 
    649           ier = NF90_GET_VAR   (force_id,v_id, & 
    650  &         soiltemp_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    651  &         start=start(1:ndim), count=count(1:ndim)) 
    652           a_er = a_er.OR.(ier.NE.0) 
    653 !--------- 
    654           ndim = 3; 
    655           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    656           count(1:ndim) = SHAPE(soilhum_fm) 
    657           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    658           ier = NF90_INQ_VARID (force_id,'soilhum',v_id) 
    659           a_er = a_er.OR.(ier.NE.0) 
    660           ier = NF90_GET_VAR   (force_id,v_id, & 
    661  &         soilhum_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    662  &         start=start(1:ndim), count=count(1:ndim)) 
    663           a_er = a_er.OR.(ier.NE.0) 
    664 !--------- 
    665           ndim = 2; 
    666           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    667           count(1:ndim) = SHAPE(precip_fm) 
    668           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    669           ier = NF90_INQ_VARID (force_id,'precip',v_id) 
    670           a_er = a_er.OR.(ier.NE.0) 
    671           ier = NF90_GET_VAR   (force_id,v_id, & 
    672  &         precip_fm(:,ifirst(iblocks):ilast(iblocks)), & 
    673  &         start=start(1:ndim), count=count(1:ndim)) 
    674           a_er = a_er.OR.(ier.NE.0) 
    675 !--------- 
    676           ndim = 3; 
    677           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    678           count(1:ndim) = SHAPE(gpp_x_fm) 
    679           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    680           ier = NF90_INQ_VARID (force_id,'gpp',v_id) 
    681           a_er = a_er.OR.(ier.NE.0) 
    682           ier = NF90_GET_VAR   (force_id,v_id, & 
    683  &         gpp_x_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    684  &         start=start(1:ndim), count=count(1:ndim)) 
    685           a_er = a_er.OR.(ier.NE.0) 
    686 !--------- 
    687           ndim = 3; 
    688           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    689           count(1:ndim) = SHAPE(veget_force_x_fm) 
    690           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    691           ier = NF90_INQ_VARID (force_id,'veget',v_id) 
    692           a_er = a_er.OR.(ier.NE.0) 
    693           ier = NF90_GET_VAR   (force_id,v_id, & 
    694  &         veget_force_x_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    695  &         start=start(1:ndim), count=count(1:ndim)) 
    696           a_er = a_er.OR.(ier.NE.0) 
    697 !--------- 
    698           ndim = 3; 
    699           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    700           count(1:ndim) = SHAPE(veget_max_force_x_fm) 
    701           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    702           ier = NF90_INQ_VARID (force_id,'veget_max',v_id) 
    703           a_er = a_er.OR.(ier.NE.0) 
    704           ier = NF90_GET_VAR   (force_id,v_id, & 
    705  &         veget_max_force_x_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    706  &         start=start(1:ndim), count=count(1:ndim)) 
    707           a_er = a_er.OR.(ier.NE.0) 
    708 !--------- 
    709           ndim = 3; 
    710           start(:) = 1; start(ndim) = isf(ifirst(iblocks)); 
    711           count(1:ndim) = SHAPE(lai_force_x_fm) 
    712           count(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1 
    713           ier = NF90_INQ_VARID (force_id,'lai',v_id) 
    714           a_er = a_er.OR.(ier.NE.0) 
    715           ier = NF90_GET_VAR   (force_id,v_id, & 
    716  &         lai_force_x_fm(:,:,ifirst(iblocks):ilast(iblocks)), & 
    717  &         start=start(1:ndim), count=count(1:ndim)) 
    718           a_er = a_er.OR.(ier.NE.0) 
    719         ENDIF 
    720       ENDDO 
     789        CALL forcing_read(forcing_id,nsfm) 
     790 
     791!-------------------------- 
     792 
    721793!----- 
    722794!---- determine which forcing states must be read next time 
    … …  
    724796      isf(1) = isf(nsfm)+1 
    725797      IF ( isf(1) .GT. nsft ) isf(1) = 1 
    726       DO iisf = 2, nsfm 
    727         isf(iisf) = isf(iisf-1)+1 
    728         IF ( isf(iisf) .GT. nsft ) isf(iisf) = 1 
    729       ENDDO 
     798        DO iiisf = 2, nsfm 
     799           isf(iiisf) = isf(iiisf-1)+1 
     800           IF ( isf(iiisf) .GT. nsft ) isf(iiisf) = 1 
     801        ENDDO 
     802        nf_written(isf(:)) = .TRUE. 
    730803!---- start again at first forcing state 
    731       iisf = 1 
    732     ENDIF 
    733     soiltype(:,3) = clay_fm(:,iisf) 
    734     humrel_x(:,:) = humrel_x_fm(:,:,iisf) 
    735     litterhum(:) = litterhum_fm(:,iisf) 
    736     t2m(:) = t2m_fm(:,iisf) 
    737     t2m_min(:) = t2m_min_fm(:,iisf) 
    738     temp_sol(:) = temp_sol_fm(:,iisf) 
    739     soiltemp(:,:) = soiltemp_fm(:,:,iisf) 
    740     soilhum(:,:) = soilhum_fm(:,:,iisf) 
    741     precip_rain(:) = precip_fm(:,iisf) 
    742     gpp_x(:,:) = gpp_x_fm(:,:,iisf) 
    743     veget_force_x(:,:) = veget_force_x_fm(:,:,iisf) 
    744     veget_max_force_x(:,:) = veget_max_force_x_fm(:,:,iisf) 
    745     lai_force_x(:,:) = lai_force_x_fm(:,:,iisf) 
    746     WHERE ( t2m(:) .LT. ZeroCelsius ) 
    747       precip_snow(:) = precip_rain(:) 
    748       precip_rain(:) = 0. 
    749     ELSEWHERE 
    750       precip_snow(:) = 0. 
    751     ENDWHERE 
     804        iisf = 1 
     805     ENDIF 
     806     ! Bug here ! soiltype(:,3) != clay 
     807!     soiltype(:,3) = clay_fm(:,iisf) 
     808     humrel_x(:,:) = humrel_daily_fm(:,:,iisf) 
     809     litterhum(:) = litterhum_daily_fm(:,iisf) 
     810     t2m(:) = t2m_daily_fm(:,iisf) 
     811     t2m_min(:) = t2m_min_daily_fm(:,iisf) 
     812     temp_sol(:) = tsurf_daily_fm(:,iisf) 
     813     soiltemp(:,:) = tsoil_daily_fm(:,:,iisf) 
     814     soilhum(:,:) = soilhum_daily_fm(:,:,iisf) 
     815     precip_rain(:) = precip_fm(:,iisf) 
     816     gpp_x(:,:) = gpp_daily_fm(:,:,iisf) 
     817     veget_force_x(:,:) = veget_fm(:,:,iisf) 
     818     veget_max_force_x(:,:) = veget_max_fm(:,:,iisf) 
     819     lai_force_x(:,:) = lai_fm(:,:,iisf) 
     820     WHERE ( t2m(:) .LT. ZeroCelsius ) 
     821        precip_snow(:) = precip_rain(:) 
     822        precip_rain(:) = 0. 
     823     ELSEWHERE 
     824        precip_snow(:) = 0. 
     825     ENDWHERE 
    752826!--- 
    753827!-- scale GPP to new lai and veget_max 
    754828!--- 
    755     WHERE ( lai_x(:,:) .EQ. 0.0 ) gpp_x(:,:) = 0.0 
     829     WHERE ( lai_x(:,:) .EQ. 0.0 ) gpp_x(:,:) = 0.0 
    756830!-- scale GPP to new LAI 
    757     WHERE (lai_force_x(:,:) .GT. 0.0 ) 
    758       gpp_x(:,:) = gpp_x(:,:)*atan(2.*lai_x(:,:)) & 
    759  &                           /atan( 2.*MAX(lai_force_x(:,:),0.01)) 
    760     ENDWHERE 
     831     WHERE (lai_force_x(:,:) .GT. 0.0 ) 
     832        gpp_x(:,:) = gpp_x(:,:)*ATAN(2.*lai_x(:,:)) & 
     833 &                           /ATAN( 2.*MAX(lai_force_x(:,:),0.01)) 
     834     ENDWHERE 
    761835!-- scale GPP to new veget_max 
    762     WHERE (veget_max_force_x(:,:) .GT. 0.0 ) 
    763       gpp_x(:,:) = gpp_x(:,:)*veget_max_x(:,:)/veget_max_force_x(:,:) 
    764     ENDWHERE 
     836     WHERE (veget_max_force_x(:,:) .GT. 0.0 ) 
     837        gpp_x(:,:) = gpp_x(:,:)*veget_max_x(:,:)/veget_max_force_x(:,:) 
     838     ENDWHERE 
    765839!--- 
    766840!-- number crunching 
    767841!--- 
    768     CALL intsurf_time( itau, date0, dtradia ) 
    769     ldrestart_read = .FALSE. 
    770     ldrestart_write = .FALSE. 
    771     CALL slowproc_main & 
     842     ldrestart_read = .FALSE. 
     843     ldrestart_write = .FALSE. 
     844     CALL slowproc_main & 
    772845 &    (itau, kjpij, kjpindex, dt_force, date0, & 
    773846 &     ldrestart_read, ldrestart_write, .FALSE., .TRUE., & 
    … …  
    777850 &     deadleaf_cover, assim_param_x, lai_x, height_x, veget_x, & 
    778851 &     frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, & 
    779  &     rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_sto, hist_id_stom_IPCC, co2_flux) 
    780     day_counter = one_day - dt_force 
     852 &     rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu) 
     853     day_counter = one_day - dt_force 
    781854  ENDDO ! end of the time loop 
    782855!- 
    783 itau = itau -itau_step 
    784 !- 
    785856! write restart files 
    786857!- 
     858  IF (is_root_prc) THEN 
    787859! first, read and write variables that are not managed otherwise 
    788   taboo_vars = & 
    789  &  '$lat$ $lon$ $lev$ $veget_year$ '// & 
    790  &  '$height$ $day_counter$ $veget$ $veget_max$ $frac_nobio$ '// & 
    791  &  '$lai$ $soiltype_frac$ $clay_frac$ '// & 
    792  &  '$nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$' 
    793 !- 
    794   CALL ioget_vname(rest_id_sec, nbvar, varnames) 
    795 !!$!- 
    796 !!$! read and write some special variables (1D or variables that we need) 
    797 !!$!- 
    798 !!$  var_name = 'day_counter' 
    799 !!$  CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp) 
    800 !!$  CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp) 
    801 !!$!- 
    802 !!$  var_name = 'dt_days' 
    803 !!$  CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp) 
    804 !!$  CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp) 
    805 !!$!- 
    806 !!$  var_name = 'date' 
    807 !!$  CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp) 
    808 !!$  CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp) 
    809 !- 
    810   DO iv = 1, nbvar 
     860     taboo_vars = & 
     861          &  '$lat$ $lon$ $lev$ $veget_year$ '// & 
     862          &  '$height$ $day_counter$ $veget$ $veget_max$ $frac_nobio$ '// & 
     863          &  '$lai$ $soiltype_frac$ $clay_frac$ '// & 
     864          &  '$nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$' 
     865!- 
     866     CALL ioget_vname(rest_id_sec, nbvar, varnames) 
     867!- 
     868     DO iv = 1, nbvar 
    811869!-- check if the variable is to be written here 
    812     IF (INDEX( taboo_vars,'$'//TRIM(varnames(iv))//'$') .EQ. 0 ) THEN 
     870        IF (INDEX( taboo_vars,'$'//TRIM(varnames(iv))//'$') .EQ. 0 ) THEN 
     871           IF (debug) WRITE(numout,*) "restart var : ",TRIM(varnames(iv)),itau_dep,itau_fin 
     872 
    813873!---- get variable dimensions, especially 3rd dimension 
    814       CALL ioget_vdim & 
    815  &      (rest_id_sec, varnames(iv), varnbdim_max, varnbdim, vardims) 
    816       l1d = ALL(vardims(1:varnbdim) .EQ. 1) 
    817       ALLOCATE(var_3d(kjpindex,vardims(3)),stat=ier) 
    818       IF (ier .NE. 0) STOP 'ALLOCATION PROBLEM' 
     874           CALL ioget_vdim & 
     875                &      (rest_id_sec, varnames(iv), varnbdim_max, varnbdim, vardims) 
     876           l1d = ALL(vardims(1:varnbdim) .EQ. 1) 
    819877!---- read it 
    820       IF (l1d) THEN 
    821         CALL restget (rest_id_sec,TRIM(varnames(iv)), & 
    822                       1,vardims(3),1,itau_dep,.TRUE.,var_3d) 
    823       ELSE 
    824         CALL restget (rest_id_sec,TRIM(varnames(iv)), & 
    825                       kjpindex,vardims(3),1,itau_dep,.TRUE.,var_3d, & 
    826                       "gather",kjpindex,indices) 
    827       ENDIF 
     878           IF (l1d) THEN 
     879              CALL restget (rest_id_sec,TRIM(varnames(iv)), & 
     880                   1,1,1,itau_dep,.TRUE.,var_1d) 
     881           ELSE 
     882              ALLOCATE(var_3d(nbp_glo,vardims(3)),stat=ier) 
     883              IF (ier .NE. 0) STOP 'ALLOCATION PROBLEM' 
     884              CALL restget (rest_id_sec,TRIM(varnames(iv)), & 
     885                   nbp_glo,vardims(3),1,itau_dep,.TRUE.,var_3d, & 
     886                   "gather",nbp_glo,indices_g) 
     887           ENDIF 
    828888!---- write it 
    829       IF (l1d) THEN 
    830         CALL restput (rest_id_sec,TRIM(varnames(iv)), & 
    831                       1,vardims(3),1,itau,var_3d) 
    832       ELSE 
    833         CALL restput (rest_id_sec,TRIM(varnames(iv)), & 
    834                       kjpindex,vardims(3),1,itau,var_3d, & 
    835                       'scatter',kjpindex,indices) 
    836       ENDIF 
    837       DEALLOCATE (var_3d) 
    838     ENDIF 
    839   ENDDO 
     889           IF (l1d) THEN 
     890              CALL restput (rest_id_sec,TRIM(varnames(iv)), & 
     891                   1,1,1,itau_fin,var_1d) 
     892           ELSE 
     893              CALL restput (rest_id_sec,TRIM(varnames(iv)), & 
     894                   nbp_glo,vardims(3),1,itau_fin,var_3d, & 
     895                   'scatter',nbp_glo,indices_g) 
     896              DEALLOCATE (var_3d) 
     897           ENDIF 
     898        ENDIF 
     899     ENDDO 
     900  ENDIF 
     901  CALL barrier_para() 
     902 
    840903! call slowproc to write restart files 
    841904  ldrestart_read = .FALSE. 
    842905  ldrestart_write = .TRUE. 
    843906!- 
     907  IF (debug) WRITE(numout,*) "Call slowproc for restart." 
    844908  CALL slowproc_main & 
    845  &  (itau, kjpij, kjpindex, dt_force, date0, & 
     909 &  (itau_fin, kjpij, kjpindex, dt_force, date0, & 
    846910 &   ldrestart_read, ldrestart_write, .FALSE., .TRUE., & 
    847911 &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltype, & 
    … …  
    850914 &   deadleaf_cover, assim_param_x, lai_x, height_x, veget_x, & 
    851915 &   frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, & 
    852  &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_sto, hist_id_stom_IPCC, co2_flux) 
     916 &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu) 
    853917!- 
    854918! close files 
    855919!- 
    856   CALL restclo 
     920  IF (is_root_prc) THEN 
     921     CALL restclo 
     922     IF ( debug )  WRITE(numout,*) 'REST CLOSED' 
     923  ENDIF 
    857924  CALL histclo 
    858   ier = NF90_CLOSE (force_id) 
    859 !- 
    860 ! write a new driver restart file with correct time step 
    861 !- 
    862   write(*,*) 'teststomate: writing driver restart file with correct time step.' 
    863   dri_restname_in = 'driver_start.nc' 
    864   CALL getin ('RESTART_FILEIN',dri_restname_in) 
    865   dri_restname_out = 'driver_restart.nc' 
    866   CALL getin ('RESTART_FILEOUT',dri_restname_out) 
    867   CALL SYSTEM & 
    868  &  ('cp '//TRIM(dri_restname_in)//' '//TRIM(dri_restname_out)) 
    869 !- 
    870   iret = NF90_OPEN (TRIM(sec_restname_out),NF90_NOWRITE,ncfid) 
    871   iret = NF90_INQ_VARID (ncfid,'time',v_id) 
    872   iret = NF90_GET_VAR   (ncfid,v_id,r1d) 
    873   time_sec = r1d(1) 
    874   iret = NF90_INQ_VARID (ncfid,'time_steps',v_id) 
    875   iret = NF90_GET_VAR   (ncfid,v_id,time_step_sec) 
    876   iret = NF90_CLOSE (ncfid) 
    877 !- 
    878   iret = NF90_OPEN (TRIM(dri_restname_out),NF90_WRITE,ncfid) 
    879   iret = NF90_INQ_VARID (ncfid,'time',v_id) 
    880   iret = NF90_GET_VAR   (ncfid,v_id,r1d) 
    881   time_dri = r1d(1) 
    882   r1d(1) = time_sec 
    883   iret = NF90_PUT_VAR   (ncfid,v_id,r1d) 
    884   iret = NF90_INQ_VARID (ncfid,'time_steps',v_id) 
    885   iret = NF90_GET_VAR   (ncfid,v_id,time_step_dri) 
    886   iret = NF90_PUT_VAR   (ncfid,v_id,time_step_sec) 
    887   iret = NF90_INQ_VARID (ncfid,'julian',v_id) 
    888   iret = NF90_GET_VAR   (ncfid,v_id,r1d) 
    889   julian  = r1d(1) 
    890   djulian = (time_step_sec-time_step_dri)*dtradia/one_day 
    891   julian  = julian & 
    892  &         +djulian-FLOAT(INT((julian+djulian)/one_year))*one_year 
    893   r1d(1) = julian 
    894   iret = NF90_PUT_VAR   (ncfid,v_id,r1d) 
    895   iret = NF90_CLOSE (ncfid) 
    896  
    897   CALL getin_dump 
     925 
     926  IF (is_root_prc) & 
     927       ier = NF90_CLOSE (forcing_id) 
     928 
     929  IF (is_root_prc) THEN 
     930     CALL getin_dump() 
     931  ENDIF 
     932#ifdef CPP_PARA 
     933  CALL MPI_FINALIZE(ier) 
     934#endif 
     935  WRITE(numout,*) "End of teststomate." 
     936 
    898937!--------------- 
    899938END PROGRAM teststomate 
Note: See TracChangeset for help on using the changeset viewer.