|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE WRITESURF_TEB_GREENROOF_n(HPROGRAM,HPATCH) 00003 ! ##################################### 00004 ! 00005 !!**** *WRITESURF_TEB_GREENROOF_n* - writes ISBA prognostic fields 00006 !! 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! Based on "writesurf_teb_gardenn" 00015 !! 00016 !! EXTERNAL 00017 !! -------- 00018 !! 00019 !! 00020 !! IMPLICIT ARGUMENTS 00021 !! ------------------ 00022 !! 00023 !! REFERENCE 00024 !! --------- 00025 !! 00026 !! 00027 !! AUTHOR 00028 !! ------ 00029 !! A. Lemonsu & C. de Munck 00030 !! 00031 !! MODIFICATIONS 00032 !! ------------- 00033 !! Original 07/2011 00034 !------------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATIONS 00037 ! ------------ 00038 ! 00039 USE MODD_TEB_VEG_n, ONLY : CPHOTO,CRESPSL, NNBIOMASS 00040 USE MODD_TEB_GREENROOF_n, ONLY : NLAYER_GR, & 00041 XTG, XWG, XWGI, XWR, XTDEEP, XLAI, & 00042 TSNOW, & 00043 XRESA, XAN, XANFM, XLE, XANDAY, & 00044 XRESP_BIOMASS, XBIOMASS 00045 ! 00046 USE MODD_DIAG_TEB_GREENROOF_n, ONLY : XDRAIN,XRUNOFF 00047 ! 00048 USE MODI_WRITE_SURF 00049 USE MODI_WRITESURF_GR_SNOW 00050 USE MODD_DST_n 00051 USE MODD_DST_SURF 00052 ! 00053 ! 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=30) :: 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 :: IWORK ! Work integer 00080 ! 00081 INTEGER :: JSV, JNBIOMASS 00082 ! 00083 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00084 ! 00085 !------------------------------------------------------------------------------ 00086 ! 00087 !* 2. Prognostic fields: 00088 ! ----------------- 00089 ! 00090 IF (LHOOK) CALL DR_HOOK('WRITESURF_TEB_GREENROOF_N',0,ZHOOK_HANDLE) 00091 ALLOCATE(ZWORK(SIZE(XTG,1))) 00092 ! 00093 ! 00094 !* soil temperatures 00095 ! 00096 IWORK=NLAYER_GR 00097 ! 00098 DO JLAYER=1,IWORK 00099 WRITE(YLVL,'(I2)') JLAYER 00100 YRECFM=HPATCH//'GR_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00101 YRECFM=ADJUSTL(YRECFM) 00102 YFORM='(A13,I1.1,A4)' 00103 IF (JLAYER >= 10) YFORM='(A13,I2.2,A4)' 00104 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_TWN_TG_GR',JLAYER,' (K)' 00105 ZWORK=XTG(:,JLAYER) 00106 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT) 00107 END DO 00108 ! 00109 !* soil liquid water content 00110 ! 00111 DO JLAYER=1,NLAYER_GR 00112 WRITE(YLVL,'(I2)') JLAYER 00113 YRECFM=HPATCH//'GR_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00114 YRECFM=ADJUSTL(YRECFM) 00115 YFORM='(A13,I1.1,A8)' 00116 IF (JLAYER >= 10) YFORM='(A13,I2.2,A8)' 00117 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_TWN_WG_GR',JLAYER,' (m3/m3)' 00118 ZWORK=XWG(:,JLAYER) 00119 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT) 00120 END DO 00121 ! 00122 ! 00123 !* soil ice water content 00124 ! 00125 DO JLAYER=1,NLAYER_GR 00126 WRITE(YLVL,'(I2)') JLAYER 00127 YRECFM=HPATCH//'GR_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00128 YRECFM=ADJUSTL(YRECFM) 00129 YFORM='(A14,I1.1,A8)' 00130 IF (JLAYER >= 10) YFORM='(A14,I2.2,A8)' 00131 WRITE(YCOMMENT,YFORM) 'X_Y_GR_WGI',JLAYER,' (m3/m3)' 00132 ZWORK=XWGI(:,JLAYER) 00133 CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT) 00134 END DO 00135 ! 00136 DEALLOCATE(ZWORK) 00137 ! 00138 !* water intercepted on leaves 00139 ! 00140 YRECFM=HPATCH//'GR_WR' 00141 YRECFM=ADJUSTL(YRECFM) 00142 YCOMMENT='X_Y_TWN_WR_GR (kg/m2)' 00143 CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:),IRESP,HCOMMENT=YCOMMENT) 00144 ! 00145 !* Leaf Area Index 00146 ! 00147 IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN 00148 YRECFM=HPATCH//'GR_LAI' 00149 YRECFM=ADJUSTL(YRECFM) 00150 YCOMMENT='X_Y_GR_LAI (m2/m2)' 00151 CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:),IRESP,HCOMMENT=YCOMMENT) 00152 END IF 00153 ! 00154 ! 00155 !* biomass 00156 ! 00157 IF (CPHOTO=='NIT') THEN 00158 DO JNBIOMASS=1,NNBIOMASS 00159 WRITE(YLVL,'(I1)') JNBIOMASS 00160 YRECFM=HPATCH//'GR_BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00161 YFORM='(A11,I1.1,A8)' 00162 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_BIOMASS',JNBIOMASS,' (kg/m2)' 00163 CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS),IRESP,HCOMMENT=YCOMMENT) 00164 END DO 00165 ! 00166 ! 00167 DO JNBIOMASS=2,NNBIOMASS 00168 WRITE(YLVL,'(I1)') JNBIOMASS 00169 YRECFM=HPATCH//'GR_RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00170 YFORM='(A16,I1.1,A10)' 00171 WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)' 00172 CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS),IRESP,HCOMMENT=YCOMMENT) 00173 END DO 00174 END IF 00175 ! 00176 !* aerodynamical resistance 00177 ! 00178 ! 00179 YRECFM=HPATCH//'GR_RESA' 00180 YRECFM=ADJUSTL(YRECFM) 00181 YCOMMENT='X_Y_GR_RESA (s/m)' 00182 CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:),IRESP,HCOMMENT=YCOMMENT) 00183 ! 00184 !* snow mantel 00185 ! 00186 YRECFM='GR' 00187 CALL WRITESURF_GR_SNOW(HPROGRAM,YRECFM,HPATCH,TSNOW) 00188 ! 00189 IF (LHOOK) CALL DR_HOOK('WRITESURF_TEB_GREENROOF_N',1,ZHOOK_HANDLE) 00190 ! 00191 !------------------------------------------------------------------------------- 00192 ! 00193 END SUBROUTINE WRITESURF_TEB_GREENROOF_n
1.8.0
