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_SEAFLUX_n(HPROGRAM)
00003 !     #################################
00004 !
00005 !!****  *WRITE_DIAG_SEB_SEAFLUX_n* - write the SEAFLUX diagnostic fields
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 !!      Modified    08/2009 : cumulated diag
00027 !-------------------------------------------------------------------------------
00028 !
00029 !*       0.    DECLARATIONS
00030 !              ------------
00031 !
00032 USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
00033 !
00034 USE MODD_SEAFLUX_n,     ONLY : LINTERPOL_SST
00035 USE MODD_SURF_PAR,      ONLY : XUNDEF
00036 USE MODD_DIAG_SEAFLUX_n,ONLY : N2M, LRAD_BUDGET, LSURF_BUDGET,           &
00037                                  LCOEF, LSURF_VARS, XDIAG_SST,             &
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,                    &
00042                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
00043                                  XFMU, XFMV, LSURF_BUDGETC,                &
00044                                  XRNC, XHC, XLEC, XLEIC, XGFLUXC, XSWDC,   &
00045                                  XSWUC, XLWDC, XLWUC, XFMUC, XFMVC,        &
00046                                  XHU2M_MIN, XHU2M_MAX, XWIND10M, XWIND10M_MAX  
00047 !                               
00048 USE MODD_CH_SEAFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
00049 !
00050 USE MODI_INIT_IO_SURF_n
00051 USE MODI_WRITE_SURF
00052 USE MODI_END_IO_SURF_n
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 !
00065 !*       0.2   Declarations of local variables
00066 !              -------------------------------
00067 !
00068 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00069  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00070  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00071  CHARACTER(LEN=2)  :: YNUM
00072 !
00073 INTEGER           :: JSV, JSW
00074 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00075 !
00076 !-------------------------------------------------------------------------------
00077 !
00078 !         Initialisation for IO
00079 !
00080 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAFLUX_N',0,ZHOOK_HANDLE)
00081  CALL INIT_IO_SURF_n(HPROGRAM,'SEA   ','SEAFLX','WRITE')
00082 !
00083 !
00084 !*       2.     Richardson number :
00085 !               -----------------
00086 !
00087 IF (N2M>=1) THEN
00088 
00089 YRECFM='RI_SEA'
00090 YCOMMENT='X_Y_'//YRECFM
00091 !
00092  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
00093 !
00094 END IF
00095 !
00096 !*       3.     Energy fluxes :
00097 !               -------------
00098 !
00099 IF (LSURF_BUDGET) THEN
00100 
00101 YRECFM='RN_SEA'
00102 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00103 !
00104  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
00105 !
00106 YRECFM='H_SEA'
00107 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00108 !
00109  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
00110 !
00111 YRECFM='LE_SEA'
00112 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00113 !
00114  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
00115 !
00116 YRECFM='LEI_SEA'
00117 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00118 !
00119  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
00120 !
00121 YRECFM='GFLUX_SEA'
00122 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00123 !
00124  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
00125 !
00126 IF (LRAD_BUDGET) THEN
00127 !
00128    YRECFM='SWD_SEA'
00129    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00130    !
00131    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
00132    !
00133    YRECFM='SWU_SEA'
00134    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00135    !
00136    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
00137    !
00138    YRECFM='LWD_SEA'
00139    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00140    !
00141    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
00142    !
00143    YRECFM='LWU_SEA'
00144    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00145    !
00146    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
00147    !
00148    DO JSW=1, SIZE(XSWBD,2)
00149       YNUM=ACHAR(48+JSW)
00150       !
00151       YRECFM='SWD_SEA_'//YNUM
00152       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00153       !
00154       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00155       !
00156       YRECFM='SWU_SEA_'//YNUM
00157       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00158       !
00159       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00160       !
00161    ENDDO
00162 !
00163 ENDIF
00164 !
00165 YRECFM='FMU_SEA'
00166 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00167 !
00168  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
00169 !
00170 YRECFM='FMV_SEA'
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_SEA'
00180 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00181 !
00182  CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:),IRESP,HCOMMENT=YCOMMENT)
00183 !
00184 YRECFM='HC_SEA'
00185 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00186 !
00187  CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:),IRESP,HCOMMENT=YCOMMENT)
00188 !
00189 YRECFM='LEC_SEA'
00190 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00191 !
00192  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:),IRESP,HCOMMENT=YCOMMENT)
00193 !
00194 YRECFM='LEIC_SEA'
00195 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00196 !
00197  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
00198 !
00199 YRECFM='GFLUXC_SEA'
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_SEA'
00207    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00208    !
00209    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
00210    !
00211    YRECFM='SWUC_SEA'
00212    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00213    !
00214    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
00215    !
00216    YRECFM='LWDC_SEA'
00217    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00218    !
00219    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
00220    !
00221    YRECFM='LWUC_SEA'
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_SEA'
00229 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
00230 !
00231  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
00232 !
00233 YRECFM='FMVC_SEA'
00234 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
00235 !
00236  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
00237 !
00238 END IF
00239 !
00240 !*       4.     transfer coefficients
00241 !               ---------------------
00242 !
00243 IF (LCOEF) THEN
00244 
00245 YRECFM='CD_SEA'
00246 YCOMMENT='X_Y_'//YRECFM//' (W/s2)'
00247 !
00248  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
00249 !
00250 YRECFM='CH_SEA'
00251 YCOMMENT='X_Y_'//YRECFM//' (W/s)'
00252 !
00253  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
00254 !
00255 YRECFM='CE_SEA'
00256 YCOMMENT='X_Y_'//YRECFM//' (W/s/K)'
00257 !
00258  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
00259 !
00260 YRECFM='Z0_SEA'
00261 YCOMMENT='X_Y_'//YRECFM//' (M)'
00262 !
00263  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
00264 !
00265 YRECFM='Z0H_SEA'
00266 YCOMMENT='X_Y_'//YRECFM//' (M)'
00267 !
00268  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
00269 !
00270 END IF
00271 !
00272 !
00273 !*       5.     Surface humidity
00274 !               ----------------
00275 !
00276 IF (LSURF_VARS) THEN
00277 
00278 YRECFM='QS_SEA'
00279 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00280 !
00281  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
00282 !
00283 ENDIF
00284 !
00285 
00286 !
00287 !*       6.     parameters at 2 and 10 meters :
00288 !               -----------------------------
00289 !
00290 IF (N2M>=1) THEN
00291 !
00292 YRECFM='T2M_SEA'
00293 YCOMMENT='X_Y_'//YRECFM//' (K)'
00294 !
00295  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
00296 !
00297 YRECFM='T2MMIN_SEA'
00298 YCOMMENT='X_Y_'//YRECFM//' (K)'
00299 !
00300  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00301 XT2M_MIN(:)=XUNDEF
00302 !
00303 YRECFM='T2MMAX_SEA'
00304 YCOMMENT='X_Y_'//YRECFM//' (K)'
00305 !
00306  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00307 XT2M_MAX(:)=0.0
00308 !
00309 YRECFM='Q2M_SEA'
00310 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00311 !
00312  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
00313 !
00314 YRECFM='HU2M_SEA'
00315 YCOMMENT='X_Y_'//YRECFM//' (-)'
00316 !
00317  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
00318 !
00319 YRECFM='HU2MMIN_SEA'
00320 YCOMMENT='X_Y_'//YRECFM//' (-)'
00321 !
00322  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00323 XHU2M_MIN(:)=XUNDEF
00324 !
00325 YRECFM='HU2MMAX_SEA'
00326 YCOMMENT='X_Y_'//YRECFM//' (-)'
00327 !
00328  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00329 XHU2M_MAX(:)=-XUNDEF
00330 !
00331 YRECFM='ZON10M_SEA'
00332 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00333 !
00334  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
00335 !
00336 YRECFM='MER10M_SEA'
00337 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00338 !
00339  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
00340 !
00341 YRECFM='W10M_SEA'
00342 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00343 !
00344  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
00345 !
00346 YRECFM='W10MMAX_SEA'
00347 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00348 !
00349  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00350 XWIND10M_MAX(:)=0.0
00351 !
00352 END IF
00353 !
00354 !
00355 !*       7.     chemical diagnostics:
00356 !               --------------------
00357 !
00358 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
00359   DO JSV = 1,SIZE(CCH_NAMES,1)
00360     YRECFM='DV_SEA_'//TRIM(CCH_NAMES(JSV))
00361     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_SEA_',JSV
00362     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
00363   END DO
00364 ENDIF
00365 !
00366 !
00367 !*       8.     prognostic variable diagnostics:
00368 !               --------------------------------
00369 !
00370 IF(LPROVAR_TO_DIAG.OR.LINTERPOL_SST)THEN
00371 !
00372   YRECFM='SST'
00373   YCOMMENT='SST'
00374   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_SST(:),IRESP,HCOMMENT=YCOMMENT)
00375 !
00376 ENDIF
00377 !
00378 !------------------------------------------------------------------------------
00379 !
00380 !         End of IO
00381 !
00382  CALL END_IO_SURF_n(HPROGRAM)
00383 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAFLUX_N',1,ZHOOK_HANDLE)
00384 !
00385 !
00386 END SUBROUTINE WRITE_DIAG_SEB_SEAFLUX_n