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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITE_DIAG_PGD_GRDN_n(HPROGRAM)
00003 !     #########################################
00004 !
00005 !!****  *WRITE_DIAG_PGD_TEB_GARDEN_n* - writes the ISBA physiographic diagnostic fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      V. Masson   *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    01/2004 
00031 !!      Modified    10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
00032 !!      Modified    11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 USE MODD_SURF_PAR,       ONLY : XUNDEF
00039 USE MODD_TEB_VEG_n,      ONLY : CPHOTO, CHORT
00040 USE MODD_TEB_GARDEN_n,   ONLY : XLAI, XVEG, XZ0,XALBNIR_SOIL,XALBVIS_SOIL,XALBUV_SOIL,&
00041                                 XRSMIN, XGAMMA, XRGL, XCV, XEMIS, XDG, XWRMAX_CF,     &
00042                                 XVEGTYPE, XALBNIR, XALBVIS, XALBUV, XD_ICE  
00043 !
00044 USE MODD_DIAG_MISC_TEB_n,ONLY : LSURF_DIAG_ALBEDO
00045 !
00046 USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
00047 !
00048 USE MODI_INIT_IO_SURF_n
00049 USE MODI_WRITE_SURF
00050 USE MODI_END_IO_SURF_n
00051 !
00052 !
00053 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00054 USE PARKIND1  ,ONLY : JPRB
00055 !
00056 IMPLICIT NONE
00057 !
00058 !*       0.1   Declarations of arguments
00059 !              -------------------------
00060 !
00061  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00062 !
00063 !*       0.2   Declarations of local variables
00064 !              -------------------------------
00065 !
00066 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00067  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00068  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00069  CHARACTER(LEN=2)  :: YLVLV, YPAS
00070 !
00071 INTEGER           :: JL, JP
00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00073 !-------------------------------------------------------------------------------
00074 !
00075 !         Initialisation for IO
00076 !
00077 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_GRDN_N',0,ZHOOK_HANDLE)
00078  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','WRITE')
00079 !
00080 !* Leaf Area Index
00081 !
00082 IF (CPHOTO=='NON' .OR. CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
00083   !
00084   YRECFM='GD_LAI'
00085   YCOMMENT='leaf area index (-)'
00086   !
00087   CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:),IRESP,HCOMMENT=YCOMMENT)
00088   !
00089 ENDIF
00090 !
00091 !-------------------------------------------------------------------------------
00092 !
00093 !* Vegetation fraction
00094 !
00095 YRECFM='GD_VEG'
00096 YCOMMENT='vegetation fraction (-)'
00097 !
00098  CALL WRITE_SURF(HPROGRAM,YRECFM,XVEG(:),IRESP,HCOMMENT=YCOMMENT)
00099 !
00100 !* Surface roughness length (without snow)
00101 !
00102 YRECFM='GD_Z0VEG'
00103 YCOMMENT='surface roughness length (without snow) (M)'
00104 !
00105  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
00106 !
00107 !-------------------------------------------------------------------------------
00108 !
00109 !* Soil depth for each patch
00110 !
00111 DO JL=1,SIZE(XDG,2)
00112   WRITE(YRECFM,FMT='(A4,I1)') 'GD_DG',JL
00113   YCOMMENT='soil depth'//' (M)'
00114   CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JL),IRESP,HCOMMENT=YCOMMENT)
00115 END DO
00116 !
00117 !-------------------------------------------------------------------------------
00118 ! For Earth System Model
00119 IF(LFANOCOMPACT.AND..NOT.LPREP)THEN
00120    CALL END_IO_SURF_n(HPROGRAM)
00121    IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_GRDN_N',1,ZHOOK_HANDLE)
00122    RETURN
00123 ENDIF
00124 !
00125 !-------------------------------------------------------------------------------
00126 !
00127 !* Runoff soil ice depth for each patch
00128 !
00129 IF(CHORT=='SGH')THEN
00130   YRECFM='GD_DICE'
00131   YCOMMENT='soil ice depth for runoff (m)'
00132   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_ICE(:),IRESP,HCOMMENT=YCOMMENT)
00133 ENDIF
00134 !
00135 !-------------------------------------------------------------------------------
00136 !
00137 !* Fraction of each vegetation type for each patch
00138 !
00139 DO JL=1,SIZE(XVEGTYPE,2)
00140   WRITE(YPAS,'(I2)') JL 
00141   YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
00142   WRITE(YRECFM,FMT='(A12)') 'GD_VEGTY_P'//YLVLV
00143   YCOMMENT='fraction of each vegetation type '//' (-)'
00144   CALL WRITE_SURF(HPROGRAM,YRECFM,XVEGTYPE(:,JL),IRESP,HCOMMENT=YCOMMENT)
00145 END DO
00146 !-------------------------------------------------------------------------------
00147 !
00148 !* other surface parameters
00149 !
00150 YRECFM='GD_RSMIN'
00151 YCOMMENT='minimum stomatal resistance (SM-1)'
00152  CALL WRITE_SURF(HPROGRAM,YRECFM,XRSMIN(:),IRESP,HCOMMENT=YCOMMENT)
00153 !
00154 YRECFM='GD_GAMMA'
00155 YCOMMENT='coefficient for RSMIN calculation (-)'
00156  CALL WRITE_SURF(HPROGRAM,YRECFM,XGAMMA(:),IRESP,HCOMMENT=YCOMMENT)
00157 !
00158 YRECFM='GD_CV'
00159 YCOMMENT='vegetation thermal inertia coefficient (-)'
00160  CALL WRITE_SURF(HPROGRAM,YRECFM,XCV(:),IRESP,HCOMMENT=YCOMMENT)
00161 !
00162 YRECFM='GD_RGL'
00163 YCOMMENT='maximum solar radiation usable in photosynthesis (-)'
00164  CALL WRITE_SURF(HPROGRAM,YRECFM,XRGL(:),IRESP,HCOMMENT=YCOMMENT)
00165 !
00166 YRECFM='GD_EMIS_ISBA'
00167 YCOMMENT='surface emissivity (-)'
00168  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS(:),IRESP,HCOMMENT=YCOMMENT)
00169 !
00170 YRECFM='GD_WRMAX_CF'
00171 YCOMMENT='coefficient for maximum water interception (-)'
00172  CALL WRITE_SURF(HPROGRAM,YRECFM,XWRMAX_CF(:),IRESP,HCOMMENT=YCOMMENT)
00173 !
00174 !-------------------------------------------------------------------------------
00175 !
00176 IF (LSURF_DIAG_ALBEDO) THEN
00177 !
00178 !* Soil albedos
00179 !
00180 !
00181    YRECFM='GD_ALBNIR_S'
00182    YCOMMENT='soil near-infra-red albedo (-)'
00183    CALL WRITE_SURF(HPROGRAM,YRECFM,XALBNIR_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
00184 !
00185 !-------------------------------------------------------------------------------
00186 !
00187    YRECFM='GD_ALBVIS_S'
00188    YCOMMENT='soil visible albedo (-)'
00189    CALL WRITE_SURF(HPROGRAM,YRECFM,XALBVIS_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
00190 !
00191 !-------------------------------------------------------------------------------
00192 !
00193    YRECFM='GD_ALBUV_S'
00194    YCOMMENT='soil UV albedo (-)'
00195    CALL WRITE_SURF(HPROGRAM,YRECFM,XALBUV_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
00196 !
00197 !-------------------------------------------------------------------------------
00198 !
00199 !* albedos
00200 !
00201    YRECFM='GD_ALBNIR_T'
00202    YCOMMENT='total near-infra-red albedo (-)'
00203    CALL WRITE_SURF(HPROGRAM,YRECFM,XALBNIR(:),IRESP,HCOMMENT=YCOMMENT)
00204 !
00205 !-------------------------------------------------------------------------------
00206 !
00207    YRECFM='GD_ALBVIS_T'
00208    YCOMMENT='total visible albedo (-)'
00209    CALL WRITE_SURF(HPROGRAM,YRECFM,XALBVIS(:),IRESP,HCOMMENT=YCOMMENT)
00210 !
00211 !-------------------------------------------------------------------------------
00212 !
00213    YRECFM='GD_ALBUV_T'
00214    YCOMMENT='total UV albedo (-)'
00215    CALL WRITE_SURF(HPROGRAM,YRECFM,XALBUV(:),IRESP,HCOMMENT=YCOMMENT)
00216 !
00217 END IF
00218 !
00219 !-------------------------------------------------------------------------------
00220 !
00221 !         End of IO
00222 !
00223  CALL END_IO_SURF_n(HPROGRAM)
00224 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_GRDN_N',1,ZHOOK_HANDLE)
00225 !
00226 !
00227 END SUBROUTINE WRITE_DIAG_PGD_GRDN_n