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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_PREP_ISBA_SNOW(HPROGRAM,HSNOW,KSNOW_LAYER,HFILE,HFILETYPE,OUNIF)
00003 !     #######################################################
00004 !
00005 !!****  *READ_PREP_ISBA_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 !!     B. Decharme  07/2012 Bug init uniform snow
00037 !-------------------------------------------------------------------------------
00038 !
00039 !*       0.    DECLARATIONS
00040 !              ------------
00041 !
00042 USE MODN_PREP_ISBA_SNOW
00043 USE MODD_READ_NAMELIST, ONLY : LNAM_READ
00044 !
00045 USE MODD_SURF_PAR,   ONLY : XUNDEF
00046 USE MODD_SNOW_PAR,   ONLY : XANSMIN, XRHOSMAX
00047 USE MODD_CSTS,       ONLY : XTT
00048 !
00049 USE MODE_POS_SURF
00050 USE MODI_TEST_NAM_VAR_SURF
00051 USE MODI_GET_LUOUT
00052 USE MODI_OPEN_NAMELIST
00053 USE MODI_CLOSE_NAMELIST
00054 USE MODI_ABOR1_SFX
00055 !
00056 USE MODD_PREP_ISBA, ONLY : CFILE_SNOW, CTYPE_SNOW, LSNOW_IDEAL, &
00057                            XWSNOW_p=>XWSNOW, XTSNOW_p=>XTSNOW,  &
00058                            XRSNOW_p=>XRSNOW, XASNOW,            &
00059                            XSG1SNOW_p=>XSG1SNOW, XSG2SNOW_p=>XSG2SNOW, &
00060                            XHISTSNOW_p=>XHISTSNOW, XAGESNOW_p=>XAGESNOW
00061                            
00062 !
00063 USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT, NSNOW_LAYER_MAX 
00064 !
00065 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00066 USE PARKIND1  ,ONLY : JPRB
00067 !
00068 IMPLICIT NONE
00069 !
00070 !*       0.1   Declarations of arguments
00071 !              -------------------------
00072 !
00073  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling ISBA
00074  CHARACTER(LEN=3),  INTENT(OUT) :: HSNOW    ! snow scheme
00075 INTEGER, INTENT(OUT)           :: KSNOW_LAYER  ! number of snow layers
00076  CHARACTER(LEN=28), OPTIONAL, INTENT(OUT) :: HFILE        ! file name
00077  CHARACTER(LEN=6),  OPTIONAL, INTENT(OUT) :: HFILETYPE    ! file type
00078 LOGICAL,           OPTIONAL, INTENT(OUT) :: OUNIF  ! uniform snow
00079 !
00080 !*       0.2   Declarations of local variables
00081 !              -------------------------------
00082 !
00083 REAL, DIMENSION(NSNOW_LAYER_MAX) :: XWSNOW, XRSNOW, XTSNOW, 
00084                                     XSG1SNOW, XSG2SNOW, XHISTSNOW, XAGESNOW
00085 INTEGER           :: JLAYER
00086 !
00087 LOGICAL           :: LFILE
00088 !
00089 LOGICAL           :: GFOUND         ! Return code when searching namelist
00090 INTEGER           :: ILUOUT         ! output file logical unit
00091 INTEGER           :: ILUNAM         ! namelist file logical unit
00092 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00093 !-------------------------------------------------------------------------------
00094 NAMELIST/NAM_PREP_ISBA_SNOW/CSNOW, NSNOW_LAYER, CFILE_SNOW, CTYPE_SNOW,  &
00095                             LSNOW_IDEAL, LSNOW_FRAC_TOT,                 &
00096                             XWSNOW, XTSNOW, XRSNOW, XASNOW,              &
00097                             XSG1SNOW, XSG2SNOW, XHISTSNOW, XAGESNOW
00098 !-------------------------------------------------------------------------------
00099 !* default
00100 !  -------
00101 !
00102 IF (LHOOK) CALL DR_HOOK('READ_PREP_ISBA_SNOW',0,ZHOOK_HANDLE)
00103 IF (LNAM_READ) THEN
00104   !
00105   CSNOW = 'D95'
00106   NSNOW_LAYER = 1
00107   !
00108   CFILE_SNOW    = '                         '
00109   CTYPE_SNOW    = '      '
00110   !
00111   LSNOW_IDEAL = .FALSE.
00112   LSNOW_FRAC_TOT = .FALSE.
00113   !
00114   XWSNOW(:) = XUNDEF
00115   XRSNOW(:) = XUNDEF  
00116   XTSNOW(:) = XTT  
00117   XASNOW = XANSMIN
00118   XSG1SNOW(:) = XUNDEF
00119   XSG2SNOW(:) = XUNDEF
00120   XHISTSNOW(:) = XUNDEF
00121   XAGESNOW(:) = XUNDEF  
00122   !
00123   CALL GET_LUOUT(HPROGRAM,ILUOUT)
00124   CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00125   !
00126   !* reading of namelist
00127   !  -------------------
00128   !
00129   CALL POSNAM(ILUNAM,'NAM_PREP_ISBA_SNOW',GFOUND,ILUOUT)
00130   IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PREP_ISBA_SNOW)
00131   !
00132   CALL TEST_NAM_VAR_SURF(ILUOUT,'CSNOW',CSNOW,'D95','3-L','EBA','CRO','NON')
00133   !
00134   IF (CSNOW=='NON') NSNOW_LAYER = 0
00135   !
00136   IF (CSNOW=='D95' .OR. CSNOW=='EBA') NSNOW_LAYER = 1
00137   !
00138   IF ((CSNOW=='3-L' .OR. CSNOW=='CRO') .AND. NSNOW_LAYER<=2) NSNOW_LAYER = 3
00139   !
00140   IF (CSNOW=='3-L' .AND. NSNOW_LAYER>3) THEN
00141     NSNOW_LAYER = 3
00142     WRITE(ILUOUT,*) '------------------------------------'
00143     WRITE(ILUOUT,*) 'With ISBA-ES, number of snow layers '
00144     WRITE(ILUOUT,*) 'cannot be more than 3.              '
00145     WRITE(ILUOUT,*) 'So it is forced to 3 here.          '
00146     WRITE(ILUOUT,*) '------------------------------------'
00147   ENDIF
00148   !
00149   IF (NSNOW_LAYER > NSNOW_LAYER_MAX) THEN
00150     WRITE(ILUOUT,*) '------------------------------------'
00151     WRITE(ILUOUT,*) 'Please update modd_prep_snow.f90 routine : '
00152     WRITE(ILUOUT,*) 'The maximum number of snow layers  '
00153     WRITE(ILUOUT,*) 'in the declaration of the namelist variables '
00154     WRITE(ILUOUT,*) 'must be decreased to : ', NSNOW_LAYER_MAX
00155     WRITE(ILUOUT,*) '------------------------------------'
00156     CALL ABOR1_SFX('READ_PREP_ISBA_SNOW: NUMBER OF SNOW LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
00157   ENDIF
00158   !
00159   IF(NSNOW_LAYER>=3)THEN
00160     IF(XWSNOW(1)/=XUNDEF.AND.ANY(XWSNOW(2:NSNOW_LAYER)==XUNDEF))THEN
00161       WHERE(XWSNOW(2:NSNOW_LAYER)==XUNDEF)XWSNOW(2:NSNOW_LAYER)=0.0
00162     ENDIF
00163     IF(XRSNOW(1)/=XUNDEF.AND.ANY(XRSNOW(2:NSNOW_LAYER)==XUNDEF))THEN
00164       WHERE(XRSNOW(2:NSNOW_LAYER)==XUNDEF)XRSNOW(2:NSNOW_LAYER)=XRSNOW(1)
00165     ENDIF    
00166   ENDIF
00167   !
00168   ALLOCATE(XWSNOW_p(NSNOW_LAYER))
00169   ALLOCATE(XRSNOW_p(NSNOW_LAYER))
00170   ALLOCATE(XTSNOW_p(NSNOW_LAYER))
00171   !
00172   XWSNOW_p=XWSNOW(1:NSNOW_LAYER)
00173   XRSNOW_p=XRSNOW(1:NSNOW_LAYER)
00174   XTSNOW_p=XTSNOW(1:NSNOW_LAYER)
00175   !
00176   IF (CSNOW=='CRO') THEN
00177     !
00178     ALLOCATE(XSG1SNOW_p (NSNOW_LAYER))
00179     ALLOCATE(XSG2SNOW_p (NSNOW_LAYER))
00180     ALLOCATE(XHISTSNOW_p(NSNOW_LAYER))
00181     ALLOCATE(XAGESNOW_p (NSNOW_LAYER))
00182     !
00183     XSG1SNOW_p =XSG1SNOW (1:NSNOW_LAYER)
00184     XSG2SNOW_p =XSG2SNOW (1:NSNOW_LAYER)
00185     XHISTSNOW_p=XHISTSNOW(1:NSNOW_LAYER)
00186     XAGESNOW_p =XAGESNOW (1:NSNOW_LAYER)
00187     !
00188     DO JLAYER=1,NSNOW_LAYER
00189       IF ((XSG1SNOW_p (JLAYER)==XUNDEF .OR. XSG2SNOW_p(JLAYER)==XUNDEF .OR. &
00190            XHISTSNOW_p(JLAYER)==XUNDEF .OR. XAGESNOW_p(JLAYER)==XUNDEF) &
00191            .AND. XWSNOW_p(JLAYER).NE.0. .AND. XWSNOW_p(JLAYER)/=XUNDEF ) THEN
00192         WRITE(ILUOUT,*) '----------------------------'
00193         WRITE(ILUOUT,*) 'WSNOW/=0 AND ONE OF SG1SNOW,'
00194         WRITE(ILUOUT,*) 'SG2SNOW, HISTSNOW OR AGESNOW'
00195         WRITE(ILUOUT,*) '         ==XUNDEF           '
00196         WRITE(ILUOUT,*) '    PLEASE CORRECT THAT     '
00197         WRITE(ILUOUT,*) '----------------------------'
00198         CALL ABOR1_SFX('READ_PREP_ISBA_SNOW: ERROR IN INITIALISATION OF SNOW PARAMETERS')
00199       ENDIF
00200     ENDDO
00201     !
00202   ELSE
00203     !
00204     ALLOCATE(XSG1SNOW_p (0))
00205     ALLOCATE(XSG2SNOW_p (0))
00206     ALLOCATE(XHISTSNOW_p(0))
00207     ALLOCATE(XAGESNOW_p (0))
00208     !
00209   ENDIF
00210   !
00211   CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00212   !
00213 ENDIF
00214 !
00215 HSNOW = CSNOW
00216 !
00217 KSNOW_LAYER = NSNOW_LAYER
00218 !
00219 IF(ALL(XWSNOW_p(:)==XUNDEF).AND.PRESENT(OUNIF))THEN
00220     OUNIF=.FALSE.
00221 ELSEIF(PRESENT(OUNIF))THEN
00222     OUNIF=.TRUE.
00223 ENDIF
00224 !
00225 LFILE=(LEN_TRIM(CFILE_SNOW)>0.AND.LEN_TRIM(CTYPE_SNOW)>0)
00226 !
00227 IF(PRESENT(HFILE))THEN 
00228   IF(LFILE)THEN
00229      HFILE = CFILE_SNOW
00230   ELSE
00231      HFILE = '                         '
00232   ENDIF
00233 ENDIF
00234 IF(PRESENT(HFILETYPE))THEN 
00235   IF(LFILE)THEN
00236      HFILETYPE = CTYPE_SNOW
00237   ELSE
00238      HFILETYPE = '      '
00239   ENDIF
00240 ENDIF
00241 IF (LFILE.AND.PRESENT(OUNIF)) OUNIF=.FALSE.
00242 !
00243 IF (LHOOK) CALL DR_HOOK('READ_PREP_ISBA_SNOW',1,ZHOOK_HANDLE)
00244 !
00245 !-------------------------------------------------------------------------------
00246 !-------------------------------------------------------------------------------
00247 !
00248 END SUBROUTINE READ_PREP_ISBA_SNOW