Changeset 381

Timestamp:

2011-08-01T15:40:24+02:00 (13 years ago)

Author:

didier.solyga

Message:

Merge revisions 370 to 372 from the trunk in the externalized version

Location:

branches/ORCHIDEE_EXT/ORCHIDEE

Files:

• src_parallel/transfert_para.f90 (modified) (1 diff)
• src_sechiba/slowproc.f90 (modified) (4 diffs)
• src_stomate/stomate.f90 (modified) (1 diff)

branches/ORCHIDEE_EXT/ORCHIDEE/src_parallel/transfert_para.f90

@@ -196 +196 @@
   IMPLICIT NONE
     LOGICAL,INTENT(INOUT) :: Var
-   
-#ifndef CPP_PARA
-    RETURN
-#else
-    CALL bcast_lgen(Var,1)
+    LOGICAL,DIMENSION(1) :: Var1
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_root_prc) &
+         Var1(1)=Var
+    CALL bcast_lgen(Var1,1)
+    Var=Var1(1)
 #endif
   END SUBROUTINE bcast_l

branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/slowproc.f90

@@ -2564 +2564 @@
           !    et PFT naturel / (somme des vegets - somme des vegets anthropiques)
           !       est conservee.
-          ! Sum veget_next = old (sum veget_next Naturel) + (sum veget_next Anthropic) 
-          !           = new (sum veget_next Naturel) + (sum veget_next Anthropic)
-          !    a / (S-A) = e / (S-B) ; b/(S-A) = f/(S-B)
+          ! Modification de Nathalie : 
+          ! Si les PFTs anthropique diminue, on les remplace plutôt par du sol nu.
+          ! Le DGVM est chargé de ré-introduire les PFTs naturels.
           IF (sumf > min_sechiba) THEN
              sumvAnthro_old = zero
@@ -2573 +2573 @@
                 IF ( .NOT. natural(jv) ) THEN
                    veget_next(ib,jv) = veget_next(ib,jv) / sumf
-                   sumvAnthro = sumvAnthro + veget_last(ib,jv)
+                   sumvAnthro = sumvAnthro + veget_next(ib,jv)
                    sumvAnthro_old = sumvAnthro_old + veget_last(ib,jv)
                 ENDIF
              ENDDO
-             ! conservation :
-             rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old )
-             DO jv = 1, nvm
-                IF ( natural(jv) ) THEN
-                   veget_next(ib,jv) = veget_last(ib,jv) * rapport
-                ENDIF
-             ENDDO
+
+             IF ( sumvAnthro_old < sumvAnthro ) THEN
+                ! deforestation
+                ! conservation :
+                rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old )
+                DO jv = 1, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv) * rapport
+                   ENDIF
+                ENDDO
+             ELSE
+                ! reforestation
+                DO jv = 1, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv)
+                   ENDIF
+                ENDDO
+                veget_next(ib,1) = veget_next(ib,1) + sumvAnthro_old - sumvAnthro
+             ENDIF
+
              ! test
              IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > 10*EPSILON(un) ) THEN
@@ -2589 +2602 @@
                 WRITE(numout,*) "last sum of veget ",sum_veg," new sum of veget ",SUM(veget_next(ib,:))," error : ",&
                      &                         SUM(veget_next(ib,:)) - sum_veg
-                WRITE(numout,*) "Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro  
+                WRITE(numout,*) "Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro     
                 CALL ipslerr (3,'slowproc_update', &
                      &          'No conservation of sum of veget_next', &
                      &          "The sum of veget_next is different after reading Land Use map.", &
-                  &          '(verify the dgvm case model.)')
+                     &          '(verify the dgvm case model.)')
              ENDIF
           ELSE
@@ -2770 +2783 @@
     !
     IF (MAXVAL(vegmap) .LT. nolson) THEN
-       WRITE(*,*) 'WARNING -- WARNING'
-       WRITE(*,*) 'The vegetation map has to few vegetation types.'
-       WRITE(*,*) 'If you are lucky it will work but please check'
+       WRITE(numout,*) 'WARNING -- WARNING'
+       WRITE(numout,*) 'The vegetation map has to few vegetation types.'
+       WRITE(numout,*) 'If you are lucky it will work but please check'
     ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN
-       WRITE(*,*) 'More vegetation types in file than the code can'
-       WRITE(*,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
+       WRITE(numout,*) 'More vegetation types in file than the code can'
+       WRITE(numout,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
        STOP 'slowproc_interpol'
     ENDIF

branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate.f90

@@ -1706 +1706 @@
     ! allocation error
     LOGICAL                                     :: l_error
-    ! Global world fraction of vegetation type map
-    REAL(r_std),DIMENSION(360,180,nvm)           :: veget_ori_on_disk
     INTEGER(i_std)                              :: ier
     ! indices