|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITESURF_TEB_GARDEN_n(HPROGRAM,HPATCH) 00003 ! ##################################### 00004 ! 00005 !!**** *WRITESURF_TEB_GARDEN_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 !! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems) 00037 !------------------------------------------------------------------------------- 00038 ! 00039 !* 0. DECLARATIONS 00040 ! ------------ 00041 USE MODD_TEB_VEG_n, ONLY : CPHOTO, CRESPSL, NNBIOMASS 00042 00043 USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, & 00044 XTG, XWG, XWGI, XWR, XLAI, TSNOW, & 00045 XRESA, XAN, XANFM, XLE, XANDAY, & 00046 XRESP_BIOMASS, XBIOMASS 00047 ! 00048 USE MODD_SURF_PAR, ONLY : NUNDEF 00049 ! 00050 USE MODI_WRITE_SURF 00051 USE MODI_WRITESURF_GR_SNOW 00052 USE MODD_DST_n 00053 USE MODD_DST_SURF 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=6), INTENT(IN) :: HPROGRAM ! program calling 00064 CHARACTER(LEN=3), INTENT(IN) :: HPATCH ! current teb patch 00065 ! 00066 !* 0.2 Declarations of local variables 00067 ! ------------------------------- 00068 ! 00069 INTEGER :: IRESP ! IRESP : return-code if a problem appears 00070 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00071 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00072 CHARACTER(LEN=14) :: YFORM ! Writing format 00073 CHARACTER(LEN=4 ) :: YLVL 00074 ! 00075 INTEGER :: JLAYER ! loop counter on soil layers 00076 ! 00077 REAL, DIMENSION(:),ALLOCATABLE :: ZWORK ! 2D array to write data in file 00078 ! 00079 INTEGER :: JNBIOMASS 00080 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00081 ! 00082 !------------------------------------------------------------------------------ 00083 ! 00084 !* 2. Prognostic fields: 00085 ! ----------------- 00086 ! 00087 IF (LHOOK) CALL DR_HOOK('WRITESURF_TEB_GARDEN_N',0,ZHOOK_HANDLE) 00088 ALLOCATE(ZWORK(SIZE(XTG,1))) 00089 !* soil temperatures 00090 ! 00091 DO JLAYER=1,NGROUND_LAYER 00092 WRITE(YLVL,'(I2)') JLAYER 00093 YRECFM=HPATCH//'GD_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00094 YRECFM=ADJUSTL(YRECFM) 00095 YFORM='(A11,I1.1,A4)' 00096 IF (JLAYER >= 10) YFORM='(A11,I2.2,A4)' 00097 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_GD_TG',JLAYER,' (K)' 00098 ZWORK=XTG(:,JLAYER) 00099 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT) 00100 END DO 00101 ! 00102 ! 00103 !* soil liquid water content 00104 ! 00105 DO JLAYER=1,NGROUND_LAYER 00106 WRITE(YLVL,'(I2)') JLAYER 00107 YRECFM=HPATCH//'GD_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00108 YRECFM=ADJUSTL(YRECFM) 00109 YFORM='(A11,I1.1,A8)' 00110 IF (JLAYER >= 10) YFORM='(A11,I2.2,A8)' 00111 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_GD_WG',JLAYER,' (m3/m3)' 00112 ZWORK=XWG(:,JLAYER) 00113 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT) 00114 END DO 00115 ! 00116 ! 00117 !* soil ice water content 00118 ! 00119 DO JLAYER=1,NGROUND_LAYER 00120 WRITE(YLVL,'(I2)') JLAYER 00121 YRECFM=HPATCH//'GD_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00122 YRECFM=ADJUSTL(YRECFM) 00123 YFORM='(A11,I1.1,A8)' 00124 IF (JLAYER >= 10) YFORM='(A11,I2.2,A8)' 00125 WRITE(YCOMMENT,YFORM) 'X_Y_GD_WGI',JLAYER,' (m3/m3)' 00126 ZWORK=XWGI(:,JLAYER) 00127 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT) 00128 END DO 00129 ! 00130 DEALLOCATE(ZWORK) 00131 ! 00132 !* water intercepted on leaves 00133 ! 00134 YRECFM=HPATCH//'GD_WR' 00135 YRECFM=ADJUSTL(YRECFM) 00136 YCOMMENT='X_Y_GD_WR (kg/m2)' 00137 CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:),IRESP,HCOMMENT=YCOMMENT) 00138 ! 00139 !* Leaf Area Index 00140 ! 00141 IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN 00142 YRECFM=HPATCH//'GD_LAI' 00143 YRECFM=ADJUSTL(YRECFM) 00144 YCOMMENT='X_Y_GD_LAI (m2/m2)' 00145 CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:),IRESP,HCOMMENT=YCOMMENT) 00146 END IF 00147 ! 00148 IF (CPHOTO=='NIT') THEN 00149 ! 00150 DO JNBIOMASS=1,NNBIOMASS 00151 WRITE(YLVL,'(I1)') JNBIOMASS 00152 YRECFM=HPATCH//'GD_BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00153 YFORM='(A11,I1.1,A8)' 00154 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_BIOMASS',JNBIOMASS,' (kg/m2)' 00155 CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS),IRESP,HCOMMENT=YCOMMENT) 00156 END DO 00157 ! 00158 ! 00159 DO JNBIOMASS=2,NNBIOMASS 00160 WRITE(YLVL,'(I1)') JNBIOMASS 00161 YRECFM=HPATCH//'GD_RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00162 YFORM='(A16,I1.1,A10)' 00163 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)' 00164 CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS),IRESP,HCOMMENT=YCOMMENT) 00165 END DO 00166 ! 00167 END IF 00168 ! 00169 !* aerodynamical resistance 00170 ! 00171 YRECFM=HPATCH//'GD_RES' 00172 YRECFM=ADJUSTL(YRECFM) 00173 YCOMMENT='X_Y_GD_RESA (s/m)' 00174 CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:),IRESP,HCOMMENT=YCOMMENT) 00175 ! 00176 !* snow mantel 00177 ! 00178 YRECFM='GD' 00179 CALL WRITESURF_GR_SNOW(HPROGRAM,YRECFM,HPATCH,TSNOW) 00180 IF (LHOOK) CALL DR_HOOK('WRITESURF_TEB_GARDEN_N',1,ZHOOK_HANDLE) 00181 ! 00182 !------------------------------------------------------------------------------- 00183 ! 00184 END SUBROUTINE WRITESURF_TEB_GARDEN_n
1.8.0
