SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/read_flake_sbln.F90
Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_FLAKE_SBL_n(HPROGRAM)
00003 !     #########################################
00004 !
00005 !!****  *READ_FLAKE_SBL_n* - reads FLAKE fields
00006 !!                        
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    01/2003 
00032 !!      E. Martin   01/2012 Add LSBL_COLD_START
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 USE MODD_SURF_PAR,      ONLY : XUNDEF
00039 USE MODD_FLAKE_n,       ONLY : LSBL
00040 USE MODD_FLAKE_SBL_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XDZ, XZF, XDZF, XP
00041 !
00042 USE MODI_READ_SURF
00043 USE MODI_CANOPY_GRID
00044 USE MODI_GET_TYPE_DIM_n
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 ! calling program
00055 !
00056 !
00057 !*       0.2   Declarations of local variables
00058 !              -------------------------------
00059 !
00060  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00061  CHARACTER(LEN=3)  :: YREAD
00062 INTEGER :: ILU     ! 1D physical dimension
00063 INTEGER :: IRESP   ! Error code after redding
00064 INTEGER :: JLAYER  ! loop counter on layers
00065 INTEGER :: IVERSION, IBUGFIX
00066 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00067 !
00068 !-------------------------------------------------------------------------------
00069 !
00070 !* 1D physical dimension
00071 !
00072 IF (LHOOK) CALL DR_HOOK('READ_FLAKE_SBL_N',0,ZHOOK_HANDLE)
00073  CALL GET_TYPE_DIM_n('WATER ',ILU)
00074 !
00075 YRECFM='VERSION'
00076  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00077 !
00078 YRECFM='BUG'
00079  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
00080 !
00081 !* flag to use or not SBL levels
00082 !
00083 YRECFM='WAT_SBL'
00084  CALL READ_SURF(HPROGRAM,YRECFM,LSBL,IRESP)
00085 !
00086 IF (.NOT.LSBL) THEN
00087   ALLOCATE(XZ  (0,0))
00088   ALLOCATE(XU  (0,0))
00089   ALLOCATE(XT  (0,0))
00090   ALLOCATE(XQ  (0,0))
00091   ALLOCATE(XTKE(0,0))
00092   ALLOCATE(XLMO(0)  )
00093   ALLOCATE(XP  (0,0))
00094   ALLOCATE(XDZ (0,0))
00095   ALLOCATE(XZF (0,0))
00096   ALLOCATE(XDZF(0,0))
00097   IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
00098   RETURN
00099 ENDIF
00100 !
00101 !* number of vertical levels
00102 !
00103 YRECFM='WAT_SBL_LVL'
00104  CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP)
00105 !
00106 !*       2.     Prognostic fields:
00107 !               -----------------
00108 !
00109 !* altitudes
00110 !
00111 ALLOCATE(XZ(ILU,NLVL))
00112 !
00113 DO JLAYER=1,NLVL
00114   WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' '
00115   CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP)
00116 END DO
00117 !
00118 ALLOCATE(XU  (ILU,NLVL))
00119 ALLOCATE(XT  (ILU,NLVL))
00120 ALLOCATE(XQ  (ILU,NLVL))
00121 ALLOCATE(XTKE(ILU,NLVL))
00122 ALLOCATE(XLMO(ILU)     )
00123 ALLOCATE(XP  (ILU,NLVL))
00124 !
00125 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
00126   YRECFM='STORAGETYPE'
00127   CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
00128 ELSE
00129   YREAD = 'ALL'
00130 ENDIF
00131 !
00132 IF(YREAD=='ALL') THEN
00133   !
00134   !* wind in SBL
00135   DO JLAYER=1,NLVL
00136     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' '
00137     CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP)
00138   END DO
00139   !
00140   !* theta in SBL
00141   DO JLAYER=1,NLVL
00142     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' '
00143     CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP)
00144   END DO
00145   !
00146   !* humidity in SBL
00147   DO JLAYER=1,NLVL
00148     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' '
00149     CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP)
00150   END DO
00151   !
00152   !* Tke in SBL
00153   DO JLAYER=1,NLVL
00154     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' '
00155     CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
00156   END DO
00157   !
00158   !* Monin-Obhukov length
00159   YRECFM='WAT_SBL_LMO     '
00160   CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP)
00161   !
00162   !* Pressure
00163   DO JLAYER=1,NLVL
00164     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' '
00165     CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP)
00166   END DO
00167   !
00168 ELSE
00169   XU  (:,:) = XUNDEF
00170   XT  (:,:) = XUNDEF
00171   XQ  (:,:) = XUNDEF
00172   XTKE(:,:) = XUNDEF
00173   XLMO(:)   = XUNDEF
00174   XP  (:,:) = XUNDEF
00175 ENDIF
00176 !
00177 !
00178 !* Grid characteristics
00179 !
00180 !
00181 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
00182 !                                                                           ^
00183 !                                                                           |
00184 !                                                                           |
00185 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
00186 !                                                              ^            |
00187 !                                                              |            |
00188 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
00189 !                                                              |            ^
00190 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
00191 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
00192 !  - - - - - - - - - - - - - - - - - XZf(k-1)
00193 !
00194 ALLOCATE(XDZ (ILU,NLVL))
00195 ALLOCATE(XZF (ILU,NLVL))
00196 ALLOCATE(XDZF(ILU,NLVL))
00197  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
00198 !
00199 IF (LHOOK) CALL DR_HOOK('READ_FLAKE_SBL_N',1,ZHOOK_HANDLE)
00200 !
00201 !-------------------------------------------------------------------------------
00202 !
00203 END SUBROUTINE READ_FLAKE_SBL_n