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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITESURF_ISBA_n(HPROGRAM,OLAND_USE)
00003 !     #####################################
00004 !
00005 !!****  *WRITESURF_ISBA_n* - writes ISBA prognostic fields
00006 !!                        
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    01/2003 
00032 !!      P. LeMoigne 12/2004 : correct dimensionning if more than 10 layers in
00033 !!                            the soil (diffusion version)
00034 !!      B. Decharme  2008    : Floodplains
00035 !!      B. Decharme  01/2009 : Optional Arpege deep soil temperature write
00036 !!      A.L. Gibelin   03/09 : modifications for CENTURY model 
00037 !!      A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays 
00038 !!      A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
00039 !!      B. Decharme  07/2011 : land_use semi-prognostic variables
00040 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
00041 !!      B. Decharme  09/2012 : write some key for prep_read_external
00042 !!
00043 !-------------------------------------------------------------------------------
00044 !
00045 !*       0.    DECLARATIONS
00046 !              ------------
00047 !
00048 USE MODD_SURF_PAR, ONLY : NUNDEF
00049 !
00050 USE MODD_ISBA_n, ONLY :   NGROUND_LAYER, CISBA, CPHOTO, CRESPSL, CSOC, &
00051                           NNBIOMASS, NNLITTER, NNSOILCARB, NNLITTLEVS, &
00052                           XTG, XWG, XWGI, XWR, XLAI, TSNOW, XTSRAD_NAT,&
00053                           XRESA, XAN, XANFM, XLE, XANDAY, TTIME,       &
00054                           XRESP_BIOMASS, XBIOMASS, XPATCH, XDG,        &
00055                           XLITTER, XSOILCARB, XLIGNIN_STRUC, LFLOOD,   &
00056                           XZ0_FLOOD, LTEMP_ARP, NTEMPLAYER_ARP,        &
00057                           LGLACIER, XICE_STO, LSPINUPCARBS,            &
00058                           LSPINUPCARBW, NNBYEARSOLD
00059 !
00060 USE MODD_ASSIM, ONLY : LASSIM, CASSIM
00061 !
00062 USE MODD_CH_ISBA_n,    ONLY : NDSTEQ
00063 USE MODD_DST_n
00064 USE MODD_DST_SURF
00065 !
00066 USE MODI_WRITE_SURF
00067 USE MODI_WRITESURF_GR_SNOW
00068 !
00069 !
00070 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00071 USE PARKIND1  ,ONLY : JPRB
00072 !
00073 IMPLICIT NONE
00074 !
00075 !*       0.1   Declarations of arguments
00076 !              -------------------------
00077 !
00078  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00079 LOGICAL,           INTENT(IN)  :: OLAND_USE !
00080 !
00081 !*       0.2   Declarations of local variables
00082 !              -------------------------------
00083 !
00084 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00085  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00086  CHARACTER(LEN=4 ) :: YLVL
00087  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00088  CHARACTER(LEN=25) :: YFORM          ! Writing format
00089 !
00090 INTEGER :: JJ, JLAYER, JP, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS  ! loop counter on levels
00091 INTEGER :: IWORK   ! Work integer
00092 INTEGER :: JSV
00093 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00094 !
00095 !------------------------------------------------------------------------------
00096 !
00097 !*       2.     Prognostic fields:
00098 !               -----------------
00099 !
00100 IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',0,ZHOOK_HANDLE)
00101 !* soil temperatures
00102 !
00103 IF(LTEMP_ARP)THEN
00104   IWORK=NTEMPLAYER_ARP
00105 ELSE
00106   IWORK=NGROUND_LAYER
00107 ENDIF
00108 !
00109 DO JLAYER=1,IWORK
00110   WRITE(YLVL,'(I4)') JLAYER
00111   YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00112   YFORM='(A6,I1.1,A4)'
00113   IF (JLAYER >= 10)  YFORM='(A6,I2.2,A4)'
00114   WRITE(YCOMMENT,FMT=YFORM) 'X_Y_TG',JLAYER,' (K)'
00115   CALL WRITE_SURF(HPROGRAM,YRECFM,XTG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
00116 END DO
00117 !
00118 !* soil liquid water contents
00119 !
00120 DO JLAYER=1,NGROUND_LAYER
00121    WRITE(YLVL,'(I4)') JLAYER     
00122    YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00123    YFORM='(A6,I1.1,A8)'
00124    IF (JLAYER >= 10)  YFORM='(A6,I2.2,A8)'
00125    WRITE(YCOMMENT,FMT=YFORM) 'X_Y_WG',JLAYER,' (m3/m3)'
00126    CALL WRITE_SURF(HPROGRAM,YRECFM,XWG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
00127 END DO
00128 !
00129 !* soil ice water contents
00130 !
00131 DO JLAYER=1,NGROUND_LAYER
00132    WRITE(YLVL,'(I4)') JLAYER     
00133    YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00134    YFORM='(A7,I1.1,A8)'
00135    IF (JLAYER >= 10)  YFORM='(A7,I2.2,A8)'
00136    WRITE(YCOMMENT,YFORM) 'X_Y_WGI',JLAYER,' (m3/m3)'
00137    CALL WRITE_SURF(HPROGRAM,YRECFM,XWGI(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)  
00138 END DO
00139 !
00140 !* water intercepted on leaves
00141 !
00142 YRECFM='WR'
00143 YCOMMENT='X_Y_WR (kg/m2)'
00144  CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP,HCOMMENT=YCOMMENT)
00145 !
00146 !* roughness length of Flood water
00147 !
00148 IF(LFLOOD)THEN
00149   YRECFM='Z0_FLOOD'
00150   YCOMMENT='X_Y_Z0_FLOOD (-)'
00151   CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
00152 ENDIF
00153 !
00154 !* Glacier ice storage
00155 !
00156 IF(LGLACIER)THEN
00157   YRECFM='ICE_STO'
00158   YCOMMENT='X_Y_ICE_STO (kg/m2)'
00159   CALL WRITE_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP,HCOMMENT=YCOMMENT)
00160 ENDIF
00161 !
00162 !* Leaf Area Index
00163 !
00164 IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN
00165   !
00166   IF(LASSIM) THEN
00167     IF(CASSIM=='PLUS ') THEN
00168       YRECFM='LAIp'
00169     ELSEIF(CASSIM=='AVERA') THEN
00170       YRECFM='LAIa'
00171     ELSEIF(CASSIM=='2DVAR') THEN
00172       YRECFM='LAI'
00173     ENDIF
00174   ELSE
00175     YRECFM='LAI'
00176   ENDIF
00177   !
00178   YCOMMENT='X_Y_LAI (m2/m2)'
00179   CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP,HCOMMENT=YCOMMENT)
00180   !
00181 END IF
00182 !
00183 !* snow mantel
00184 !
00185  CALL WRITESURF_GR_SNOW(HPROGRAM,'VEG','     ',TSNOW)
00186 !
00187 !
00188 !* key and/or field usefull to make an external prep
00189 !
00190 YRECFM = 'GLACIER'
00191 YCOMMENT='LGLACIER key for external prep'
00192  CALL WRITE_SURF(HPROGRAM,YRECFM,LGLACIER,IRESP,HCOMMENT=YCOMMENT)
00193 !
00194 IF(CISBA=='DIF')THEN
00195 !
00196   YRECFM = 'SOC'
00197   YCOMMENT='SOC key for external prep'
00198   CALL WRITE_SURF(HPROGRAM,YRECFM,CSOC,IRESP,HCOMMENT=YCOMMENT)
00199 !
00200   IF(CSOC=='SGH')THEN
00201 !   Fraction for each patch
00202     YRECFM='PATCH'
00203     YCOMMENT='X_Y_PATCH (-) for external prep with SOC'
00204     CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)        
00205   ENDIF
00206 !
00207 ELSE
00208 !
00209   YRECFM = 'TEMPARP'
00210   YCOMMENT='LTEMP_ARP key for external prep'
00211   CALL WRITE_SURF(HPROGRAM,YRECFM,LTEMP_ARP,IRESP,HCOMMENT=YCOMMENT)
00212 !
00213   IF(LTEMP_ARP)THEN
00214     YRECFM = 'NTEMPLARP'
00215     YCOMMENT='NTEMPLAYER_ARP for external prep'
00216     CALL WRITE_SURF(HPROGRAM,YRECFM,NTEMPLAYER_ARP,IRESP,HCOMMENT=YCOMMENT)
00217   ENDIF
00218 !
00219 ENDIF
00220 !
00221 !-------------------------------------------------------------------------------
00222 !
00223 !*       4.  Semi-prognostic variables
00224 !            -------------------------
00225 !
00226 !
00227 !* patch averaged radiative temperature (K)
00228 !
00229 YRECFM='TSRAD_NAT'
00230 YCOMMENT='X_TSRAD_NAT (K)'
00231  CALL WRITE_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT)
00232 !
00233 !* aerodynamical resistance
00234 !
00235 YRECFM='RESA'
00236 YCOMMENT='X_Y_RESA (s/m)'
00237  CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP,HCOMMENT=YCOMMENT)
00238 !
00239 !* Land use variables
00240 !
00241 IF(OLAND_USE)THEN
00242 !     
00243   YRECFM='OLD_PATCH'
00244   YCOMMENT='X_Y_OLD_PATCH (-)'
00245   CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)
00246 !
00247   DO JLAYER=1,NGROUND_LAYER
00248     WRITE(YLVL,'(I4)') JLAYER
00249     YRECFM='OLD_DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00250     YFORM='(A6,I1.1,A8)'
00251     IF (JLAYER >= 10)  YFORM='(A6,I2.2,A8)'
00252     WRITE(YCOMMENT,FMT=YFORM) 'X_Y_OLD_DG',JLAYER,' (m)'
00253     CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
00254   END DO
00255 !
00256 ENDIF
00257 !
00258 !* ISBA-AGS variables
00259 !
00260 IF (CPHOTO/='NON') THEN
00261   YRECFM='AN'
00262   YCOMMENT='X_Y_AN (kgCO2/kgair m/s)'
00263   CALL WRITE_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP,HCOMMENT=YCOMMENT)
00264 !
00265   YRECFM='ANDAY'
00266   YCOMMENT='X_Y_ANDAY (kgCO2/m2/day)'
00267   CALL WRITE_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP,HCOMMENT=YCOMMENT)
00268 !
00269   YRECFM='ANFM'
00270   YCOMMENT='X_Y_ANFM (kgCO2/kgair m/s)'
00271   CALL WRITE_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP,HCOMMENT=YCOMMENT)
00272 !
00273   YRECFM='LE_AGS'
00274   YCOMMENT='X_Y_LE_AGS (W/m2)'
00275   CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP,HCOMMENT=YCOMMENT)
00276 END IF
00277 !
00278 !
00279 IF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
00280   !
00281   DO JNBIOMASS=1,NNBIOMASS
00282     WRITE(YLVL,'(I1)') JNBIOMASS
00283     YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00284     YFORM='(A11,I1.1,A10)'
00285     WRITE(YCOMMENT,FMT=YFORM) 'X_Y_BIOMASS',JNBIOMASS,' (kgDM/m2)'
00286     CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
00287   END DO
00288   !
00289   !
00290   DO JNBIOMASS=2,NNBIOMASS-2
00291     WRITE(YLVL,'(I1)') JNBIOMASS
00292     YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00293     YFORM='(A16,I1.1,A10)'
00294     WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)'
00295     CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
00296   END DO
00297   !
00298   IF (CPHOTO=='NIT') THEN
00299     !
00300     DO JNBIOMASS=NNBIOMASS-1,NNBIOMASS
00301       WRITE(YLVL,'(I1)') JNBIOMASS
00302       YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00303       YFORM='(A16,I1.1,A10)'
00304       WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)'
00305       CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
00306     END DO
00307     !
00308   ENDIF
00309   !
00310 END IF
00311 !
00312 !* Soil carbon
00313 !
00314 YRECFM = 'RESPSL'
00315 YCOMMENT=YRECFM
00316  CALL WRITE_SURF(HPROGRAM,YRECFM,CRESPSL,IRESP,HCOMMENT=YCOMMENT)
00317 !
00318 YRECFM='NLITTER'
00319 YCOMMENT=YRECFM
00320  CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTER,IRESP,HCOMMENT=YCOMMENT)
00321 !
00322 YRECFM='NLITTLEVS'
00323 YCOMMENT=YRECFM
00324  CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTLEVS,IRESP,HCOMMENT=YCOMMENT)
00325 !
00326 YRECFM='NSOILCARB'
00327 YCOMMENT=YRECFM
00328  CALL WRITE_SURF(HPROGRAM,YRECFM,NNSOILCARB,IRESP,HCOMMENT=YCOMMENT)
00329 !
00330 IF(LSPINUPCARBS.OR.LSPINUPCARBW)THEN
00331   YRECFM='NBYEARSOLD'
00332   YCOMMENT='yrs'
00333   CALL WRITE_SURF(HPROGRAM,YRECFM,NNBYEARSOLD,IRESP,HCOMMENT=YCOMMENT)
00334 ENDIF
00335 !
00336 IF (CRESPSL=='CNT') THEN
00337   !
00338   DO JNLITTER=1,NNLITTER
00339     DO JNLITTLEVS=1,NNLITTLEVS
00340       WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
00341       YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00342       YFORM='(A10,I1.1,A1,I1.1,A8)'
00343       WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LITTER',JNLITTER,' ',JNLITTLEVS,' (gC/m2)'
00344       CALL WRITE_SURF(HPROGRAM,YRECFM,XLITTER(:,JNLITTER,JNLITTLEVS,:),IRESP,HCOMMENT=YCOMMENT)
00345     END DO
00346   END DO
00347 
00348   DO JNSOILCARB=1,NNSOILCARB
00349     WRITE(YLVL,'(I4)') JNSOILCARB
00350     YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00351     YFORM='(A8,I1.1,A8)'
00352     WRITE(YCOMMENT,FMT=YFORM) 'X_Y_SOILCARB',JNSOILCARB,' (gC/m2)'
00353     CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILCARB(:,JNSOILCARB,:),IRESP,HCOMMENT=YCOMMENT)
00354   END DO
00355 !
00356   DO JNLITTLEVS=1,NNLITTLEVS
00357     WRITE(YLVL,'(I4)') JNLITTLEVS
00358     YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00359     YFORM='(A12,I1.1,A8)'
00360     WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LIGNIN_STRUC',JNLITTLEVS,' (-)'
00361     CALL WRITE_SURF(HPROGRAM,YRECFM,XLIGNIN_STRUC(:,JNLITTLEVS,:),IRESP,HCOMMENT=YCOMMENT)
00362   END DO
00363 !
00364 ENDIF
00365 !
00366 !
00367 IF (NDSTEQ > 0)THEN
00368   DO JSV = 1,NDSTMDE ! for all dust modes
00369     WRITE(YRECFM,'(A8,I3.3)')'FLX_DSTM',JSV
00370     YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
00371     CALL WRITE_SURF(HPROGRAM,YRECFM,XSFDSTM(:,JSV,:),IRESP,HCOMMENT=YCOMMENT)
00372   END DO
00373 ENDIF
00374 !
00375 !-------------------------------------------------------------------------------
00376 !
00377 !*       5.  Time
00378 !            ----
00379 !
00380 YRECFM='DTCUR'
00381 YCOMMENT='s'
00382  CALL WRITE_SURF(HPROGRAM,YRECFM,TTIME,IRESP,HCOMMENT=YCOMMENT)
00383 IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',1,ZHOOK_HANDLE)
00384 !
00385 !-------------------------------------------------------------------------------
00386 !
00387 END SUBROUTINE WRITESURF_ISBA_n