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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_PREP_GARDEN_SNOW(HPROGRAM,HSNOW,KSNOW_LAYER,HFILE,HFILETYPE)
00003 !     #######################################################
00004 !
00005 !!****  *READ_PREP_GARDEN_SNOW* - routine to read the configuration for snow
00006 !!                              in ISBA fields preparation
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/2004 
00032 !!     A. Bogatchev 09/2005 EBA snow option
00033 !!     V. Vionnet   06/2008 - Flag for snow metamorphism
00034 !                           - Preparation of uniform snow fields : density, temperture,albedo,grain types
00035 !!                          - Flag to avtivate new maximal liquid water holding capacity : formulation used by Crocus
00036 !-------------------------------------------------------------------------------
00037 !
00038 !*       0.    DECLARATIONS
00039 !              ------------
00040 !
00041 USE MODN_PREP_GARDEN_SNOW
00042 USE MODD_READ_NAMELIST, ONLY : LNAM_READ
00043 !
00044 USE MODD_SURF_PAR,       ONLY : XUNDEF
00045 USE MODD_SNOW_PAR,   ONLY : XANSMIN, XRHOSMAX
00046 USE MODD_CSTS,       ONLY : XTT
00047 !
00048 USE MODE_POS_SURF
00049 USE MODI_TEST_NAM_VAR_SURF
00050 USE MODI_GET_LUOUT
00051 USE MODI_OPEN_NAMELIST
00052 USE MODI_CLOSE_NAMELIST
00053 USE MODI_ABOR1_SFX
00054 !
00055 USE MODD_PREP_TEB_GARDEN, ONLY : CFILE_SNOW, CTYPE_SNOW, LSNOW_IDEAL, &
00056                                  XWSNOW_p=>XWSNOW, XTSNOW_p=>XTSNOW, &
00057                                  XRSNOW_p=>XRSNOW, XASNOW 
00058 !
00059 USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT, NSNOW_LAYER_MAX
00060 !
00061 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00062 USE PARKIND1  ,ONLY : JPRB
00063 !
00064 IMPLICIT NONE
00065 !
00066 !*       0.1   Declarations of arguments
00067 !              -------------------------
00068 !
00069  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling ISBA
00070  CHARACTER(LEN=3),  INTENT(OUT) :: HSNOW    ! snow scheme
00071 INTEGER, INTENT(OUT)           :: KSNOW_LAYER  ! number of snow layers
00072  CHARACTER(LEN=28), OPTIONAL, INTENT(OUT) :: HFILE        ! file name
00073  CHARACTER(LEN=6),  OPTIONAL, INTENT(OUT) :: HFILETYPE    ! file type
00074 !
00075 !*       0.2   Declarations of local variables
00076 !              -------------------------------
00077 !
00078 REAL, DIMENSION(NSNOW_LAYER_MAX) :: XWSNOW, XRSNOW, XTSNOW, 
00079                                     XSG1SNOW, XSG2SNOW, XHISTSNOW, XAGESNOW
00080 !
00081 LOGICAL           :: GFOUND         ! Return code when searching namelist
00082 INTEGER           :: ILUOUT         ! output file logical unit
00083 INTEGER           :: ILUNAM         ! namelist file logical unit
00084 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00085 !-------------------------------------------------------------------------------
00086 NAMELIST/NAM_PREP_ISBA_SNOW/CSNOW, NSNOW_LAYER, CFILE_SNOW, CTYPE_SNOW, &
00087                             LSNOW_IDEAL, LSNOW_FRAC_TOT,                &
00088                             XWSNOW, XTSNOW, XRSNOW, XASNOW,             &
00089                             XSG1SNOW, XSG2SNOW, XHISTSNOW, XAGESNOW
00090 NAMELIST/NAM_PREP_GARDEN_SNOW/CSNOW, NSNOW_LAYER, CFILE_SNOW, CTYPE_SNOW, &
00091                               LSNOW_IDEAL, XWSNOW, XTSNOW, XRSNOW, XASNOW
00092 !-------------------------------------------------------------------------------
00093 !* default
00094 !  -------
00095 !
00096 
00097 IF (LHOOK) CALL DR_HOOK('READ_PREP_GARDEN_SNOW',0,ZHOOK_HANDLE)
00098 IF (LNAM_READ) THEN
00099   !
00100   CSNOW = 'D95'
00101   NSNOW_LAYER = 1
00102   !
00103   CFILE_SNOW    = '                         '
00104   CTYPE_SNOW    = '      '  
00105   !
00106   LSNOW_IDEAL = .FALSE.
00107   LSNOW_FRAC_TOT = .FALSE.
00108   !
00109   XWSNOW(:) = 0.
00110   XRSNOW(:) = XRHOSMAX
00111   XTSNOW(:) = XTT
00112   XASNOW = XANSMIN  
00113   XSG1SNOW(:) = XUNDEF
00114   XSG2SNOW(:) = XUNDEF
00115   XHISTSNOW(:) = XUNDEF
00116   XAGESNOW(:) = XUNDEF  
00117   !
00118   CALL GET_LUOUT(HPROGRAM,ILUOUT)
00119   CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00120   !
00121   !* reading of namelist
00122   !  -------------------
00123   !
00124   !* default can be provided by ISBA scheme variables
00125   CALL POSNAM(ILUNAM,'NAM_PREP_ISBA_SNOW',GFOUND,ILUOUT)
00126   IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PREP_ISBA_SNOW)
00127   !
00128   CALL TEST_NAM_VAR_SURF(ILUOUT,'CSNOW',CSNOW,'D95','3-L','EBA','CRO','NON')
00129   !
00130   !* It is erased by GARDEN namelist if specified
00131   CALL POSNAM(ILUNAM,'NAM_PREP_GARDEN_SNOW',GFOUND,ILUOUT)
00132   IF (GFOUND) THEN 
00133     READ(UNIT=ILUNAM,NML=NAM_PREP_GARDEN_SNOW)
00134   !crocus can't be used in garden if not used in isba scheme
00135     CALL TEST_NAM_VAR_SURF(ILUOUT,'CSNOW',CSNOW,'D95','3-L','EBA','NON')
00136   ENDIF
00137   !
00138   IF (CSNOW=='NON') NSNOW_LAYER = 0
00139   !
00140   IF (CSNOW=='D95' .OR. CSNOW=='EBA') NSNOW_LAYER = 1
00141   ! not more than 3 layers for snow in garden
00142   IF ((CSNOW=='3-L' .OR. CSNOW=='CRO') .AND. NSNOW_LAYER<=2) NSNOW_LAYER = 3
00143   !
00144   IF (CSNOW=='3-L' .AND. NSNOW_LAYER>3) THEN
00145     NSNOW_LAYER = 3
00146     WRITE(ILUOUT,*) '------------------------------------'
00147     WRITE(ILUOUT,*) 'With ISBA-ES, number of snow layers '
00148     WRITE(ILUOUT,*) 'cannot be more than 3.              '
00149     WRITE(ILUOUT,*) 'So it is forced to 3 here.          '
00150     WRITE(ILUOUT,*) '------------------------------------'
00151   ENDIF
00152   !  
00153   IF (NSNOW_LAYER > NSNOW_LAYER_MAX) THEN
00154     WRITE(ILUOUT,*) '------------------------------------'
00155     WRITE(ILUOUT,*) 'Please update modd_prep_snow.f90 routine : '
00156     WRITE(ILUOUT,*) 'The maximum number of snow layers  '
00157     WRITE(ILUOUT,*) 'in the declaration of the namelist variables '
00158     WRITE(ILUOUT,*) 'must be decreased to : ', NSNOW_LAYER_MAX
00159     WRITE(ILUOUT,*) '------------------------------------'
00160     CALL ABOR1_SFX('READ_PREP_GARDEN_SNOW: NUMBER OF SNOW LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
00161   ENDIF
00162   !
00163   ALLOCATE(XWSNOW_p(NSNOW_LAYER))
00164   ALLOCATE(XRSNOW_p(NSNOW_LAYER))
00165   ALLOCATE(XTSNOW_p(NSNOW_LAYER))
00166   !
00167   XWSNOW_p=XWSNOW(1:NSNOW_LAYER)
00168   XRSNOW_p=XRSNOW(1:NSNOW_LAYER)
00169   XTSNOW_p=XTSNOW(1:NSNOW_LAYER)
00170   !
00171   CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00172   !
00173 ENDIF
00174 !
00175 HSNOW = CSNOW
00176 !
00177 KSNOW_LAYER = NSNOW_LAYER
00178 !
00179 IF (LEN_TRIM(CFILE_SNOW)>0 .AND. LEN_TRIM(CTYPE_SNOW)>0 ) THEN
00180   IF (PRESENT(HFILE)) HFILE = CFILE_SNOW
00181   IF (PRESENT(HFILETYPE)) HFILETYPE = CTYPE_SNOW
00182 END IF
00183 !
00184 IF (LHOOK) CALL DR_HOOK('READ_PREP_GARDEN_SNOW',1,ZHOOK_HANDLE)
00185 !
00186 !-------------------------------------------------------------------------------
00187 !-------------------------------------------------------------------------------
00188 !
00189 END SUBROUTINE READ_PREP_GARDEN_SNOW