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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITE_DIAG_SEB_TEB_n(HPROGRAM)
00003 !     #################################
00004 !
00005 !!****  *WRITE_DIAG_SEB_TEB_n* - writes TEB diagnostics
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!          
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!
00018 !!
00019 !!    AUTHOR
00020 !!    ------
00021 !!      V. Masson   *Meteo France*      
00022 !!
00023 !!    MODIFICATIONS
00024 !!    -------------
00025 !!      Original    01/2004
00026 !!      Modified    01/2006 : TEB flux parameterization.
00027 !-------------------------------------------------------------------------------
00028 !
00029 !*       0.    DECLARATIONS
00030 !              ------------
00031 !
00032 USE MODD_DIAG_TEB_n,ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET,          &
00033                              LCOEF, LSURF_VARS,                       &
00034                              XRN, XH, XLE, XGFLUX,                    &
00035                              XRI, XCD, XCH, XCE, XZ0, XZ0H,           &
00036                              XT2M, XQ2M, XHU2M,                       &
00037                              XZON10M, XMER10M, XSFCO2, XQS,           &
00038                              XSWD, XSWU, XSWBD, XSWBU,                &
00039                              XLWD, XLWU, XFMU, XFMV  
00040 USE MODD_DIAG_UTCI_TEB_n, ONLY : LUTCI, XUTCI_IN, XUTCI_OUTSUN,       &
00041                                  XUTCI_OUTSHADE, XTRAD_SUN, XTRAD_SHADE
00042                            
00043 USE MODD_CH_TEB_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ 
00044 !
00045 USE MODI_INIT_IO_SURF_n
00046 USE MODI_WRITE_SURF
00047 USE MODI_END_IO_SURF_n
00048 !
00049 !
00050 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00051 USE PARKIND1  ,ONLY : JPRB
00052 !
00053 IMPLICIT NONE
00054 !
00055 !*       0.1   Declarations of arguments
00056 !              -------------------------
00057 !
00058  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00059 !
00060 !*       0.2   Declarations of local variables
00061 !              -------------------------------
00062 !
00063 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00064  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00065  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00066  CHARACTER(LEN=2)  :: YNUM
00067 !
00068 INTEGER           :: JSV, JSW
00069 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00070 !-------------------------------------------------------------------------------
00071 !
00072 !         Initialisation for IO
00073 !
00074 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_TEB_N',0,ZHOOK_HANDLE)
00075  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','WRITE')
00076 !
00077 !
00078 !
00079 !*       2.     Richardson number :
00080 !               -----------------
00081 !
00082 IF (N2M>=1) THEN
00083 
00084 YRECFM='RI_TEB'
00085 YCOMMENT='X_Y_'//YRECFM
00086 !
00087  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
00088 !
00089 END IF
00090 !
00091 !*       3.     Energy fluxes :
00092 !               -------------
00093 !
00094 IF (LSURF_BUDGET) THEN
00095 
00096 YRECFM='RN_TEB'
00097 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00098 !
00099  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
00100 !
00101 YRECFM='H_TEB'
00102 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00103 !
00104  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
00105 !
00106 YRECFM='LE_TEB'
00107 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00108 !
00109  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
00110 !
00111 YRECFM='GFLUX_TEB'
00112 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00113 !
00114  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
00115 !
00116 IF (LRAD_BUDGET) THEN
00117 !        
00118    YRECFM='SWD_TEB'
00119    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00120    !
00121    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
00122    !
00123    YRECFM='SWU_TEB'
00124    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00125    !
00126    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
00127    !
00128    YRECFM='LWD_TEB'
00129    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00130    !
00131    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
00132    !
00133    YRECFM='LWU_TEB'
00134    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00135    !
00136    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
00137    !
00138    DO JSW=1, SIZE(XSWBD,2)
00139       YNUM=ACHAR(48+JSW)
00140       !
00141       YRECFM='SWD_TEB_'//YNUM
00142       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00143       !
00144       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00145       !
00146       YRECFM='SWU_TEB_'//YNUM
00147       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00148       !
00149       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00150       !
00151    ENDDO
00152 !
00153 ENDIF
00154 !
00155 YRECFM='FMU_TEB'
00156 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00157 !
00158  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
00159 !
00160 YRECFM='FMV_TEB'
00161 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00162 !
00163  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
00164 !
00165 END IF
00166 !
00167 !
00168 !
00169 !*       4.     Transfer coefficients
00170 !               ---------------------
00171 !
00172 IF (LCOEF) THEN
00173 
00174 YRECFM='CD_TEB'
00175 YCOMMENT='X_Y_'//YRECFM
00176 !
00177  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
00178 !
00179 YRECFM='CH_TEB'
00180 YCOMMENT='X_Y_'//YRECFM
00181 !
00182  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
00183 !
00184 YRECFM='CE_TEB'
00185 YCOMMENT='X_Y_'//YRECFM
00186 !
00187  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
00188 !
00189 YRECFM='Z0_TEB'
00190 YCOMMENT='X_Y_'//YRECFM//' (M)'
00191 !
00192  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
00193 !
00194 YRECFM='Z0H_TEB'
00195 YCOMMENT='X_Y_'//YRECFM//' (M)'
00196 !
00197  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
00198 !
00199 ENDIF
00200 !
00201 !
00202 !*       5.     Surface humidity
00203 !               ----------------
00204 !
00205 IF (LSURF_VARS) THEN
00206 
00207 YRECFM='QS_TEB'
00208 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00209 !
00210  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
00211 !
00212 ENDIF
00213 
00214 !
00215 !*       5.     parameters at 2 and 10 meters :
00216 !               -----------------------------
00217 !
00218 IF (N2M>=1) THEN
00219 
00220 YRECFM='T2M_TEB'
00221 YCOMMENT='X_Y_'//YRECFM//' (K)'
00222 !
00223  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
00224 !
00225 YRECFM='Q2M_TEB'
00226 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00227 !
00228  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
00229 !
00230 YRECFM='HU2M_TEB'
00231 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00232 !
00233  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
00234 !
00235 YRECFM='ZON10M_TEB'
00236 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00237 !
00238  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
00239 !
00240 YRECFM='MER10M_TEB'
00241 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00242 !
00243  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
00244 !
00245 YRECFM='SFCO2_TEB'
00246 YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
00247 !
00248  CALL WRITE_SURF(HPROGRAM,YRECFM,XSFCO2(:),IRESP,HCOMMENT=YCOMMENT)
00249 !
00250 END IF
00251 !
00252 IF (LUTCI .AND. N2M >0) THEN
00253   YRECFM='UTCI_IN'
00254   YCOMMENT='UTCI for person indoor'//' (°C)'
00255   CALL WRITE_SURF(HPROGRAM,YRECFM,XUTCI_IN(:),IRESP,HCOMMENT=YCOMMENT)
00256   !
00257   YRECFM='UTCI_OUTSUN'
00258   YCOMMENT='UTCI for person at sun'//' (°C)'
00259   CALL WRITE_SURF(HPROGRAM,YRECFM,XUTCI_OUTSUN(:),IRESP,HCOMMENT=YCOMMENT)
00260   !
00261   YRECFM='UTCI_OUTSHAD'
00262   YCOMMENT='UTCI for person in shade'//' (°C)'
00263   CALL WRITE_SURF(HPROGRAM,YRECFM,XUTCI_OUTSHADE(:),IRESP,HCOMMENT=YCOMMENT)
00264   !
00265   YRECFM='TRAD_SUN'
00266   YCOMMENT='Mean radiant temperature seen by person at sun'//' (K)'
00267   CALL WRITE_SURF(HPROGRAM,YRECFM,XTRAD_SUN(:),IRESP,HCOMMENT=YCOMMENT)
00268   !
00269   YRECFM='TRAD_SHADE'
00270   YCOMMENT='Mean radiant temperature seen by person in shade'//' (K)'
00271   CALL WRITE_SURF(HPROGRAM,YRECFM,XTRAD_SHADE(:),IRESP,HCOMMENT=YCOMMENT)
00272 END IF
00273 !
00274 !
00275 !*       6.     chemical diagnostics:
00276 !               --------------------
00277 !
00278 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
00279   DO JSV = 1,SIZE(CCH_NAMES,1)
00280     YRECFM='DV_TWN_'//TRIM(CCH_NAMES(JSV))
00281     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_TWN_',JSV
00282     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
00283   END DO
00284 ENDIF
00285 !-------------------------------------------------------------------------------
00286 !
00287 !         End of IO
00288 !
00289  CALL END_IO_SURF_n(HPROGRAM)
00290 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_TEB_N',1,ZHOOK_HANDLE)
00291 !
00292 !
00293 END SUBROUTINE WRITE_DIAG_SEB_TEB_n