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_WATFLUX_n(HPROGRAM)
00003 !     #################################
00004 !
00005 !!****  *WRITE_DIAG_SEB_WATFLUX_n* - writes WATFLUX diagnostics
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!          
00014 !!    REFERENCE
00015 !!    ---------
00016 !!
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      V. Masson   *Meteo France*      
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    01/2004
00025 !!      Modified    01/2006 : sea flux parameterization.
00026 !!      S.Bielli    11/2012 : write HU2M_WAT mis placed
00027 !-------------------------------------------------------------------------------
00028 !
00029 !*       0.    DECLARATIONS
00030 !              ------------
00031 !
00032 USE MODD_SURF_PAR,      ONLY : XUNDEF
00033 !
00034 USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
00035 !
00036 USE MODD_DIAG_WATFLUX_n,ONLY : N2M, LRAD_BUDGET, LSURF_BUDGET, LCOEF,    &
00037                                  LSURF_VARS,                               &
00038                                  XRN, XH, XLE, XLEI, XGFLUX,               &
00039                                  XRI, XCD, XCH, XCE, XZ0, XZ0H,            &
00040                                  XT2M, XQ2M, XHU2M, XT2M_MIN, XT2M_MAX,    &
00041                                  XZON10M, XMER10M, XQS, XDIAG_TS,          &
00042                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
00043                                  XFMU, XFMV, LSURF_BUDGETC,                &
00044                                  XRNC, XHC, XLEC, XGFLUXC, XSWDC, XSWUC,   &
00045                                  XLWDC, XLWUC, XFMUC, XFMVC, XLEIC,        &
00046                                  XHU2M_MIN, XHU2M_MAX, XWIND10M, XWIND10M_MAX  
00047 !
00048 USE MODD_WATFLUX_n,ONLY : LINTERPOL_TS
00049 !
00050 USE MODD_CH_WATFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
00051 !
00052 USE MODI_INIT_IO_SURF_n
00053 USE MODI_WRITE_SURF
00054 USE MODI_END_IO_SURF_n
00055 !
00056 !
00057 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00058 USE PARKIND1  ,ONLY : JPRB
00059 !
00060 IMPLICIT NONE
00061 !
00062 !*       0.1   Declarations of arguments
00063 !              -------------------------
00064 !
00065  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00066 !
00067 !*       0.2   Declarations of local variables
00068 !              -------------------------------
00069 !
00070 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00071  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00072  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00073  CHARACTER(LEN=2)  :: YNUM
00074 !
00075 INTEGER           :: JSV, JSW
00076 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00077 !-------------------------------------------------------------------------------
00078 !
00079 !         Initialisation for IO
00080 !
00081 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_WATFLUX_N',0,ZHOOK_HANDLE)
00082  CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','WATFLX','WRITE')
00083 !
00084 !
00085 !*       2.     Richardson number :
00086 !               -----------------
00087 !
00088 IF (N2M>=1) THEN
00089 
00090 YRECFM='RI_WAT'
00091 YCOMMENT='X_Y_'//YRECFM
00092 !
00093  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
00094 !
00095 END IF
00096 !
00097 !*       3.     Energy fluxes :
00098 !               -------------
00099 !
00100 IF (LSURF_BUDGET) THEN
00101 
00102 YRECFM='RN_WAT'
00103 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00104 !
00105  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
00106 !
00107 YRECFM='H_WAT'
00108 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00109 !
00110  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
00111 !
00112 YRECFM='LE_WAT'
00113 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00114 !
00115  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
00116 !
00117 YRECFM='LEI_WAT'
00118 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00119 !
00120  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
00121 !
00122 YRECFM='GFLUX_WAT'
00123 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00124 !
00125  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
00126 !
00127 IF (LRAD_BUDGET) THEN
00128 !       
00129    YRECFM='SWD_WAT'
00130    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00131    !
00132    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
00133    !
00134    YRECFM='SWU_WAT'
00135    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00136    !
00137    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
00138    !
00139    YRECFM='LWD_WAT'
00140    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00141    !
00142    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
00143    !
00144    YRECFM='LWU_WAT'
00145    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00146    !
00147    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
00148    !
00149    DO JSW=1, SIZE(XSWBD,2)
00150       YNUM=ACHAR(48+JSW)
00151       !
00152       YRECFM='SWD_WAT_'//YNUM
00153       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00154       !
00155       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00156       !
00157       YRECFM='SWU_WAT_'//YNUM
00158       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00159       !
00160       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00161       !
00162    ENDDO
00163 !
00164 ENDIF
00165 !
00166 YRECFM='FMU_WAT'
00167 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00168 !
00169  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
00170 YRECFM='FMV_WAT'
00171 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00172 !
00173  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
00174 !
00175 END IF
00176 !
00177 IF (LSURF_BUDGETC) THEN
00178 
00179 YRECFM='RNC_WAT'
00180 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00181 !
00182  CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:),IRESP,HCOMMENT=YCOMMENT)
00183 !
00184 YRECFM='HC_WAT'
00185 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00186 !
00187  CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:),IRESP,HCOMMENT=YCOMMENT)
00188 !
00189 YRECFM='LEC_WAT'
00190 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00191 !
00192  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:),IRESP,HCOMMENT=YCOMMENT)
00193 !
00194 YRECFM='LEIC_WAT'
00195 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00196 !
00197  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
00198 !
00199 YRECFM='GFLUXC_WAT'
00200 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00201 !
00202  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
00203 !
00204 IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
00205 !
00206    YRECFM='SWDC_WAT'
00207    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00208    !
00209    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
00210    !
00211    YRECFM='SWUC_WAT'
00212    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00213    !
00214    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
00215    !
00216    YRECFM='LWDC_WAT'
00217    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00218    !
00219    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
00220    !
00221    YRECFM='LWUC_WAT'
00222    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00223    !
00224    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWUC(:),IRESP,HCOMMENT=YCOMMENT)
00225 !
00226 ENDIF
00227 !
00228 YRECFM='FMUC_WAT'
00229 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
00230 !
00231  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
00232 !
00233 YRECFM='FMVC_WAT'
00234 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
00235 !
00236  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
00237 !
00238 END IF
00239 !
00240 !
00241 !*       4.     Transfer coefficients
00242 !               ---------------------
00243 !
00244 IF (LCOEF) THEN
00245 
00246 YRECFM='CD_WAT'
00247 YCOMMENT='X_Y_'//YRECFM
00248 !
00249  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
00250 !
00251 YRECFM='CH_WAT'
00252 YCOMMENT='X_Y_'//YRECFM
00253 !
00254  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
00255 !
00256 YRECFM='CE_WAT'
00257 YCOMMENT='X_Y_'//YRECFM
00258 !
00259  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
00260 !
00261 YRECFM='Z0_WAT'
00262 YCOMMENT='X_Y_'//YRECFM
00263 !
00264  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
00265 !
00266 YRECFM='Z0H_WAT'
00267 YCOMMENT='X_Y_'//YRECFM
00268 !
00269  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
00270 !
00271 END IF
00272 !
00273 !
00274 !*       5.     Surface humidity
00275 !               ----------------
00276 !
00277 IF (LSURF_VARS) THEN
00278 
00279 YRECFM='QS_WAT'
00280 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00281 !
00282  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
00283 !
00284 ENDIF
00285 !
00286 
00287 !
00288 !*       6.     parameters at 2 and 10 meters :
00289 !               -----------------------------
00290 !
00291 IF (N2M>=1) THEN
00292 !
00293 YRECFM='T2M_WAT'
00294 YCOMMENT='X_Y_'//YRECFM//' (K)'
00295 !
00296  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
00297 !
00298 YRECFM='T2MMIN_WAT'
00299 YCOMMENT='X_Y_'//YRECFM//' (K)'
00300 !
00301  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00302 XT2M_MIN(:)=XUNDEF
00303 !
00304 YRECFM='T2MMAX_WAT'
00305 YCOMMENT='X_Y_'//YRECFM//' (K)'
00306 !
00307  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00308 XT2M_MAX(:)=0.0
00309 !
00310 YRECFM='Q2M_WAT'
00311 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00312 !
00313  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
00314 !
00315 YRECFM='HU2M_WAT'
00316 YCOMMENT='X_Y_'//YRECFM//' (-)'
00317 !
00318  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
00319 !
00320 YRECFM='HU2MMIN_WAT'
00321 YCOMMENT='X_Y_'//YRECFM//' (-)'
00322 !
00323  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00324 XHU2M_MIN(:)=XUNDEF
00325 !
00326 YRECFM='HU2MMAX_WAT'
00327 YCOMMENT='X_Y_'//YRECFM//' (-)'
00328 !
00329  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00330 XHU2M_MAX(:)=-XUNDEF
00331 !
00332 YRECFM='ZON10M_WAT'
00333 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00334 !
00335  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
00336 !
00337 YRECFM='MER10M_WAT'
00338 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00339 !
00340  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
00341 !
00342 YRECFM='W10M_WAT'
00343 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00344 !
00345  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
00346 !
00347 YRECFM='W10MMAX_WAT'
00348 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00349 !
00350  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00351 XWIND10M_MAX(:)=0.0
00352 !
00353 END IF
00354 !
00355 !
00356 !*       7.     chemical diagnostics:
00357 !               --------------------
00358 !
00359 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
00360   DO JSV = 1,SIZE(CCH_NAMES,1)
00361     YRECFM='DV_WAT_'//TRIM(CCH_NAMES(JSV))
00362     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_WAT_',JSV
00363     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
00364   END DO
00365 ENDIF
00366 !
00367 !
00368 !*       8.     prognostic variable diagnostics:
00369 !               --------------------------------
00370 !
00371 IF(LPROVAR_TO_DIAG.OR.LINTERPOL_TS)THEN
00372 !
00373   YRECFM='TS_WATER'
00374   YCOMMENT='TS_WATER (K)'
00375   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_TS(:),IRESP,HCOMMENT=YCOMMENT)
00376 !
00377 ENDIF
00378 !
00379 !-------------------------------------------------------------------------------
00380 !
00381 !         End of IO
00382 !
00383  CALL END_IO_SURF_n(HPROGRAM)
00384 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_WATFLUX_N',1,ZHOOK_HANDLE)
00385 !
00386 !
00387 END SUBROUTINE WRITE_DIAG_SEB_WATFLUX_n