SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/co2

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE CO2_INIT_n(HPHOTO, KSIZE_NATURE_P, KR_NATURE_P, PVEGTYPE_PATCH, &
00003                             PCO2, PGMES, PGC, PDMAX, PABC, PPOI, PANMAX, &
00004                             PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES,      &
00005                             PT1GMES, PT2GMES, PAMAX, PQDAMAX,            &
00006                             PT1AMAX, PT2AMAX, PAH, PBH,                  &
00007                             PTAU_WOOD, PINCREASE, PTURNOVER              )
00008 !     #####################
00009 !
00010 !!****  *CO2_INIT_n* - routine to initialize ISBA-AGS variables
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !!
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    EXTERNAL
00019 !!    --------
00020 !!
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------
00024 !!
00025 !!    REFERENCE
00026 !!    ---------
00027 !!
00028 !!
00029 !!    AUTHOR
00030 !!    ------
00031 !!      V. Masson   *Meteo France*      
00032 !!
00033 !!    MODIFICATIONS
00034 !!    -------------
00035 !!      Original    02/2003 
00036 !!      J.C. Calvet 01/2004 Externalization
00037 !!      P Le Moigne 11/2004 cotwoinit changed into cotwoinit_n
00038 !!      P Le Moigne 09/2005 AGS modifs of L. Jarlan
00039 !!      S Lafont    09/2008 Add initialisation of POI and ABC (needed for TORI)
00040 !!      A.L. Gibelin 04/2009 : TAU_WOOD for NCB option 
00041 !!      A.L. Gibelin 04/2009 : Add carbon spinup
00042 !!      A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
00043 !!      A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
00044 !!
00045 !-------------------------------------------------------------------------------
00046 !
00047 !*       0.    DECLARATIONS
00048 !              ------------
00049 !
00050 USE MODD_SURF_PAR,       ONLY : XUNDEF
00051 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
00052 !
00053 USE MODI_COTWOINIT_n
00054 !
00055 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00056 USE PARKIND1  ,ONLY : JPRB
00057 !
00058 IMPLICIT NONE
00059 !
00060 !*       0.1   Declarations of arguments
00061 !              -------------------------
00062 !
00063  CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
00064 INTEGER, DIMENSION(:), INTENT(IN) :: KSIZE_NATURE_P
00065 INTEGER, DIMENSION(:,:), INTENT(IN) :: KR_NATURE_P
00066 REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE_PATCH
00067 REAL, DIMENSION(:), INTENT(IN) :: PCO2 ! air CO2 concentration (kg/kg)
00068 REAL, DIMENSION(:,:), INTENT(IN) :: PGMES
00069 REAL, DIMENSION(:,:), INTENT(IN) :: PGC
00070 REAL, DIMENSION(:,:), INTENT(IN) :: PDMAX
00071 REAL, DIMENSION(:), INTENT(OUT) :: PABC
00072 REAL, DIMENSION(:), INTENT(OUT) :: PPOI
00073 REAL, DIMENSION(:,:), INTENT(OUT) :: PANMAX
00074 REAL, DIMENSION(:,:), INTENT(OUT) :: PFZERO
00075 REAL, DIMENSION(:,:), INTENT(OUT) :: PEPSO
00076 REAL, DIMENSION(:,:), INTENT(OUT) :: PGAMM
00077 REAL, DIMENSION(:,:), INTENT(OUT) :: PQDGAMM
00078 REAL, DIMENSION(:,:), INTENT(OUT) :: PQDGMES
00079 REAL, DIMENSION(:,:), INTENT(OUT) :: PT1GMES
00080 REAL, DIMENSION(:,:), INTENT(OUT) :: PT2GMES
00081 REAL, DIMENSION(:,:), INTENT(OUT) :: PAMAX
00082 REAL, DIMENSION(:,:), INTENT(OUT) :: PQDAMAX
00083 REAL, DIMENSION(:,:), INTENT(OUT) :: PT1AMAX
00084 REAL, DIMENSION(:,:), INTENT(OUT) :: PT2AMAX
00085 REAL, DIMENSION(:,:), INTENT(OUT) :: PAH
00086 REAL, DIMENSION(:,:), INTENT(OUT) :: PBH
00087 REAL, DIMENSION(:,:), INTENT(OUT) :: PTAU_WOOD
00088 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINCREASE
00089 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTURNOVER
00090 !
00091 !*       0.2   Declarations of local variables
00092 !              -------------------------------
00093 !
00094 REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_VEGTYPE_PATCH  ! vegtypes present for each tile
00095 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_GMES           ! 
00096 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_CO2            ! air CO2 concentration (kg/kg)
00097 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_GC             !
00098 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_DMAX           !
00099 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_ANMAX          !
00100 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_FZERO          !
00101 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_EPSO           !
00102 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_GAMM           !
00103 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_QDGAMM         !
00104 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_QDGMES         !
00105 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_T1GMES         !
00106 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_T2GMES         !
00107 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_AMAX           !
00108 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_QDAMAX         !
00109 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_T1AMAX         !
00110 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_T2AMAX         !
00111 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_AH             !
00112 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_BH             !
00113 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_TAU_WOOD       !
00114 REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_INCREASE       !
00115 REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TURNOVER       !
00116 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_ABC            !
00117 REAL, DIMENSION(:),   ALLOCATABLE :: ZP_POI            !
00118 !
00119 INTEGER :: ILU   ! size of arrays
00120 INTEGER :: IPATCH
00121 INTEGER :: INBIOMASS
00122 INTEGER :: JP    ! loop on tiles
00123 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00124 !-------------------------------------------------------------------------------
00125 IF (LHOOK) CALL DR_HOOK('CO2_INIT_N',0,ZHOOK_HANDLE)
00126 !
00127 ILU    = SIZE(PVEGTYPE_PATCH,1)
00128 IPATCH = SIZE(PVEGTYPE_PATCH,3)
00129 INBIOMASS = SIZE(PINCREASE,2)
00130 !
00131 DO JP=1,IPATCH
00132 !
00133   IF (KSIZE_NATURE_P(JP) == 0 ) CYCLE
00134 !
00135      CALL PACK_CO2_INIT(KR_NATURE_P(:,JP),KSIZE_NATURE_P(JP),JP)
00136 !
00137      CALL COTWOINIT_n(HPHOTO, ZP_VEGTYPE_PATCH,ZP_GMES,ZP_CO2,ZP_GC,   &
00138             ZP_DMAX,ZP_ABC,ZP_POI,ZP_ANMAX,ZP_FZERO,            &
00139             ZP_EPSO,ZP_GAMM,ZP_QDGAMM,ZP_QDGMES,ZP_T1GMES,      &
00140             ZP_T2GMES,ZP_AMAX,ZP_QDAMAX,ZP_T1AMAX,              &
00141             ZP_T2AMAX,ZP_AH,ZP_BH,ZP_TAU_WOOD                   )  
00142 
00143      ZP_INCREASE = 0.
00144      ZP_TURNOVER = 0.
00145 !
00146      CALL UNPACK_CO2_INIT(KR_NATURE_P(:,JP),KSIZE_NATURE_P(JP),JP)
00147 ENDDO
00148 !
00149 !-------------------------------------------------------------------------------
00150 IF (LHOOK) CALL DR_HOOK('CO2_INIT_N',1,ZHOOK_HANDLE)
00151 CONTAINS
00152 !-------------------------------------------------------------------------------
00153 SUBROUTINE PACK_CO2_INIT(KMASK,KSIZE,KPATCH)
00154 IMPLICIT NONE
00155 INTEGER, INTENT(IN)               :: KSIZE, KPATCH
00156 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00157 !
00158 INTEGER JJ, JI
00159 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00160 !
00161 IF (LHOOK) CALL DR_HOOK('PACK_CO2_INIT',0,ZHOOK_HANDLE)
00162 ALLOCATE(ZP_VEGTYPE_PATCH(KSIZE,NVEGTYPE))
00163 ALLOCATE(ZP_GMES         (KSIZE))
00164 ALLOCATE(ZP_CO2          (KSIZE))
00165 ALLOCATE(ZP_GC           (KSIZE))
00166 ALLOCATE(ZP_DMAX         (KSIZE))
00167 ALLOCATE(ZP_ANMAX        (KSIZE))
00168 ALLOCATE(ZP_FZERO        (KSIZE))
00169 ALLOCATE(ZP_EPSO         (KSIZE))
00170 ALLOCATE(ZP_GAMM         (KSIZE))
00171 ALLOCATE(ZP_QDGAMM       (KSIZE))
00172 ALLOCATE(ZP_QDGMES       (KSIZE))
00173 ALLOCATE(ZP_T1GMES       (KSIZE))
00174 ALLOCATE(ZP_T2GMES       (KSIZE))
00175 ALLOCATE(ZP_AMAX         (KSIZE))
00176 ALLOCATE(ZP_QDAMAX       (KSIZE))
00177 ALLOCATE(ZP_T1AMAX       (KSIZE))
00178 ALLOCATE(ZP_T2AMAX       (KSIZE))
00179 ALLOCATE(ZP_AH           (KSIZE))
00180 ALLOCATE(ZP_BH           (KSIZE))
00181 ALLOCATE(ZP_TAU_WOOD     (KSIZE))
00182 ALLOCATE(ZP_INCREASE     (KSIZE,INBIOMASS))
00183 ALLOCATE(ZP_TURNOVER     (KSIZE,INBIOMASS))
00184 !
00185 ! initialisation needed for TORI
00186 ALLOCATE(ZP_ABC(SIZE(PABC)))
00187 ALLOCATE(ZP_POI(SIZE(PPOI)))
00188 ZP_ABC(:)=0.
00189 ZP_POI(:)=0.
00190 !
00191 DO JJ=1,KSIZE
00192   JI                     =    KMASK(JJ)
00193   ZP_VEGTYPE_PATCH(JJ,:) =    PVEGTYPE_PATCH(JI,:,KPATCH)
00194   ZP_GMES         (JJ)   =    PGMES         (JI,KPATCH)
00195   ZP_CO2          (JJ)   =    PCO2          (JI)
00196   ZP_GC           (JJ)   =    PGC           (JI,KPATCH)
00197   ZP_DMAX         (JJ)   =    PDMAX         (JI,KPATCH)
00198 END DO
00199 IF (LHOOK) CALL DR_HOOK('PACK_CO2_INIT',1,ZHOOK_HANDLE)
00200 !-------------------------------------------------------------------------------
00201 END SUBROUTINE PACK_CO2_INIT
00202 !-------------------------------------------------------------------------------
00203 SUBROUTINE UNPACK_CO2_INIT(KMASK,KSIZE,KPATCH)
00204 IMPLICIT NONE
00205 INTEGER, INTENT(IN)               :: KSIZE, KPATCH
00206 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00207 !
00208 INTEGER JJ, JI
00209 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00210 !
00211 IF (LHOOK) CALL DR_HOOK('UNPACK_CO2_INIT',0,ZHOOK_HANDLE)
00212 PANMAX     (:,KPATCH) = XUNDEF
00213 PFZERO     (:,KPATCH) = XUNDEF
00214 PEPSO      (:,KPATCH) = XUNDEF
00215 PGAMM      (:,KPATCH) = XUNDEF
00216 PQDGAMM    (:,KPATCH) = XUNDEF
00217 PQDGMES    (:,KPATCH) = XUNDEF
00218 PT1GMES    (:,KPATCH) = XUNDEF
00219 PT2GMES    (:,KPATCH) = XUNDEF
00220 PAMAX      (:,KPATCH) = XUNDEF
00221 PQDAMAX    (:,KPATCH) = XUNDEF
00222 PT1AMAX    (:,KPATCH) = XUNDEF
00223 PT2AMAX    (:,KPATCH) = XUNDEF
00224 PAH        (:,KPATCH) = XUNDEF
00225 PBH        (:,KPATCH) = XUNDEF
00226 PTAU_WOOD  (:,KPATCH) = XUNDEF
00227 PINCREASE  (:,:,KPATCH) = XUNDEF
00228 PTURNOVER  (:,:,KPATCH) = XUNDEF
00229 !
00230 DO JJ=1,KSIZE
00231    JI                              = KMASK         (JJ)
00232    PANMAX          (JI, KPATCH)    = ZP_ANMAX      (JJ)
00233    PFZERO          (JI, KPATCH)    = ZP_FZERO      (JJ)
00234    PEPSO           (JI, KPATCH)    = ZP_EPSO       (JJ)
00235    PGAMM           (JI, KPATCH)    = ZP_GAMM       (JJ)
00236    PQDGAMM         (JI, KPATCH)    = ZP_QDGAMM     (JJ)
00237    PQDGMES         (JI, KPATCH)    = ZP_QDGMES     (JJ)
00238    PT1GMES         (JI, KPATCH)    = ZP_T1GMES     (JJ)
00239    PT2GMES         (JI, KPATCH)    = ZP_T2GMES     (JJ)
00240    PAMAX           (JI, KPATCH)    = ZP_AMAX       (JJ)
00241    PQDAMAX         (JI, KPATCH)    = ZP_QDAMAX     (JJ)
00242    PT1AMAX         (JI, KPATCH)    = ZP_T1AMAX     (JJ)
00243    PT2AMAX         (JI, KPATCH)    = ZP_T2AMAX     (JJ)
00244    PAH             (JI, KPATCH)    = ZP_AH         (JJ)
00245    PBH             (JI, KPATCH)    = ZP_BH         (JJ)
00246    PTAU_WOOD       (JI, KPATCH)    = ZP_TAU_WOOD   (JJ)
00247    PINCREASE       (JI, :, KPATCH) = ZP_INCREASE   (JJ, :)
00248    PTURNOVER       (JI, :, KPATCH) = ZP_TURNOVER   (JJ, :)
00249 END DO
00250 ! 
00251 DO JJ=1,SIZE(PABC)
00252    PABC(JJ)=ZP_ABC(JJ)
00253    PPOI(JJ)=ZP_POI(JJ)
00254 END DO 
00255 
00256 DEALLOCATE(ZP_VEGTYPE_PATCH)
00257 DEALLOCATE(ZP_GMES         )
00258 DEALLOCATE(ZP_CO2          )
00259 DEALLOCATE(ZP_GC           )
00260 DEALLOCATE(ZP_DMAX         )
00261 DEALLOCATE(ZP_ANMAX        )
00262 DEALLOCATE(ZP_FZERO        )
00263 DEALLOCATE(ZP_EPSO         )
00264 DEALLOCATE(ZP_GAMM         )
00265 DEALLOCATE(ZP_QDGAMM       )
00266 DEALLOCATE(ZP_QDGMES       )
00267 DEALLOCATE(ZP_T1GMES       )
00268 DEALLOCATE(ZP_T2GMES       )
00269 DEALLOCATE(ZP_AMAX         )
00270 DEALLOCATE(ZP_QDAMAX       )
00271 DEALLOCATE(ZP_T1AMAX       )
00272 DEALLOCATE(ZP_T2AMAX       )
00273 DEALLOCATE(ZP_AH           )
00274 DEALLOCATE(ZP_BH           )
00275 DEALLOCATE(ZP_TAU_WOOD     )
00276 DEALLOCATE(ZP_INCREASE     )
00277 DEALLOCATE(ZP_TURNOVER     )
00278 DEALLOCATE(ZP_ABC          )
00279 DEALLOCATE(ZP_POI          )
00280 IF (LHOOK) CALL DR_HOOK('UNPACK_CO2_INIT',1,ZHOOK_HANDLE)
00281 !-------------------------------------------------------------------------------
00282 END SUBROUTINE UNPACK_CO2_INIT
00283 !-------------------------------------------------------------------------------
00284 !
00285 END SUBROUTINE CO2_INIT_n