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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITESURF_PGD_ISBA_n(HPROGRAM)
00003 !     ################################################
00004 !
00005 !!****  *WRITESURF_PGD_ISBA_n* - writes ISBA physiographic 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. Le Moigne 12/2004 : add type of photosynthesis 
00033 !!      B. Decharme  06/2009 : add topographic index statistics
00034 !!      A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
00035 !!      B. Decharme  07/2011 : delete argument HWRITE
00036 !!
00037 !-------------------------------------------------------------------------------
00038 !
00039 !*       0.    DECLARATIONS
00040 !              ------------
00041 !
00042 USE MODD_SURF_ATM_n, ONLY : CNATURE
00043 USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA,&
00044                         CPEDOTF, CPHOTO, LTR_ML, XRM_PATCH,     &
00045                         XCLAY, XSAND, XSOC,                     &                          
00046                         XAOSIP, XAOSIM, XAOSJP, XAOSJM,         &
00047                         XHO2IP, XHO2IM, XHO2JP, XHO2JM,         &
00048                         XSSO_SLOPE,                             &
00049                         XRUNOFFB, XWDRAIN,                      &
00050                         XTI_MIN, XTI_MAX, XTI_MEAN, XTI_STD,    &
00051                         XTI_SKEW, XZS,XCOVER,                   &
00052                         XZ0EFFJPDIR,                            &
00053                         LCOVER, LECOCLIMAP, LCTI, LSOCP, LNOF,  &
00054                         XSOILGRID, XPH, XFERT, LPERM, XPERM
00055 !
00056 USE MODD_ISBA_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
00057 !
00058 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
00059 !
00060 USE MODI_WRITE_SURF
00061 USE MODI_WRITE_GRID
00062 USE MODI_WRITESURF_PGD_ISBA_PAR_n
00063 USE MODI_WRITESURF_PGD_TSZ0_PAR_n
00064 !
00065 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00066 USE PARKIND1  ,ONLY : JPRB
00067 !
00068 IMPLICIT NONE
00069 !
00070 !*       0.1   Declarations of arguments
00071 !              -------------------------
00072 !
00073  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00074 !
00075 !*       0.2   Declarations of local variables
00076 !              -------------------------------
00077 !
00078 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00079  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00080  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00081 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00082 !
00083 !
00084 !-------------------------------------------------------------------------------
00085 !
00086 !
00087 !* soil scheme option
00088 !
00089 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',0,ZHOOK_HANDLE)
00090 YRECFM='ISBA'
00091 YCOMMENT=YRECFM
00092  CALL WRITE_SURF(HPROGRAM,YRECFM,CISBA,IRESP,HCOMMENT=YCOMMENT)
00093 !
00094 !* Pedo-transfert function
00095 !
00096 YRECFM='PEDOTF'
00097 YCOMMENT=YRECFM
00098  CALL WRITE_SURF(HPROGRAM,YRECFM,CPEDOTF,IRESP,HCOMMENT=YCOMMENT)
00099 !
00100 !* type of photosynthesis
00101 !
00102 YRECFM='PHOTO'
00103 YCOMMENT=YRECFM
00104  CALL WRITE_SURF(HPROGRAM,YRECFM,CPHOTO,IRESP,HCOMMENT=YCOMMENT)
00105 !
00106 !* new radiative transfert
00107 !
00108 YRECFM='TR_ML'
00109 YCOMMENT=YRECFM
00110  CALL WRITE_SURF(HPROGRAM,YRECFM,LTR_ML,IRESP,HCOMMENT=YCOMMENT)
00111 !
00112 !* threshold to remove little fractions of patches
00113 !
00114 YRECFM='RM_PATCH'
00115 YCOMMENT=YRECFM
00116  CALL WRITE_SURF(HPROGRAM,YRECFM,XRM_PATCH,IRESP,HCOMMENT=YCOMMENT)
00117 
00118 !* number of soil layers
00119 !
00120 YRECFM='GROUND_LAYER'
00121 YCOMMENT=YRECFM
00122  CALL WRITE_SURF(HPROGRAM,YRECFM,NGROUND_LAYER,IRESP,HCOMMENT=YCOMMENT)
00123 !
00124 !* Reference grid for DIF
00125 !
00126 IF(CISBA=='DIF') THEN
00127   YRECFM='SOILGRID'
00128   YCOMMENT=YRECFM
00129   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILGRID,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
00130 ENDIF
00131 !
00132 !* number of biomass pools
00133 !
00134 YRECFM='NBIOMASS'
00135 YCOMMENT=YRECFM
00136  CALL WRITE_SURF(HPROGRAM,YRECFM,NNBIOMASS,IRESP,HCOMMENT=YCOMMENT)
00137 !
00138 !* number of tiles
00139 !
00140 YRECFM='PATCH_NUMBER'
00141 YCOMMENT=YRECFM
00142  CALL WRITE_SURF(HPROGRAM,YRECFM,NPATCH,IRESP,HCOMMENT=YCOMMENT)
00143 !
00144 !* flag indicating if fields are computed from ecoclimap or not
00145 !
00146 YRECFM='ECOCLIMAP'
00147 YCOMMENT=YRECFM
00148  CALL WRITE_SURF(HPROGRAM,YRECFM,LECOCLIMAP,IRESP,HCOMMENT=YCOMMENT)
00149 !
00150 !
00151 !*       2.     Physiographic data fields:
00152 !               -------------------------
00153 !
00154 !* cover classes
00155 !
00156 YRECFM='COVER_LIST'
00157 YCOMMENT='(LOGICAL LIST)'
00158  CALL WRITE_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
00159 !
00160 YCOMMENT='COVER FIELDS'
00161  CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
00162 !
00163 !* orography
00164 !
00165 YRECFM='ZS'
00166 YCOMMENT='ZS'
00167  CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
00168 !
00169 !* latitude, longitude
00170 !
00171  CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP,XZ0EFFJPDIR)
00172 !
00173 !
00174 !* clay fraction
00175 !
00176 !
00177 YRECFM='CLAY'
00178 YCOMMENT='X_Y_CLAY'
00179  CALL WRITE_SURF(HPROGRAM,YRECFM,XCLAY(:,1),IRESP,HCOMMENT=YCOMMENT)
00180 !
00181 !* sand fraction
00182 !
00183 YRECFM='SAND'
00184 YCOMMENT='X_Y_SAND'
00185  CALL WRITE_SURF(HPROGRAM,YRECFM,XSAND(:,1),IRESP,HCOMMENT=YCOMMENT)
00186 !
00187 !* soil organic carbon
00188 !
00189 YRECFM='SOCP'
00190 YCOMMENT=''
00191  CALL WRITE_SURF(HPROGRAM,YRECFM,LSOCP,IRESP,HCOMMENT=YCOMMENT)
00192 !
00193 IF(LSOCP)THEN
00194   !        
00195   YCOMMENT='X_Y_SOC'
00196   YRECFM='SOC_TOP'
00197   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,1),IRESP,HCOMMENT=YCOMMENT)
00198   YRECFM='SOC_SUB'
00199   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,2),IRESP,HCOMMENT=YCOMMENT)
00200   !
00201 ENDIF
00202 !
00203 !* permafrost distribution
00204 !
00205 YRECFM='PERMAFROST'
00206 YCOMMENT=''
00207  CALL WRITE_SURF(HPROGRAM,YRECFM,LPERM,IRESP,HCOMMENT=YCOMMENT)
00208 !
00209 IF(LPERM)THEN
00210   YCOMMENT='X_Y_PERM'
00211   YRECFM='PERM'
00212   CALL WRITE_SURF(HPROGRAM,YRECFM,XPERM(:),IRESP,HCOMMENT=YCOMMENT)
00213 ENDIF
00214 !
00215 !SOILNOX
00216 !
00217 YRECFM='NO'
00218 YCOMMENT=''
00219  CALL WRITE_SURF(HPROGRAM,YRECFM,LNOF,IRESP,HCOMMENT=YCOMMENT)
00220 !
00221 IF (LNOF) THEN
00222   !
00223   YRECFM='PH'
00224   YCOMMENT='X_Y_PH'
00225   CALL WRITE_SURF(HPROGRAM,YRECFM,XPH(:),IRESP,HCOMMENT=YCOMMENT)
00226   !
00227   YRECFM='FERT'
00228   YCOMMENT='X_Y_FERT'
00229   CALL WRITE_SURF(HPROGRAM,YRECFM,XFERT(:),IRESP,HCOMMENT=YCOMMENT)
00230   !
00231 ENDIF
00232 !
00233 !* subgrid-scale orography parameters to compute dynamical roughness length
00234 !
00235 YRECFM='AOSIP'
00236 YCOMMENT='X_Y_AOSIP'
00237  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIP,IRESP,HCOMMENT=YCOMMENT)
00238 !
00239 YRECFM='AOSIM'
00240 YCOMMENT='X_Y_AOSIM'
00241  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIM,IRESP,HCOMMENT=YCOMMENT)
00242 !
00243 YRECFM='AOSJP'
00244 YCOMMENT='X_Y_AOSJP'
00245  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJP,IRESP,HCOMMENT=YCOMMENT)
00246 !
00247 YRECFM='AOSJM'
00248 YCOMMENT='X_Y_AOSJM'
00249  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJM,IRESP,HCOMMENT=YCOMMENT)
00250 !
00251 YRECFM='HO2IP'
00252 YCOMMENT='X_Y_HO2IP'
00253  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IP,IRESP,HCOMMENT=YCOMMENT)
00254 !
00255 YRECFM='HO2IM'
00256 YCOMMENT='X_Y_HO2IM'
00257  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IM,IRESP,HCOMMENT=YCOMMENT)
00258 !
00259 YRECFM='HO2JP'
00260 YCOMMENT='X_Y_HO2JP'
00261  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JP,IRESP,HCOMMENT=YCOMMENT)
00262 !
00263 YRECFM='HO2JM'
00264 YCOMMENT='X_Y_HO2JM'
00265  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JM,IRESP,HCOMMENT=YCOMMENT)
00266 !
00267 YRECFM='SSO_SLOPE'
00268 YCOMMENT='X_Y_SSO_SLOPE (-)'
00269  CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_SLOPE,IRESP,HCOMMENT=YCOMMENT)
00270 !
00271 !* orographic runoff coefficient
00272 !
00273 YRECFM='RUNOFFB'
00274 YCOMMENT='X_Y_RUNOFFB'
00275  CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFB,IRESP,HCOMMENT=YCOMMENT)
00276 !
00277 !* subgrid drainage coefficient
00278 !
00279 YRECFM='WDRAIN'
00280 YCOMMENT='X_Y_WDRAIN'
00281  CALL WRITE_SURF(HPROGRAM,YRECFM,XWDRAIN,IRESP,HCOMMENT=YCOMMENT)
00282 !
00283 !* topographic index statistics
00284 !
00285 YRECFM='CTI'
00286 YCOMMENT=''
00287  CALL WRITE_SURF(HPROGRAM,YRECFM,LCTI,IRESP,HCOMMENT=YCOMMENT)
00288 !
00289 IF(LCTI)THEN
00290 !
00291 YRECFM='TI_MIN'
00292 YCOMMENT='X_Y_TI_MIN'
00293  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MIN,IRESP,HCOMMENT=YCOMMENT)
00294 !
00295 YRECFM='TI_MAX'
00296 YCOMMENT='X_Y_TI_MAX'
00297  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MAX,IRESP,HCOMMENT=YCOMMENT)
00298 !
00299 YRECFM='TI_MEAN'
00300 YCOMMENT='X_Y_TI_MEAN'
00301  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MEAN,IRESP,HCOMMENT=YCOMMENT)
00302 !
00303 YRECFM='TI_STD'
00304 YCOMMENT='X_Y_TI_STD'
00305  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_STD,IRESP,HCOMMENT=YCOMMENT)
00306 !
00307 YRECFM='TI_SKEW'
00308 YCOMMENT='X_Y_TI_SKEW'
00309  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_SKEW,IRESP,HCOMMENT=YCOMMENT)
00310 !
00311 ENDIF
00312 !
00313 !-------------------------------------------------------------------------------
00314  CALL WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
00315 IF (CNATURE=='TSZ0') CALL WRITESURF_PGD_TSZ0_PAR_n(HPROGRAM)
00316 !
00317 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',1,ZHOOK_HANDLE)
00318 !-------------------------------------------------------------------------------
00319 !
00320 END SUBROUTINE WRITESURF_PGD_ISBA_n