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

Externalized version merged with the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/slowproc.f90

    r143 r257  
    22! Daily update of leaf area index etc. 
    33! 
    4 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/slowproc.f90,v 1.48 2010/04/20 14:12:04 ssipsl Exp $ 
     4!< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/slowproc.f90 $ 
     5!< $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 
     6!< $Author: mmaipsl $ 
     7!< $Revision: 45 $ 
    58!! IPSL (2006) 
    69!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC 
    … …  
    5457  LOGICAL, SAVE                                   :: old_lai = .FALSE.         ! Old Lai Map interpolation 
    5558  LOGICAL, SAVE                                   :: impveg = .FALSE. 
     59  LOGICAL, SAVE                                   :: impsoilt = .FALSE. 
    5660  LOGICAL, SAVE                                   :: old_veget = .FALSE.         ! Old veget Map interpolation 
    5761  ! 
    … …  
    143147    LOGICAL, PARAMETER                                 :: check = .FALSE. 
    144148 
    145     REAL(r_std), SAVE                                       :: sec_old = 0. 
     149    REAL(r_std), SAVE                                       :: sec_old = zero 
    146150    ! 
    147151    ! do initialisation 
    … …  
    299303    ! Test each day and assert all slow processes (days and years) 
    300304    ! 
    301     IF ( sec_old >= one_day - dtradia .AND.  sec >= 0. ) THEN 
     305    IF ( sec_old >= one_day - dtradia .AND.  sec >= zero ) THEN 
    302306       ! 
    303307       ! reset counter 
    … …  
    510514    LOGICAL, PARAMETER                                 :: check = .FALSE. 
    511515    ! 
    512     ! DS 15032011 add for replacing SUM(veget_max(ji,nvm-1:nvm  
     516    ! DS 15032011 add for replacing SUM(veget_max(ji,nvm-1:nvm))  
    513517    REAL(r_std)    :: sum_veget_max 
    514     ! 
    515  
    516518 
    517519    ! 
    … …  
    582584    !Config        only done once a day. 
    583585    ! 
    584     CALL setvar_p (day_counter, val_exp, 'SECHIBA_DAY', 0.0_r_std) 
     586    CALL setvar_p (day_counter, val_exp, 'SECHIBA_DAY', zero) 
    585587    ! 
    586588    !Config Key  = LAI_MAP 
    … …  
    733735       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 12, kjit, .TRUE., laimap) 
    734736       ! 
     737    ELSE 
     738       ! 
     739       ALLOCATE (laimap(1,1,1)) 
    735740    ENDIF 
    736741    ! 
    … …  
    806811    !Config  Key  = DT_SLOW 
    807812    !Config  Desc = Time step of STOMATE and other slow processes 
    808     !Config  Def  = 86400. 
     813    !Config  Def  = one_day 
    809814    !Config  Help = Time step (s) of regular update of vegetation 
    810815    !Config         cover, LAI etc. This is also the time step 
    … …  
    905910       CALL setvar_p (lai, val_exp, 'SECHIBA_LAI', llaimax) 
    906911 
    907   
    908        !Config Key  = SOIL_FRACTIONS 
    909        !Config Desc = Fraction of the 3 soil types (0-dim mode) 
    910        !Config Def  = 0.28, 0.52, 0.20 
     912       ! 
     913       !Config Key  = IMPOSE_SOILT 
     914       !Config Desc = Should the soil typ be prescribed 
     915       !Config Def  = n 
    911916       !Config If   = IMPOSE_VEG 
    912        !Config Help = Determines the fraction for the 3 soil types 
    913        !Config        in the mesh in the following order : sand loam and clay. 
    914        ! 
    915        CALL setvar_p (soiltype, val_exp, 'SOIL_FRACTIONS', soiltype_default) 
    916  
    917  
    918        !Config Key  = CLAY_FRACTION 
    919        !Config Desc = Fraction of the clay fraction (0-dim mode) 
    920        !Config Def  = 0.2 
    921        !Config If   = IMPOSE_VEG 
    922        !Config Help = Determines the fraction of clay in the grid box. 
    923        ! 
    924        CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default) 
    925  
     917       !Config Help = This flag allows the user to impose a soil type distribution. 
     918       !Config        It is espacially interesting for 0D 
     919       !Config        simulations. On the globe it does not make too much sense as 
     920       !Config        it imposes the same soil everywhere 
     921       ! 
     922       impsoilt = .FALSE. 
     923       CALL getin_p('IMPOSE_SOILT', impsoilt) 
     924       IF (impsoilt) THEN 
     925          !Config Key  = SOIL_FRACTIONS 
     926          !Config Desc = Fraction of the 3 soil types (0-dim mode) 
     927          !Config Def  = 0.28, 0.52, 0.20 
     928          !Config If   = IMPOSE_VEG 
     929          !Config If   = IMPOSE_SOILT 
     930          !Config Help = Determines the fraction for the 3 soil types 
     931          !Config        in the mesh in the following order : sand loam and clay. 
     932          ! 
     933          CALL setvar_p (soiltype, val_exp, 'SOIL_FRACTIONS', soiltype_default) 
     934 
     935          !Config Key  = CLAY_FRACTION 
     936          !Config Desc = Fraction of the clay fraction (0-dim mode) 
     937          !Config Def  = 0.2 
     938          !Config If   = IMPOSE_VEG 
     939          !Config If   = IMPOSE_SOILT 
     940          !Config Help = Determines the fraction of clay in the grid box. 
     941          ! 
     942          CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default) 
     943       ELSE 
     944          IF ( MINVAL(soiltype) .EQ. MAXVAL(soiltype) .AND. MAXVAL(soiltype) .EQ. val_exp .OR.& 
     945               & MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp) THEN 
     946 
     947             CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soiltype, clayfraction) 
     948          ENDIF 
     949       ENDIF 
    926950       ! 
    927951       !Config Key  = SLOWPROC_HEIGHT 
    … …  
    10051029             ! If restart doesn't contain veget, then it is the first computation 
    10061030             CALL slowproc_update(kjpindex, lalo, neighbours, resolution, contfrac, & 
    1007                   &               veget_max, frac_nobio, veget_max, frac_nobio, veget_year, init=.TRUE.) 
     1031               &               veget_nextyear, frac_nobio_nextyear, veget_max, frac_nobio, veget_year, init=.TRUE.) 
    10081032             ! 
    10091033             IF ( control%ok_dgvm  ) THEN 
    … …  
    11721196       ! 
    11731197    CASE('MAXR') 
    1174        pref_soil_veg(:,1) = pref_soil_veg_sand 
    1175        pref_soil_veg(:,2) = pref_soil_veg_loan       
    1176        pref_soil_veg(:,3) = pref_soil_veg_clay 
     1198       pref_soil_veg(:,1) = pref_soil_veg_sand(:) 
     1199       pref_soil_veg(:,2) = pref_soil_veg_loan(:)       
     1200       pref_soil_veg(:,3) = pref_soil_veg_clay(:) 
    11771201       ! 
    11781202       ! Current default : equidistribution. 
    … …  
    13651389    ! 
    13661390 
    1367     IF ( ( tau .LT. dt ) .OR. ( dt .LE. 0. ) .OR. ( tau .LE. 0. ) ) THEN 
     1391    IF ( ( tau .LT. dt ) .OR. ( dt .LE. zero ) .OR. ( tau .LE. zero ) ) THEN 
    13681392       WRITE(numout,*) 'slowproc_long: Problem with time steps' 
    13691393       WRITE(numout,*) 'dt=',dt 
    … …  
    14111435    ! 1.1 Sum up 
    14121436    ! 
    1413     fracsum(:) = 0. 
     1437    fracsum(:) = zero 
    14141438    DO jv = 1, nnobio 
    14151439       DO ji = 1, kjpindex 
    … …  
    14771501       ENDDO 
    14781502    ENDDO 
    1479      
    14801503    ! 
    14811504    ! 3. if lai of a vegetation type (jv > 1) is small, increase soil part 
    … …  
    15011524    ! Ajout Nouveau calcul (stomate-like)  
    15021525    DO ji = 1, kjpindex 
    1503        SUMveg = 0.0 
     1526       SUMveg = zero 
    15041527       veget(ji,1) = veget_max(ji,1) 
    15051528       DO jv = 2, nvm 
    1506           veget(ji,jv) = veget_max(ji,jv) * ( 1. - exp( - lai(ji,jv) * ext_coeff(jv) ) ) 
     1529          veget(ji,jv) = veget_max(ji,jv) * ( un - exp( - lai(ji,jv) * ext_coeff(jv) ) ) 
    15071530          veget(ji,1) = veget(ji,1) + (veget_max(ji,jv) - veget(ji,jv)) 
    15081531          SUMveg = SUMveg + veget(ji,jv) 
    … …  
    15151538       ENDIF 
    15161539    ENDDO 
    1517  
    15181540    ! 
    15191541    ! 4. Sum up surface fractions and test if the sum is equal to 1 
    … …  
    15231545    ! 4.1 Sum up 
    15241546    ! 
    1525     fracsum(:) = 0. 
     1547    fracsum(:) = zero 
    15261548    DO jv = 1, nnobio 
    15271549       DO ji = 1, kjpindex 
    … …  
    15991621    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution !! size in x an y of the grid (m) 
    16001622 
    1601     REAL(r_std), DIMENSION(kjpindex,nvm,12), INTENT(in) :: laimap     !! LAI lue 
     1623    REAL(r_std), DIMENSION(:,:,:), INTENT(in)          :: laimap     !! LAI lue 
    16021624    LOGICAL, INTENT(in)                                :: read_lai 
    16031625    ! 0.2 Output 
    … …  
    16101632    ! Test Nathalie. On impose LAI PFT 1 a 0 
    16111633    ! On boucle sur 2,nvm au lieu de 1,nvm 
    1612     lai(: ,1) = 0.0 
     1634    lai(: ,1) = zero 
    16131635    DO jv = 2,nvm 
    16141636!!$    DO jv = 1,nvm 
    … …  
    17711793    ! 
    17721794    WHERE  ( laimaporig(:,:,:) .LT. 0 ) 
    1773        laimaporig(:,:,:) = 0. 
     1795       laimaporig(:,:,:) = zero 
    17741796    ENDWHERE 
    17751797    ! 
    … …  
    18311853    ilast = 1 
    18321854    n_origlai(:) = 0 
    1833     laimap(:,:,:) = 0.     
     1855    laimap(:,:,:) = zero    
    18341856    ! 
    18351857    DO ip=1,ijml 
    … …  
    19431965             ! Antartica 
    19441966             DO jv =1,nvm 
    1945                 laimap(ip,jv,:) = 0. 
     1967                laimap(ip,jv,:) = zero 
    19461968             ENDDO 
    19471969             ! 
    … …  
    19491971             ! Artica 
    19501972             DO jv =1,nvm 
    1951                 laimap(ip,jv,:) = 0. 
     1973                laimap(ip,jv,:) = zero 
    19521974             ENDDO 
    19531975             ! 
    … …  
    19551977             ! Greenland 
    19561978             DO jv =1,nvm 
    1957                 laimap(ip,jv,:) = 0. 
     1979                laimap(ip,jv,:) = zero 
    19581980             ENDDO 
    19591981             ! 
    … …  
    25902612       DO ib = 1, nbpt 
    25912613          idi=1 
    2592           sumf=0. 
     2614          sumf=zero 
    25932615          DO WHILE ( sub_area(ib,idi) > zero )  
    25942616             ip = sub_index(ib,idi,1) 
    … …  
    26222644             IF (PRESENT(init)) THEN 
    26232645                IF (init) THEN 
    2624 !                   veget_next(ib,:) = (/ 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) 
    2625                     veget_next(ib,1) = 1. 
     2646                    veget_next(ib,1) = un 
    26262647                    veget_next(ib,2:nvm) = zero 
    26272648                ELSE 
    … …  
    26582679          ! 
    26592680          idi=1 
    2660           sumf=0. 
     2681          sumf=zero 
    26612682          DO WHILE ( sub_area(ib,idi) > zero )  
    26622683             ip = sub_index(ib,idi,1) 
    … …  
    27632784          err=norm-un 
    27642785          IF (debug) & 
    2765              WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-1., sumf",err,sumf 
    2766           IF (abs(err) > -EPSILON(1._r_std)) THEN 
     2786             WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un, sumf",err,sumf 
     2787          IF (abs(err) > -EPSILON(un)) THEN 
    27672788!MM 1.9.3 
    27682789!          IF (abs(err) > 0.) THEN 
    … …  
    27752796             err=norm-un 
    27762797             IF (debug) & 
    2777                   WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-1.",err 
    2778              IF (abs(err) > EPSILON(1._r_std)) THEN 
     2798                  WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un",err 
     2799             IF (abs(err) > EPSILON(un)) THEN 
    27792800!MM 1.9.3 
    27802801!             IF (abs(err) > 0.) THEN 
    … …  
    29272948       ! 
    29282949       ! 
    2929        veget(ib,:) = 0.0 
    2930        frac_nobio (ib,:) = 0.0 
     2950       veget(ib,:) = zero 
     2951       frac_nobio (ib,:) = zero 
    29312952       ! 
    29322953    ENDDO 
    … …  
    30633084        frac_origveg(:,vid) =  REAL(n_origveg(:,vid),r_std) /  REAL(n_found(:),r_std) 
    30643085      ELSEWHERE 
    3065          frac_origveg(:,vid) = 0. 
     3086         frac_origveg(:,vid) = zero 
    30663087      ENDWHERE 
    30673088    ENDDO 
    … …  
    30993120          IF ( lalo(ib,1) .LT. -56.0) THEN 
    31003121             ! Antartica 
    3101              frac_nobio(ib,:) = 0.0 
    3102              frac_nobio(ib,iice) = 1.0 
    3103              veget(ib,:) = 0.0 
     3122             frac_nobio(ib,:) = zero 
     3123             frac_nobio(ib,iice) = un 
     3124             veget(ib,:) = zero 
    31043125             ! 
    31053126          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 
    31063127             ! Artica 
    3107              frac_nobio(ib,:) = 0.0 
    3108              frac_nobio(ib,iice) = 1.0 
    3109              veget(ib,:) = 0.0 
     3128             frac_nobio(ib,:) = zero 
     3129             frac_nobio(ib,iice) = un 
     3130             veget(ib,:) = zero 
    31103131             ! 
    31113132          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 
    31123133             ! Greenland 
    3113              frac_nobio(ib,:) = 0.0 
    3114              frac_nobio(ib,iice) = 1.0 
    3115              veget(ib,:) = 0.0 
     3134             frac_nobio(ib,:) = zero 
     3135             frac_nobio(ib,iice) = un 
     3136             veget(ib,:) = zero 
    31163137             ! 
    31173138          ELSE 
    … …  
    31443165       DO vid = 1, nvm 
    31453166          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 
    3146              veget(ib,vid) = 0.0 
     3167             veget(ib,vid) = zero 
    31473168          ENDIF 
    31483169       ENDDO 
    … …  
    33463367          frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:) 
    33473368       ELSEWHERE 
    3348           frac_origveg(:,vid) = 0. 
     3369          frac_origveg(:,vid) = zero 
    33493370       ENDWHERE 
    33503371    ENDDO 
    … …  
    33823403          IF ( lalo(ib,1) .LT. -56.0) THEN 
    33833404             ! Antartica 
    3384              frac_nobio(ib,:) = 0.0 
    3385              frac_nobio(ib,iice) = 1.0 
    3386              veget(ib,:) = 0.0 
     3405             frac_nobio(ib,:) = zero 
     3406             frac_nobio(ib,iice) = un 
     3407             veget(ib,:) = zero 
    33873408             ! 
    33883409          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 
    33893410             ! Artica 
    3390              frac_nobio(ib,:) = 0.0 
    3391              frac_nobio(ib,iice) = 1.0 
    3392              veget(ib,:) = 0.0 
     3411             frac_nobio(ib,:) = zero 
     3412             frac_nobio(ib,iice) = un 
     3413             veget(ib,:) = zero 
    33933414             ! 
    33943415          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 
    33953416             ! Greenland 
    3396              frac_nobio(ib,:) = 0.0 
    3397              frac_nobio(ib,iice) = 1.0 
    3398              veget(ib,:) = 0.0 
     3417             frac_nobio(ib,:) = zero 
     3418             frac_nobio(ib,iice) = un 
     3419             veget(ib,:) = zero 
    33993420             ! 
    34003421          ELSE 
    … …  
    34273448       DO vid = 1, nvm 
    34283449          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 
    3429              veget(ib,vid) = 0.0 
     3450             veget(ib,vid) = zero 
    34303451          ENDIF 
    34313452       ENDDO 
    … …  
    35543575       ! 
    35553576       ! 
    3556        veget(ib,:) = 0.0 
    3557        frac_nobio (ib,:) = 0.0 
     3577       veget(ib,:) = zero 
     3578       frac_nobio (ib,:) = zero 
    35583579       ! 
    35593580    ENDDO 
    … …  
    36903711        frac_origveg(:,vid) =  REAL(n_origveg(:,vid),r_std) /  REAL(n_found(:),r_std) 
    36913712      ELSEWHERE 
    3692          frac_origveg(:,vid) = 0. 
     3713         frac_origveg(:,vid) = zero 
    36933714      ENDWHERE 
    36943715    ENDDO 
    … …  
    37263747          IF ( lalo(ib,1) .LT. -56.0) THEN 
    37273748             ! Antartica 
    3728              frac_nobio(ib,:) = 0.0 
    3729              frac_nobio(ib,iice) = 1.0 
    3730              veget(ib,:) = 0.0 
     3749             frac_nobio(ib,:) = zero 
     3750             frac_nobio(ib,iice) = un 
     3751             veget(ib,:) = zero 
    37313752             ! 
    37323753          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 
    37333754             ! Artica 
    3734              frac_nobio(ib,:) = 0.0 
    3735              frac_nobio(ib,iice) = 1.0 
    3736              veget(ib,:) = 0.0 
     3755             frac_nobio(ib,:) = zero 
     3756             frac_nobio(ib,iice) = un 
     3757             veget(ib,:) = zero 
    37373758             ! 
    37383759          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 
    37393760             ! Greenland 
    3740              frac_nobio(ib,:) = 0.0 
    3741              frac_nobio(ib,iice) = 1.0 
    3742              veget(ib,:) = 0.0 
     3761             frac_nobio(ib,:) = zero 
     3762             frac_nobio(ib,iice) = un 
     3763             veget(ib,:) = zero 
    37433764             ! 
    37443765          ELSE 
    … …  
    37713792       DO vid = 1, nvm 
    37723793          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 
    3773              veget(ib,vid) = 0.0 
     3794             veget(ib,vid) = zero 
    37743795          ENDIF 
    37753796       ENDDO 
    … …  
    39623983          frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:) 
    39633984       ELSEWHERE 
    3964           frac_origveg(:,vid) = 0. 
     3985          frac_origveg(:,vid) = zero 
    39653986       ENDWHERE 
    39663987    ENDDO 
    … …  
    39984019          IF ( lalo(ib,1) .LT. -56.0) THEN 
    39994020             ! Antartica 
    4000              frac_nobio(ib,:) = 0.0 
    4001              frac_nobio(ib,iice) = 1.0 
    4002              veget(ib,:) = 0.0 
     4021             frac_nobio(ib,:) = zero 
     4022             frac_nobio(ib,iice) = un 
     4023             veget(ib,:) = zero 
    40034024             ! 
    40044025          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 
    40054026             ! Artica 
    4006              frac_nobio(ib,:) = 0.0 
    4007              frac_nobio(ib,iice) = 1.0 
    4008              veget(ib,:) = 0.0 
     4027             frac_nobio(ib,:) = zero 
     4028             frac_nobio(ib,iice) = un 
     4029             veget(ib,:) = zero 
    40094030             ! 
    40104031          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 
    40114032             ! Greenland 
    4012              frac_nobio(ib,:) = 0.0 
    4013              frac_nobio(ib,iice) = 1.0 
    4014              veget(ib,:) = 0.0 
     4033             frac_nobio(ib,:) = zero 
     4034             frac_nobio(ib,iice) = un 
     4035             veget(ib,:) = zero 
    40154036             ! 
    40164037          ELSE 
    … …  
    40434064       DO vid = 1, nvm 
    40444065          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 
    4045              veget(ib,vid) = 0.0 
     4066             veget(ib,vid) = zero 
    40464067          ENDIF 
    40474068       ENDDO 
Note: See TracChangeset for help on using the changeset viewer.