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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE PREP_SNOW_UNIF(KLUOUT,HSURF,PFIELD, TPTIME,  &
00003                           OSNOW_IDEAL,                  &
00004                           PUNIF_WSNOW, PUNIF_RSNOW,     &
00005                           PUNIF_TSNOW, PUNIF_ASNOW,     &
00006                           PUNIF_SG1SNOW, PUNIF_SG2SNOW, &
00007                           PUNIF_HISTSNOW,PUNIF_AGESNOW  )  
00008 !     #################################################################################
00009 !
00010 !!****  *PREP_SNOW_UNIF* - prepares snow field from prescribed values
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    REFERENCE
00019 !!    ---------
00020 !!      
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!     V. Masson 
00025 !!
00026 !!    MODIFICATIONS
00027 !!    -------------
00028 !!      Original    01/2004
00029 !!      M. Lafaysse adaptation with new snow age
00030 !!------------------------------------------------------------------
00031 !
00032 !
00033 USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
00034 !
00035 USE MODD_SURF_PAR,       ONLY : XUNDEF
00036 USE MODD_PREP,           ONLY : CINTERP_TYPE
00037 USE MODD_PREP_SNOW,      ONLY : NGRID_LEVEL
00038 !
00039 USE MODI_SNOW_T_WLIQ_TO_HEAT
00040 !
00041 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00042 USE PARKIND1  ,ONLY : JPRB
00043 !
00044 USE MODI_ABOR1_SFX
00045 !
00046 IMPLICIT NONE
00047 !
00048 !*      0.1    declarations of arguments
00049 !
00050 INTEGER,            INTENT(IN)  :: KLUOUT    ! output listing logical unit
00051  CHARACTER(LEN=10),  INTENT(IN)  :: HSURF     ! type of field
00052 REAL, POINTER, DIMENSION(:,:,:) :: PFIELD    ! field to interpolate horizontally
00053 TYPE(DATE_TIME),    INTENT(IN)  :: TPTIME    ! date and time
00054 LOGICAL,            INTENT(IN)  :: OSNOW_IDEAL
00055 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_WSNOW ! prescribed snow content (kg/m2)
00056 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_RSNOW ! prescribed density (kg/m3)
00057 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_TSNOW ! prescribed temperature (K)
00058 REAL,               INTENT(IN)  :: PUNIF_ASNOW ! prescribed albedo (-)
00059 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_SG1SNOW ! 
00060 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_SG2SNOW ! 
00061 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_HISTSNOW ! 
00062 REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_AGESNOW ! 
00063 !
00064 !*      0.2    declarations of local variables
00065 !
00066 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW, ZRSNOW
00067 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00068 !
00069 !-------------------------------------------------------------------------------------
00070 !
00071 !
00072 IF (LHOOK) CALL DR_HOOK('PREP_SNOW_UNIF',0,ZHOOK_HANDLE)
00073 !
00074 IF (OSNOW_IDEAL) THEN
00075   ALLOCATE(PFIELD(1,SIZE(PUNIF_WSNOW),1))
00076   ALLOCATE(ZTSNOW(1,SIZE(PUNIF_WSNOW),1))
00077   ALLOCATE(ZRSNOW(1,SIZE(PUNIF_WSNOW),1))
00078 ELSE
00079   ALLOCATE(PFIELD(1,NGRID_LEVEL,1))
00080   ALLOCATE(ZTSNOW(1,NGRID_LEVEL,1))
00081   ALLOCATE(ZRSNOW(1,NGRID_LEVEL,1))
00082 ENDIF
00083 !
00084 !*      1.     No snow
00085 !              -------
00086 !
00087 IF (ANY(PUNIF_RSNOW(:)==0. .AND. PUNIF_WSNOW(:)/=0.)) THEN 
00088   WRITE(KLUOUT,*)'XWSNOW/=0. AND RSNOW=0.'
00089   CALL ABOR1_SFX('PREP_SNOW_UNIF: WITH XWSNOW/=0., RSNOW MUST NOT BE 0.')
00090 END IF
00091 !
00092 !*      2.     Snow prescribed
00093 !              ---------------
00094 !
00095 SELECT CASE(HSURF(1:3))
00096 !
00097   CASE('WWW')
00098     IF (OSNOW_IDEAL) THEN
00099       PFIELD(1,:,1) = PUNIF_WSNOW(:)
00100     ELSE
00101       PFIELD(1,:,1) = PUNIF_WSNOW(1)
00102     ENDIF
00103   CASE('RHO')
00104     IF (OSNOW_IDEAL) THEN
00105       PFIELD(1,:,1) = PUNIF_RSNOW(:)
00106     ELSE
00107       PFIELD(1,:,1) = PUNIF_RSNOW(1)
00108     ENDIF               
00109   CASE('ALB')          
00110     PFIELD = PUNIF_ASNOW
00111   CASE('DEP')
00112     IF (OSNOW_IDEAL) THEN
00113       PFIELD(1,:,1) = PUNIF_WSNOW(:)/PUNIF_RSNOW(:)
00114     ELSE
00115       PFIELD(1,:,1) = PUNIF_WSNOW(1)/PUNIF_RSNOW(1)
00116     ENDIF              
00117   CASE('HEA')
00118     IF (OSNOW_IDEAL) THEN
00119       ZRSNOW(1,:,1) = PUNIF_RSNOW(:)
00120       ZTSNOW(1,:,1) = PUNIF_TSNOW(:)
00121     ELSE
00122       ZRSNOW(1,:,1) = PUNIF_RSNOW(1)
00123       ZTSNOW(1,:,1) = PUNIF_TSNOW(1)
00124     ENDIF
00125     CALL SNOW_T_WLIQ_TO_HEAT(PFIELD,ZRSNOW,ZTSNOW)
00126   CASE('SG1')
00127     IF (OSNOW_IDEAL) THEN
00128       PFIELD(1,:,1) = PUNIF_SG1SNOW(:)
00129     ELSE
00130       PFIELD(1,:,1) = PUNIF_SG1SNOW(1)
00131     ENDIF 
00132   CASE('SG2')
00133     IF (OSNOW_IDEAL) THEN
00134       PFIELD(1,:,1) = PUNIF_SG2SNOW(:)
00135     ELSE
00136       PFIELD(1,:,1) = PUNIF_SG2SNOW(1)
00137     ENDIF 
00138   CASE('HIS')
00139     IF (OSNOW_IDEAL) THEN
00140       PFIELD(1,:,1) = PUNIF_HISTSNOW(:)
00141     ELSE
00142       PFIELD(1,:,1) = PUNIF_HISTSNOW(1)
00143     ENDIF     
00144   CASE('AGE')
00145     IF (OSNOW_IDEAL) THEN
00146       PFIELD(1,:,1) = PUNIF_AGESNOW(:)
00147     ELSE
00148       PFIELD(1,:,1) = PUNIF_AGESNOW(1)
00149     ENDIF           
00150   !
00151 END SELECT
00152 !
00153 !*      2.     Interpolation method
00154 !              --------------------
00155 !
00156 CINTERP_TYPE='UNIF  '
00157 IF (LHOOK) CALL DR_HOOK('PREP_SNOW_UNIF',1,ZHOOK_HANDLE)
00158 !
00159 !-------------------------------------------------------------------------------------
00160 END SUBROUTINE PREP_SNOW_UNIF