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

Go to the documentation of this file.
00001 !     #########################################
00002       SUBROUTINE READ_SSO_CANOPY_n(HPROGRAM,HINIT)
00003 !     #########################################
00004 !
00005 !!****  *READ_SSO_CANOPY_n* - reads SSO 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    05/2010 
00032 !!      B. Decharme 07/2011  initialize sso_canopy in prep
00033 !!      E. Martin   01/2012  Avoid writing of XUNDEF canopy fields
00034 !-------------------------------------------------------------------------------
00035 !
00036 !*       0.    DECLARATIONS
00037 !              ------------
00038 !
00039 USE MODD_SURF_PAR,        ONLY : XUNDEF
00040 USE MODD_SSO_CANOPY_n,   ONLY : NLVL, XZ, XU, XTKE, XDZ, XZF, XDZF
00041 !
00042 USE MODI_READ_SURF
00043 USE MODI_PREP_SSO_CANOPY
00044 USE MODI_CANOPY_GRID
00045 USE MODI_GET_TYPE_DIM_n
00046 !
00047 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00048 USE PARKIND1  ,ONLY : JPRB
00049 !
00050 IMPLICIT NONE
00051 !
00052 !*       0.1   Declarations of arguments
00053 !              -------------------------
00054 !
00055  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
00056  CHARACTER(LEN=3),  INTENT(IN)  :: HINIT    ! choice of fields to initialize
00057 !
00058 !*       0.2   Declarations of local variables
00059 !              -------------------------------
00060 !
00061  CHARACTER(LEN=12) :: YRECFM       ! Name of the article to be read
00062  CHARACTER(LEN=3)  :: YREAD
00063 INTEGER :: ILU     ! 1D physical dimension
00064 INTEGER :: IRESP   ! Error code after redding
00065 INTEGER :: JLAYER  ! loop counter on layers
00066 INTEGER :: IVERSION, IBUGFIX   ! surface version
00067 LOGICAL :: GCANOPY    ! flag to test if SSO canopy fields are in the file
00068 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00069 !-------------------------------------------------------------------------------
00070 !
00071 !* 1D physical dimension
00072 !
00073 IF (LHOOK) CALL DR_HOOK('READ_SSO_CANOPY_N',0,ZHOOK_HANDLE)
00074  CALL GET_TYPE_DIM_n('FULL  ',ILU)
00075 !
00076 !* flag to use or not canopy levels
00077 !
00078 YRECFM='VERSION'
00079  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00080 !
00081 YRECFM='BUG'
00082  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
00083 !
00084 IF (IVERSION<6.OR.HINIT=='PGD'.OR. HINIT=='PRE') THEN
00085   GCANOPY = .FALSE.
00086 ELSE
00087   YRECFM='SSO_CANOPY'
00088   CALL READ_SURF(HPROGRAM,YRECFM,GCANOPY,IRESP)
00089 END IF
00090 !
00091 !*       2.     Allocation of Prognostic fields:
00092 !               --------------------------------
00093 !
00094 !* number of vertical levels
00095 !
00096 IF (.NOT. GCANOPY) THEN
00097   CALL PREP_SSO_CANOPY(ILU)
00098 ELSE
00099   !
00100   YRECFM='SSO_CAN_LVL'
00101   CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP)
00102   !
00103   ALLOCATE(XZ(ILU,NLVL))
00104   !
00105   !*       3.     Reading of Prognostic fields:
00106   !               -----------------------------
00107   !
00108   !* altitudes
00109   !
00110   DO JLAYER=1,NLVL
00111     WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_Z',JLAYER,' '
00112     CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP)
00113   END DO
00114   !
00115   ALLOCATE(XU(ILU,NLVL))
00116   ALLOCATE(XTKE(ILU,NLVL))
00117   !
00118   IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
00119     YRECFM='STORAGETYPE'
00120     CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
00121   ELSE
00122     YREAD = 'ALL'
00123   ENDIF
00124   !
00125   IF(YREAD=='ALL') THEN
00126     !
00127     !* wind in canopy
00128     DO JLAYER=1,NLVL
00129       WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_U',JLAYER,' '
00130       CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP)
00131     END DO
00132     !
00133     !* Tke in canopy
00134     DO JLAYER=1,NLVL
00135       WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_E',JLAYER,' '
00136       CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
00137     END DO
00138     !
00139   ELSE
00140     XU(:,:)=XUNDEF
00141     XTKE(:,:)=XUNDEF
00142   ENDIF
00143   !
00144 ENDIF
00145 !
00146 !
00147 !* Grid characteristics
00148 !
00149 !
00150 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
00151 !                                                                           ^
00152 !                                                                           |
00153 !                                                                           |
00154 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
00155 !                                                              ^            |
00156 !                                                              |            |
00157 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
00158 !                                                              |            ^
00159 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
00160 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
00161 !  - - - - - - - - - - - - - - - - - XZf(k-1)
00162 !
00163 ALLOCATE(XDZ (ILU,NLVL))
00164 ALLOCATE(XZF (ILU,NLVL))
00165 ALLOCATE(XDZF(ILU,NLVL))
00166  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
00167 IF (LHOOK) CALL DR_HOOK('READ_SSO_CANOPY_N',1,ZHOOK_HANDLE)
00168 !
00169 !-------------------------------------------------------------------------------
00170 !
00171 END SUBROUTINE READ_SSO_CANOPY_n