SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/prep_hor_flake_field.F90
Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE PREP_HOR_FLAKE_FIELD(HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,&
00003                                 HPGDFILE,HPGDFILETYPE,ONOVALUE)
00004 !     #################################################################################
00005 !
00006 !!****  *PREP_HOR_FLAKE_FIELD* - Reads, interpolates and prepares a water field
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    REFERENCE
00015 !!    ---------
00016 !!      
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!     S. Malardel
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    01/2004
00025 !!      P. Le Moigne 10/2005, Phasage Arome
00026 !!      E. Kourzeneva 09/2010, Make possible to interpolate 
00027 !!                             only lake surface temperature, 
00028 !!                             but not profiles
00029 !!------------------------------------------------------------------
00030 !
00031 !
00032 !
00033 USE MODD_SURF_PAR,     ONLY : XUNDEF
00034 USE MODD_PREP,         ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
00035                                XX_OUT, XY_OUT, CMASK
00036 USE MODD_FLAKE_n,      ONLY : XZS, XTS, XT_SNOW, XT_ICE, XT_MNW, XT_WML, &
00037                               XT_BOT, XT_B1,   &
00038                               XCT, XH_SNOW, XH_ICE, XH_ML, XH_B1,   &
00039 ! Water depth is needed in order to compute XCT. 
00040 !salgado - check if XWATER_DEPTH is initialized during prep!
00041                             XWATER_DEPTH
00042 !
00043 USE MODD_FLAKE_GRID_n, ONLY : XLAT, XLON
00044 !
00045 USE MODD_CSTS,       ONLY : XTT
00046 USE MODD_PREP_FLAKE, ONLY : LCLIM_LAKE
00047 !
00048 USE MODI_READ_PREP_FLAKE_CONF
00049 USE MODI_PREP_FLAKE_GRIB
00050 USE MODI_PREP_FLAKE_ASCLLV
00051 USE MODI_PREP_FLAKE_UNIF
00052 USE MODI_PREP_FLAKE_BUFFER
00053 USE MODI_HOR_INTERPOL
00054 USE MODI_GET_LUOUT
00055 USE MODI_PREP_FLAKE_EXTERN
00056 !
00057 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00058 USE PARKIND1  ,ONLY : JPRB
00059 !
00060 USE MODI_ABOR1_SFX
00061 IMPLICIT NONE
00062 !
00063 !*      0.1    declarations of arguments
00064 !
00065  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00066  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
00067  CHARACTER(LEN=28),  INTENT(IN)  :: HATMFILE    ! name of the Atmospheric file
00068  CHARACTER(LEN=6),   INTENT(IN)  :: HATMFILETYPE! type of the Atmospheric file
00069  CHARACTER(LEN=28),  INTENT(IN)  :: HPGDFILE    ! name of the Atmospheric file
00070  CHARACTER(LEN=6),   INTENT(IN)  :: HPGDFILETYPE! type of the Atmospheric file
00071 LOGICAL, OPTIONAL, INTENT(OUT) :: ONOVALUE  ! flag for the not given value
00072 !
00073 !
00074 !*      0.2    declarations of local variables
00075 !
00076  CHARACTER(LEN=6)              :: YFILETYPE ! type of input file
00077  CHARACTER(LEN=28)             :: YFILE     ! name of file
00078  CHARACTER(LEN=6)              :: YFILEPGDTYPE ! type of input file
00079  CHARACTER(LEN=28)             :: YFILEPGD     ! name of file
00080 REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN  ! field to interpolate horizontally
00081 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated   horizontally
00082 INTEGER                       :: ILUOUT    ! output listing logical unit
00083 !
00084 LOGICAL                       :: GUNIF     ! flag for prescribed uniform field
00085 LOGICAL                       :: GDEFAULT  ! flag for prescribed default field
00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00087 !-------------------------------------------------------------------------------------
00088 !
00089 !
00090 !*      1.     Reading of input file name and type
00091 !
00092 IF (LHOOK) CALL DR_HOOK('PREP_HOR_FLAKE_FIELD',0,ZHOOK_HANDLE)
00093  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00094 !
00095  CALL READ_PREP_FLAKE_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
00096                           HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
00097 !
00098 CMASK = 'WATER'
00099 !
00100 GDEFAULT = (YFILETYPE=='      ' .OR. (HSURF(1:2)/='ZS' .AND. HSURF(1:2)/='TS' &
00101                 .AND. SIZE(XLAT).NE.1)) .AND. .NOT.GUNIF
00102 IF (PRESENT(ONOVALUE)) ONOVALUE = GDEFAULT
00103 !
00104 IF (.NOT. GDEFAULT) THEN
00105 !
00106 !-------------------------------------------------------------------------------------
00107 !
00108 !*      2.     Reading of input  configuration (Grid and interpolation type)
00109 !
00110   IF (GUNIF) THEN
00111     CALL PREP_FLAKE_UNIF(ILUOUT,HSURF,ZFIELDIN)
00112   ELSE IF (YFILETYPE=='ASCLLV') THEN
00113     CALL PREP_FLAKE_ASCLLV(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
00114   ELSE IF (YFILETYPE=='GRIB  ') THEN
00115     CALL PREP_FLAKE_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
00116   ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI   ') THEN
00117     CALL PREP_FLAKE_EXTERN(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
00118   ELSE IF (YFILETYPE=='BUFFER') THEN
00119     CALL PREP_FLAKE_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
00120   ELSE
00121     CALL ABOR1_SFX('PREP_HOR_FLAKE_FIELD: data file type not supported : '//YFILETYPE)
00122   END IF
00123 !
00124 !
00125 !*      4.     Horizontal interpolation
00126 !
00127   !ALLOCATE(ZFIELDOUT(SIZE(XLAT),SIZE(ZFIELDIN,2)))
00128   ALLOCATE(ZFIELDOUT(SIZE(XLAT),1))
00129 !
00130 !Impossible to interpolate lake profiles, only the lake surface temperature! 
00131 !But in uniform case and 1 point case
00132   IF(GUNIF .OR. SIZE(XLAT).EQ.1) THEN
00133     CALL HOR_INTERPOL(ILUOUT,ZFIELDIN,ZFIELDOUT)
00134   ELSE IF(HSURF(1:2)=='ZS' .OR. HSURF(1:2)=='TS') THEN
00135     WRITE(ILUOUT,*) "WARNING! Impossible to interpolate lake profiles in horisontal!"
00136     WRITE(ILUOUT,*) "So, interoplate only surface temperature and start from lakes mixed down to the bottom"
00137     CALL HOR_INTERPOL(ILUOUT,ZFIELDIN,ZFIELDOUT)
00138   END IF
00139 !
00140 !*      5.     Return to historical variable
00141 !
00142   SELECT CASE (HSURF)
00143    CASE('ZS     ') 
00144     ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
00145     XZS_LS(:) = ZFIELDOUT(:,1)
00146    CASE('TS     ')
00147     ALLOCATE(XTS(SIZE(ZFIELDOUT,1)))
00148     XTS(:) = ZFIELDOUT(:,1)
00149    CASE('T_SNOW ')
00150     ALLOCATE(XT_SNOW(SIZE(ZFIELDOUT,1)))
00151     XT_SNOW(:) = ZFIELDOUT(:,1)
00152    CASE('T_ICE  ')
00153     ALLOCATE(XT_ICE(SIZE(ZFIELDOUT,1)))
00154     XT_ICE(:) = ZFIELDOUT(:,1)
00155    CASE('T_WML  ')
00156     ALLOCATE(XT_WML(SIZE(ZFIELDOUT,1)))
00157     XT_WML(:) = ZFIELDOUT(:,1)
00158    CASE('T_BOT  ')
00159     ALLOCATE(XT_BOT(SIZE(ZFIELDOUT,1)))
00160     XT_BOT(:) = ZFIELDOUT(:,1)
00161    CASE('T_B1   ')
00162     ALLOCATE(XT_B1(SIZE(ZFIELDOUT,1)))
00163     XT_B1(:) = ZFIELDOUT(:,1)
00164    CASE('CT     ')
00165     ALLOCATE(XCT(SIZE(ZFIELDOUT,1)))
00166     XCT(:) = ZFIELDOUT(:,1)
00167    CASE('H_SNOW ')
00168     ALLOCATE(XH_SNOW(SIZE(ZFIELDOUT,1)))
00169     XH_SNOW(:) = ZFIELDOUT(:,1)
00170    CASE('H_ICE  ')
00171     ALLOCATE(XH_ICE(SIZE(ZFIELDOUT,1)))
00172     XH_ICE(:) = ZFIELDOUT(:,1)
00173    CASE('H_ML   ')
00174     ALLOCATE(XH_ML(SIZE(ZFIELDOUT,1)))
00175     XH_ML(:) = ZFIELDOUT(:,1)
00176    CASE('H_B1   ')
00177     ALLOCATE(XH_B1(SIZE(ZFIELDOUT,1)))
00178     XH_B1(:) = ZFIELDOUT(:,1)
00179   END SELECT
00180 !*      6.     Deallocations
00181 !
00182   IF (ALL(ZFIELDOUT==XUNDEF)) GDEFAULT = .TRUE.
00183 !
00184   DEALLOCATE(ZFIELDIN )
00185   DEALLOCATE(ZFIELDOUT)
00186 !
00187 END IF
00188 
00189 !
00190 IF (GDEFAULT) THEN
00191 !
00192 !*      7.    Initial values of FLAKE variables are computed from TS
00193 !             when uniform values are not prescribed 
00194   IF (HSURF(1:2)/='ZS') WRITE(ILUOUT,*) 'NO FILE FOR FIELD ',HSURF, &
00195                                         ': UNIFORM DEFAULT FIELD IS PRESCRIBED'
00196   
00197 END IF
00198 !
00199 IF (LHOOK) CALL DR_HOOK('PREP_HOR_FLAKE_FIELD',1,ZHOOK_HANDLE)
00200 !
00201 !-------------------------------------------------------------------------------------
00202 !
00203 END SUBROUTINE PREP_HOR_FLAKE_FIELD