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_FLAKE_n(HPROGRAM)
00003 !     #################################
00004 !
00005 !!****  *WRITE_DIAG_SEB_FLAKE_n* - writes FLAKE 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 !-------------------------------------------------------------------------------
00027 !
00028 !*       0.    DECLARATIONS
00029 !              ------------
00030 !
00031 USE MODD_DIAG_FLAKE_n,  ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET,  LCOEF,   &
00032                                  LSURF_VARS, XRN, XH, XLE, XLEI, XGFLUX,   &
00033                                  XRI, XCD, XCH, XCE, XZ0, XZ0H,            &
00034                                  XT2M, XQ2M, XHU2M,                        &
00035                                  XZON10M, XMER10M, XQS,                    &
00036                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
00037                                  XFMU, XFMV  
00038 
00039 USE MODD_CH_WATFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
00040 !
00041 USE MODI_INIT_IO_SURF_n
00042 USE MODI_WRITE_SURF
00043 USE MODI_END_IO_SURF_n
00044 !
00045 !
00046 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00047 USE PARKIND1  ,ONLY : JPRB
00048 !
00049 IMPLICIT NONE
00050 !
00051 !*       0.1   Declarations of arguments
00052 !              -------------------------
00053 !
00054  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00055 !
00056 !*       0.2   Declarations of local variables
00057 !              -------------------------------
00058 !
00059 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00060  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00061  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00062  CHARACTER(LEN=2)  :: YNUM
00063 !
00064 INTEGER           :: JSV, JSW
00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00066 !-------------------------------------------------------------------------------
00067 !
00068 !         Initialisation for IO
00069 !
00070 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_FLAKE_N',0,ZHOOK_HANDLE)
00071  CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE ','WRITE')
00072 !
00073 !
00074 !*       2.     Richardson number :
00075 !               -----------------
00076 !
00077 IF (N2M>=1) THEN
00078 
00079 YRECFM='RI_WAT'
00080 YCOMMENT='Bulk-Richardson number for water'
00081 !
00082  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
00083 !
00084 END IF
00085 !
00086 !*       3.     Energy fluxes :
00087 !               -------------
00088 !
00089 IF (LSURF_BUDGET) THEN
00090 
00091 YRECFM='RN_WAT'
00092 YCOMMENT='net radiation for water'//' (W/m2)'
00093 !
00094  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
00095 !
00096 YRECFM='H_WAT'
00097 YCOMMENT='sensible heat flux for water'//' (W/m2)'
00098 !
00099  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
00100 !
00101 YRECFM='LE_WAT'
00102 YCOMMENT='total latent heat flux for water'//' (W/m2)'
00103 !
00104  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
00105 !
00106 YRECFM='LEI_WAT'
00107 YCOMMENT='sublimation latent heat flux for water-ice'//' (W/m2)'
00108 !
00109  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
00110 !
00111 YRECFM='GFLUX_WAT'
00112 YCOMMENT='conduction flux for water'//' (W/m2)'
00113 !
00114  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
00115 !
00116 IF (LRAD_BUDGET) THEN
00117 !
00118    YRECFM='SWD_WAT'
00119    YCOMMENT='short wave downward radiation for water'//' (W/m2)'
00120    !
00121    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
00122    !
00123    YRECFM='SWU_WAT'
00124    YCOMMENT='short wave upward radiation for water'//' (W/m2)'
00125    !
00126    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
00127    !
00128    YRECFM='LWD_WAT'
00129    YCOMMENT='downward long wave radiation'//' (W/m2)'
00130    !
00131    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
00132    !
00133    YRECFM='LWU_WAT'
00134    YCOMMENT='upward long wave radiation'//' (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_WAT_'//YNUM
00142       YCOMMENT='downward short wave radiation by spectral band '//' (W/m2)'
00143       !
00144       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00145       !
00146       YRECFM='SWU_WAT_'//YNUM
00147       YCOMMENT='upward short wave radiation by spectral band'//' (W/m2)'
00148       !
00149       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00150       !
00151    ENDDO
00152 !
00153 ENDIF
00154 !
00155 YRECFM='FMU_WAT'
00156 YCOMMENT='u-component of momentum flux for water'//' (kg/ms2)'
00157 !
00158  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
00159 YRECFM='FMV_WAT'
00160 YCOMMENT='v-component of momentum flux for water'//' (kg/ms2)'
00161 !
00162  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
00163 !
00164 END IF
00165 !
00166 !
00167 !*       4.     Transfer coefficients
00168 !               ---------------------
00169 !
00170 IF (LCOEF) THEN
00171 
00172 YRECFM='CD_WAT'
00173 YCOMMENT='drag coefficient for wind over water (W/s2)'
00174 !
00175  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
00176 !
00177 YRECFM='CH_WAT'
00178 YCOMMENT='drag coefficient for heat (W/s)'
00179 !
00180  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
00181 !
00182 YRECFM='CE_WAT'
00183 YCOMMENT='drag coefficient for vapor (W/s/K)'
00184 !
00185  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
00186 !
00187 YRECFM='Z0_WAT'
00188 YCOMMENT='roughness length over water (m)'
00189 
00190  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
00191 !
00192 YRECFM='Z0H_WAT'
00193 YCOMMENT='thermal roughness length over water (m)'
00194 !
00195  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
00196 !
00197 END IF
00198 !
00199 !
00200 !*       5.     Surface humidity
00201 !               ----------------
00202 !
00203 IF (LSURF_VARS) THEN
00204 
00205 YRECFM='QS_WAT'
00206 YCOMMENT='specific humidity over water'//' (KG/KG)'
00207 !
00208  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
00209 !
00210 ENDIF
00211 !
00212 
00213 !
00214 !*       6.     parameters at 2 and 10 meters :
00215 !               -----------------------------
00216 !
00217 IF (N2M>=1) THEN
00218 
00219 YRECFM='T2M_WAT'
00220 YCOMMENT='2 meters temperature'//' (K)'
00221 !
00222  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
00223 !
00224 YRECFM='Q2M_WAT'
00225 YCOMMENT='2 meters specific humidity'//' (KG/KG)'
00226 !
00227  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
00228 !
00229 YRECFM='HU2M_WAT'
00230 YCOMMENT='2 meters relative humidity'//' (KG/KG)'
00231 !
00232  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
00233 !
00234 YRECFM='ZON10M_WAT'
00235 YCOMMENT='10 meters zonal wind'//' (M/S)'
00236 !
00237  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
00238 !
00239 YRECFM='MER10M_WAT'
00240 YCOMMENT='10 meters meridian wind'//' (M/S)'
00241 !
00242  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
00243 !
00244 END IF
00245 !
00246 !
00247 !*       7.     chemical diagnostics:
00248 !               --------------------
00249 !
00250 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
00251   DO JSV = 1,SIZE(CCH_NAMES,1)
00252     YRECFM='DV_WAT_'//TRIM(CCH_NAMES(JSV))
00253     WRITE(YCOMMENT,'(A26)')'final dry deposition (m/s)'
00254     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
00255   END DO
00256 ENDIF
00257 !
00258 !-------------------------------------------------------------------------------
00259 !
00260 !         End of IO
00261 !
00262  CALL END_IO_SURF_n(HPROGRAM)
00263 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_FLAKE_N',1,ZHOOK_HANDLE)
00264 !
00265 !
00266 END SUBROUTINE WRITE_DIAG_SEB_FLAKE_n