src/SURFEX/write_diag_seb_seafluxn.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 !     #########
   6       SUBROUTINE WRITE_DIAG_SEB_SEAFLUX_n(HPROGRAM)
   7 !     #################################
   8 !
   9 !!****  *WRITE_DIAG_SEB_SEAFLUX_n* - write the SEAFLUX diagnostic fields
  10 !!
  11 !!    PURPOSE
  12 !!    -------
  13 !!
  14 !!
  15 !!**  METHOD
  16 !!    ------
  17 !!
  18 !!    REFERENCE
  19 !!    ---------
  20 !!
  21 !!
  22 !!    AUTHOR
  23 !!    ------
  24 !!      V. Masson   *Meteo France*
  25 !!
  26 !!    MODIFICATIONS
  27 !!    -------------
  28 !!      Original    01/2004
  29 !!      Modified    01/2006 : sea flux parameterization.
  30 !!      Modified    08/2009 : cumulated diag
  31 !-------------------------------------------------------------------------------
  32 !
  33 !*       0.    DECLARATIONS
  34 !              ------------
  35 !
  36 USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
  37 !
  38 USE MODD_SEAFLUX_n,     ONLY : LINTERPOL_SST
  39 USE MODD_SURF_PAR,      ONLY : XUNDEF
  40 USE MODD_DIAG_SEAFLUX_n,ONLY : N2M, LRAD_BUDGET, LSURF_BUDGET,           &
  41                                  LCOEF, LSURF_VARS, XDIAG_SST,             &
  42                                  XRN, XH, XLE, XLEI, XGFLUX,               &
  43                                  XRI, XCD, XCH, XCE, XZ0, XZ0H,            &
  44                                  XT2M, XQ2M, XHU2M, XT2M_MIN, XT2M_MAX,    &
  45                                  XZON10M, XMER10M, XQS,                    &
  46                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
  47                                  XFMU, XFMV, LSURF_BUDGETC,                &
  48                                  XRNC, XHC, XLEC, XLEIC, XGFLUXC, XSWDC,   &
  49                                  XSWUC, XLWDC, XLWUC, XFMUC, XFMVC,        &
  50                                  XHU2M_MIN, XHU2M_MAX, XWIND10M, XWIND10M_MAX
  51 !
  52 USE MODD_CH_SEAFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
  53 !
  54 USE MODI_INIT_IO_SURF_n
  55 USE MODI_WRITE_SURF
  56 USE MODI_END_IO_SURF_n
  57 !
  58 !
  59 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  60 USE PARKIND1  ,ONLY : JPRB
  61 !
  62 IMPLICIT NONE
  63 !
  64 !*       0.1   Declarations of arguments
  65 !              -------------------------
  66 !
  67  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
  68 !
  69 !*       0.2   Declarations of local variables
  70 !              -------------------------------
  71 !
  72 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
  73  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
  74  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
  75  CHARACTER(LEN=2)  :: YNUM
  76 !
  77 INTEGER           :: JSV, JSW
  78 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  79 !
  80 !-------------------------------------------------------------------------------
  81 !
  82 !         Initialisation for IO
  83 !
  84 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAFLUX_N',0,ZHOOK_HANDLE)
  85  CALL INIT_IO_SURF_n(HPROGRAM,'SEA   ','SEAFLX','WRITE')
  86 !
  87 !
  88 !*       2.     Richardson number :
  89 !               -----------------
  90 !
  91 IF (N2M>=1) THEN
  92
  93 YRECFM='RI_SEA'
  94 YCOMMENT='X_Y_'//YRECFM
  95 !
  96  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
  97 !
  98 END IF
  99 !
 100 !*       3.     Energy fluxes :
 101 !               -------------
 102 !
 103 IF (LSURF_BUDGET) THEN
 104
 105 YRECFM='RN_SEA'
 106 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 107 !
 108  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
 109 !
 110 YRECFM='H_SEA'
 111 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 112 !
 113  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
 114 !
 115 YRECFM='LE_SEA'
 116 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 117 !
 118  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
 119 !
 120 YRECFM='LEI_SEA'
 121 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 122 !
 123  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
 124 !
 125 YRECFM='GFLUX_SEA'
 126 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 127 !
 128  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
 129 !
 130 IF (LRAD_BUDGET) THEN
 131 !
 132    YRECFM='SWD_SEA'
 133    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 134    !
 135    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
 136    !
 137    YRECFM='SWU_SEA'
 138    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 139    !
 140    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
 141    !
 142    YRECFM='LWD_SEA'
 143    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 144    !
 145    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
 146    !
 147    YRECFM='LWU_SEA'
 148    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 149    !
 150    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
 151    !
 152    DO JSW=1, SIZE(XSWBD,2)
 153       YNUM=ACHAR(48+JSW)
 154       !
 155       YRECFM='SWD_SEA_'//YNUM
 156       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 157       !
 158       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
 159       !
 160       YRECFM='SWU_SEA_'//YNUM
 161       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
 162       !
 163       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
 164       !
 165    ENDDO
 166 !
 167 ENDIF
 168 !
 169 YRECFM='FMU_SEA'
 170 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
 171 !
 172  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
 173 !
 174 YRECFM='FMV_SEA'
 175 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
 176 !
 177  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
 178 !
 179 END IF
 180 !
 181 IF (LSURF_BUDGETC) THEN
 182
 183 YRECFM='RNC_SEA'
 184 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 185 !
 186  CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:),IRESP,HCOMMENT=YCOMMENT)
 187 !
 188 YRECFM='HC_SEA'
 189 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 190 !
 191  CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:),IRESP,HCOMMENT=YCOMMENT)
 192 !
 193 YRECFM='LEC_SEA'
 194 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 195 !
 196  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:),IRESP,HCOMMENT=YCOMMENT)
 197 !
 198 YRECFM='LEIC_SEA'
 199 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 200 !
 201  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
 202 !
 203 YRECFM='GFLUXC_SEA'
 204 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 205 !
 206  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
 207 !
 208 IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
 209 !
 210    YRECFM='SWDC_SEA'
 211    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 212    !
 213    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
 214    !
 215    YRECFM='SWUC_SEA'
 216    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 217    !
 218    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
 219    !
 220    YRECFM='LWDC_SEA'
 221    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 222    !
 223    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
 224    !
 225    YRECFM='LWUC_SEA'
 226    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
 227    !
 228    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWUC(:),IRESP,HCOMMENT=YCOMMENT)
 229 !
 230 ENDIF
 231 !
 232 YRECFM='FMUC_SEA'
 233 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
 234 !
 235  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
 236 !
 237 YRECFM='FMVC_SEA'
 238 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
 239 !
 240  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
 241 !
 242 END IF
 243 !
 244 !*       4.     transfer coefficients
 245 !               ---------------------
 246 !
 247 IF (LCOEF) THEN
 248
 249 YRECFM='CD_SEA'
 250 YCOMMENT='X_Y_'//YRECFM//' (W/s2)'
 251 !
 252  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
 253 !
 254 YRECFM='CH_SEA'
 255 YCOMMENT='X_Y_'//YRECFM//' (W/s)'
 256 !
 257  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
 258 !
 259 YRECFM='CE_SEA'
 260 YCOMMENT='X_Y_'//YRECFM//' (W/s/K)'
 261 !
 262  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
 263 !
 264 YRECFM='Z0_SEA'
 265 YCOMMENT='X_Y_'//YRECFM//' (M)'
 266 !
 267  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
 268 !
 269 YRECFM='Z0H_SEA'
 270 YCOMMENT='X_Y_'//YRECFM//' (M)'
 271 !
 272  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
 273 !
 274 END IF
 275 !
 276 !
 277 !*       5.     Surface humidity
 278 !               ----------------
 279 !
 280 IF (LSURF_VARS) THEN
 281
 282 YRECFM='QS_SEA'
 283 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
 284 !
 285  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
 286 !
 287 ENDIF
 288 !
 289
 290 !
 291 !*       6.     parameters at 2 and 10 meters :
 292 !               -----------------------------
 293 !
 294 IF (N2M>=1) THEN
 295 !
 296 YRECFM='T2M_SEA'
 297 YCOMMENT='X_Y_'//YRECFM//' (K)'
 298 !
 299  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
 300 !
 301 YRECFM='T2MMIN_SEA'
 302 YCOMMENT='X_Y_'//YRECFM//' (K)'
 303 !
 304  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
 305 XT2M_MIN(:)=XUNDEF
 306 !
 307 YRECFM='T2MMAX_SEA'
 308 YCOMMENT='X_Y_'//YRECFM//' (K)'
 309 !
 310  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
 311 XT2M_MAX(:)=0.0
 312 !
 313 YRECFM='Q2M_SEA'
 314 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
 315 !
 316  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
 317 !
 318 YRECFM='HU2M_SEA'
 319 YCOMMENT='X_Y_'//YRECFM//' (-)'
 320 !
 321  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
 322 !
 323 YRECFM='HU2MMIN_SEA'
 324 YCOMMENT='X_Y_'//YRECFM//' (-)'
 325 !
 326  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
 327 XHU2M_MIN(:)=XUNDEF
 328 !
 329 YRECFM='HU2MMAX_SEA'
 330 YCOMMENT='X_Y_'//YRECFM//' (-)'
 331 !
 332  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
 333 XHU2M_MAX(:)=-XUNDEF
 334 !
 335 YRECFM='ZON10M_SEA'
 336 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
 337 !
 338  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
 339 !
 340 YRECFM='MER10M_SEA'
 341 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
 342 !
 343  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
 344 !
 345 YRECFM='W10M_SEA'
 346 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
 347 !
 348  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
 349 !
 350 YRECFM='W10MMAX_SEA'
 351 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
 352 !
 353  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
 354 XWIND10M_MAX(:)=0.0
 355 !
 356 END IF
 357 !
 358 !
 359 !*       7.     chemical diagnostics:
 360 !               --------------------
 361 !
 362 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
 363   DO JSV = 1,SIZE(CCH_NAMES,1)
 364     YRECFM='DV_SEA_'//TRIM(CCH_NAMES(JSV))
 365     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_SEA_',JSV
 366     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
 367   END DO
 368 ENDIF
 369 !
 370 !
 371 !*       8.     prognostic variable diagnostics:
 372 !               --------------------------------
 373 !
 374 IF(LPROVAR_TO_DIAG.OR.LINTERPOL_SST)THEN
 375 !
 376   YRECFM='SST'
 377   YCOMMENT='SST'
 378   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_SST(:),IRESP,HCOMMENT=YCOMMENT)
 379 !
 380 ENDIF
 381 !
 382 !------------------------------------------------------------------------------
 383 !
 384 !         End of IO
 385 !
 386  CALL END_IO_SURF_n(HPROGRAM)
 387 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAFLUX_N',1,ZHOOK_HANDLE)
 388 !
 389 !
 390 END SUBROUTINE WRITE_DIAG_SEB_SEAFLUX_n