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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITE_DIAG_SEB_SURF_ATM_n(HPROGRAM)
00003 !     #################################
00004 !
00005 !!****  *WRITE_DIAG_SEB_SURF_ATM_n* - writes surface 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 : sea flux parameterization.
00027 !!      Modified    08/2009 : cumulated diag
00028 !!      Juan        6/12/2011: parallel bug , remove local ANY(XAVG_ZON10M) test
00029 !-------------------------------------------------------------------------------
00030 !
00031 !*       0.    DECLARATIONS
00032 !              ------------
00033 !
00034 USE MODD_DIAG_SURF_ATM_n,  ONLY : N2M, L2M_MIN_ZS, LSURF_BUDGET, LCOEF,          &
00035                                   LRAD_BUDGET, LRESET_BUDGETC, LSURF_BUDGETC,    &
00036                                   XAVG_RN, XAVG_H, XAVG_LE, XAVG_LEI, XAVG_GFLUX,&
00037                                   XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE,            &
00038                                   XAVG_T2M, XAVG_TS, XAVG_Q2M, XAVG_HU2M,        &
00039                                   XAVG_ZON10M, XAVG_MER10M, XAVG_Z0, XAVG_Z0H,   &
00040                                   XAVG_T2M_MIN_ZS, XAVG_Q2M_MIN_ZS,              &
00041                                   XAVG_HU2M_MIN_ZS, XDIAG_UREF, XDIAG_ZREF,      &
00042                                   XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU,      &
00043                                   XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV,        &
00044                                   XSSO_FMU, XSSO_FMV,                            &
00045                                   XAVG_RNC, XAVG_HC, XAVG_LEC, XAVG_GFLUXC,      &
00046                                   XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC,    &
00047                                   XAVG_FMUC, XAVG_FMVC, XAVG_T2M_MIN,            &
00048                                   XAVG_T2M_MAX, XAVG_LEIC, XDIAG_TRAD,           &
00049                                   XDIAG_EMIS, XAVG_HU2M_MIN, XAVG_HU2M_MAX,      &
00050                                   XAVG_WIND10M, XAVG_WIND10M_MAX, XAVG_SFCO2
00051 !
00052 USE MODD_SURF_ATM_GRID_n, ONLY : CGRID
00053 USE MODD_SURF_PAR, ONLY : XUNDEF
00054 !
00055 USE MODI_INIT_IO_SURF_n
00056 USE MODI_WRITE_SURF
00057 USE MODI_END_IO_SURF_n
00058 USE MODI_SUM_ON_ALL_PROCS
00059 !
00060 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00061 USE PARKIND1  ,ONLY : JPRB
00062 !
00063 IMPLICIT NONE
00064 !
00065 !*       0.1   Declarations of arguments
00066 !              -------------------------
00067 !
00068  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00069 !
00070 !*       0.2   Declarations of local variables
00071 !              -------------------------------
00072 !
00073 
00074 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00075  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00076  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00077  CHARACTER(LEN=2)  :: YNUM
00078 !
00079 INTEGER           :: JSW
00080 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00081 !
00082 !-------------------------------------------------------------------------------
00083 !
00084 !         Initialisation for IO
00085 !
00086 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SURF_ATM_N',0,ZHOOK_HANDLE)
00087  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
00088 !
00089 !
00090 !*       1.     Richardson number :
00091 !               -----------------
00092 !
00093 IF (N2M>=1) THEN
00094   !        
00095   YRECFM='RI'
00096   YCOMMENT='X_Y_'//YRECFM
00097   !
00098   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
00099   !
00100 ENDIF
00101 !
00102 !*       2.     parameters at surface, 2 and 10 meters :
00103 !               ----------------------------------------
00104 !
00105 IF (N2M>=1.OR.LSURF_BUDGET.OR.LSURF_BUDGETC) THEN
00106   !
00107   YRECFM='TS'
00108   YCOMMENT='X_Y_'//YRECFM//' (K)'
00109   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
00110   !
00111   YRECFM='TSRAD'
00112   YCOMMENT='X_Y_'//YRECFM//' (K)'
00113   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_TRAD(:),IRESP,HCOMMENT=YCOMMENT)
00114   !
00115   YRECFM='EMIS'
00116   YCOMMENT='X_Y_'//YRECFM//' (-)'
00117   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_EMIS(:),IRESP,HCOMMENT=YCOMMENT)
00118   !
00119   YRECFM='SFCO2'
00120   YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
00121   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
00122   !
00123 ENDIF
00124 !
00125 IF (N2M>=1) THEN
00126   !
00127   YRECFM='T2M'
00128   YCOMMENT='X_Y_'//YRECFM//' (K)'
00129   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
00130   !
00131   YRECFM='T2MMIN'
00132   YCOMMENT='X_Y_'//YRECFM//' (K)'
00133   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00134   !
00135   YRECFM='T2MMAX'
00136   YCOMMENT='X_Y_'//YRECFM//' (K)'
00137   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00138   !
00139   YRECFM='Q2M'
00140   YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00141   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
00142   !
00143   YRECFM='HU2M'
00144   YCOMMENT='X_Y_'//YRECFM//' (-)'
00145   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
00146   !
00147   YRECFM='HU2MMIN'
00148   YCOMMENT='X_Y_'//YRECFM//' (-)'
00149   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00150   !
00151   YRECFM='HU2MMAX'
00152   YCOMMENT='X_Y_'//YRECFM//' (-)'
00153   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00154   !
00155   IF ( SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XAVG_ZON10M(:)/= XUNDEF) > 0. ) THEN
00156     !
00157     YRECFM='ZON10M'
00158     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00159     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
00160     !
00161     YRECFM='MER10M'
00162     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00163     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
00164     !
00165     YRECFM='W10M'
00166     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00167     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
00168     !
00169     YRECFM='W10MMAX'
00170     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00171     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00172     !
00173   ENDIF
00174   !
00175   IF (L2M_MIN_ZS) THEN
00176     !
00177     YRECFM='T2M_MIN_ZS'
00178     YCOMMENT='X_Y_'//YRECFM//' (K)'
00179     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
00180     !
00181     YRECFM='Q2M_MIN_ZS'
00182     YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00183     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
00184     !
00185     YRECFM='HU2M_MIN_ZS'
00186     YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00187     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
00188     !
00189   END IF
00190   !
00191 END IF
00192 !
00193 !*       3.     Energy fluxes :
00194 !               -------------
00195 !
00196 IF (LSURF_BUDGET) THEN
00197   !
00198   YRECFM='RN'
00199   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00200   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
00201   !
00202   YRECFM='H'
00203   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00204   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
00205   !
00206   YRECFM='LE'
00207   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00208   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
00209   !
00210   YRECFM='LEI'
00211   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00212   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
00213   !
00214   YRECFM='GFLUX'
00215   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00216   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
00217   !
00218   IF (LRAD_BUDGET) THEN
00219     !         
00220     YRECFM='SWD'
00221     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00222     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
00223     !
00224     YRECFM='SWU'
00225     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00226     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
00227     !
00228     YRECFM='LWD'
00229     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00230     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
00231     !
00232     YRECFM='LWU'
00233     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00234     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
00235     !
00236     DO JSW=1, SIZE(XAVG_SWBD,2)
00237       YNUM=ACHAR(48+JSW)
00238       !
00239       YRECFM='SWD_'//YNUM
00240       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00241       CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00242       !
00243       YRECFM='SWU_'//YNUM
00244       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00245       CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00246       !
00247     ENDDO
00248     !
00249   ENDIF
00250   !
00251   YRECFM='FMUNOSSO'
00252   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00253   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
00254   !
00255   YRECFM='FMVNOSSO'
00256   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00257   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
00258   !
00259   YRECFM='FMU'
00260   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00261   CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_FMU(:),IRESP,HCOMMENT=YCOMMENT)
00262   !
00263   YRECFM='FMV'
00264   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
00265   CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_FMV(:),IRESP,HCOMMENT=YCOMMENT)
00266   !
00267 END IF
00268 !
00269 ! * Cumulated diag
00270 !
00271 IF (LSURF_BUDGETC) THEN
00272   !
00273   YRECFM='RNC'
00274   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00275   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
00276   !
00277   YRECFM='HC'
00278   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00279   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
00280   !
00281   YRECFM='LEC'
00282   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00283   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
00284   !
00285   YRECFM='LEIC'
00286   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00287   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
00288   !
00289   YRECFM='GFLUXC'
00290   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00291   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
00292   !
00293   IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
00294     !        
00295     YRECFM='SWDC'
00296     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00297     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
00298     !
00299     YRECFM='SWUC'
00300     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00301     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
00302     !
00303     YRECFM='LWDC'
00304     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00305     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
00306     !
00307     YRECFM='LWUC'
00308     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00309     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
00310     !
00311   ENDIF
00312   !
00313   YRECFM='FMUC'
00314   YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
00315   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
00316   !
00317   YRECFM='FMVC'
00318   YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
00319   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
00320   !
00321 END IF
00322 !
00323 !
00324 !*       4.     Transfer coefficients
00325 !               ---------------------
00326 !
00327 IF (LCOEF) THEN
00328   !
00329   YRECFM='CD'
00330   YCOMMENT='X_Y_'//YRECFM
00331   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
00332   !
00333   YRECFM='CH'
00334   YCOMMENT='X_Y_'//YRECFM
00335   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
00336   !
00337   YRECFM='CE'
00338   YCOMMENT='X_Y_'//YRECFM
00339   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
00340   !
00341   YRECFM='Z0'
00342   YCOMMENT='X_Y_'//YRECFM
00343   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
00344   !
00345   YRECFM='Z0H'
00346   YCOMMENT='X_Y_'//YRECFM
00347   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
00348   !
00349   YRECFM='UREF'
00350   YCOMMENT='X_Y_'//YRECFM
00351   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_UREF(:),IRESP,HCOMMENT=YCOMMENT)
00352   !
00353   YRECFM='ZREF'
00354   YCOMMENT='X_Y_'//YRECFM
00355   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_ZREF(:),IRESP,HCOMMENT=YCOMMENT)
00356   !
00357 END IF
00358 !
00359 !-------------------------------------------------------------------------------
00360 !
00361 !         End of IO
00362 !
00363  CALL END_IO_SURF_n(HPROGRAM)
00364 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SURF_ATM_N',1,ZHOOK_HANDLE)
00365 !
00366 !
00367 END SUBROUTINE WRITE_DIAG_SEB_SURF_ATM_n