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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITESURF_FLAKE_SBL_n(HPROGRAM,HWRITE)
00003 !     ####################################
00004 !
00005 !!****  *WRITE_FLAKE_n* - writes FLAKE fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      V. Masson   *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    01/2003 
00031 !!      E. Martin   01/2012 avoid write of XUNDEF fields
00032 !-------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 !
00038 !
00039 USE MODD_FLAKE_n,       ONLY : LSBL
00040 USE MODD_FLAKE_SBL_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XP
00041 !
00042 USE MODI_WRITE_SURF
00043 !
00044 !
00045 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00046 USE PARKIND1  ,ONLY : JPRB
00047 !
00048 IMPLICIT NONE
00049 !
00050 !*       0.1   Declarations of arguments
00051 !              -------------------------
00052 !
00053  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00054  CHARACTER(LEN=3),    INTENT(IN)  :: HWRITE    ! 'PREP' : does not write SBL XUNDEF fields
00055 !                                             ! 'ALL' : all fields are written
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 !
00063 INTEGER :: JLAYER  ! loop counter on layers
00064 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00065 !-------------------------------------------------------------------------------
00066 !
00067 !*       1.     Prognostic fields:
00068 !               -----------------
00069 !
00070 !* flag to define if SBL is computed
00071 !
00072 IF (LHOOK) CALL DR_HOOK('WRITESURF_FLAKE_SBL_N',0,ZHOOK_HANDLE)
00073 YRECFM='WAT_SBL'
00074 YCOMMENT='flag to use SBL levels'
00075  CALL WRITE_SURF(HPROGRAM,YRECFM,LSBL,IRESP,HCOMMENT=YCOMMENT)
00076 !
00077 IF (.NOT. LSBL .AND. LHOOK) CALL DR_HOOK('WRITESURF_FLAKE_SBL_N',1,ZHOOK_HANDLE)
00078 IF (.NOT. LSBL) RETURN
00079 !
00080 !* number of levels
00081 !
00082 YRECFM='WAT_SBL_LVL'
00083 YCOMMENT='number of SBL levels'
00084  CALL WRITE_SURF(HPROGRAM,YRECFM,NLVL,IRESP,HCOMMENT=YCOMMENT)
00085 !
00086 !* altitudes
00087 !
00088 DO JLAYER=1,NLVL
00089   WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' '
00090   YCOMMENT='altitudes of SBL levels (m)'
00091   CALL WRITE_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00092 END DO
00093 !
00094 IF (HWRITE/='PRE') THEN
00095   !
00096   !* wind in SBL
00097   !
00098   DO JLAYER=1,NLVL
00099     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' '
00100     YCOMMENT='wind at SBL levels (m/s)'
00101     CALL WRITE_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00102   END DO
00103   !
00104   !* temperature in SBL
00105   !
00106   DO JLAYER=1,NLVL
00107     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' '
00108     YCOMMENT='temperature at SBL levels (K)'
00109     CALL WRITE_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00110   END DO
00111   !
00112   !* humidity in SBL
00113   !
00114   DO JLAYER=1,NLVL
00115     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' '
00116     YCOMMENT='humidity at SBL levels (kg/m3)'
00117     CALL WRITE_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00118   END DO
00119   !
00120   !* Tke in SBL
00121   !
00122   DO JLAYER=1,NLVL
00123     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' '
00124     YCOMMENT='Tke at SBL levels (m2/s2)'
00125     CALL WRITE_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00126   END DO
00127   !
00128   !* Monin-Obhukov length
00129   !
00130   YRECFM='WAT_SBL_LMO     '
00131   CALL WRITE_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP,HCOMMENT=YCOMMENT)
00132   !
00133   !* Air pressure in SBL
00134   !
00135   DO JLAYER=1,NLVL
00136     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' '
00137     YCOMMENT='Pressure at SBL levels (Pa)'
00138     CALL WRITE_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00139   END DO
00140   !
00141 ENDIF
00142 !
00143 IF (LHOOK) CALL DR_HOOK('WRITESURF_FLAKE_SBL_N',1,ZHOOK_HANDLE)
00144 !
00145 !
00146 !-------------------------------------------------------------------------------
00147 !
00148 END SUBROUTINE WRITESURF_FLAKE_SBL_n