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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_PREP_TEB_GARDEN_CONF(HPROGRAM,HVAR,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
00003                                            HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
00004 !     #######################################################
00005 !
00006 !!****  *READ_PREP_TEB_GARDEN_CONF* - routine to read the configuration for ISBA
00007 !!                              fields preparation
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!**  METHOD
00013 !!    ------
00014 !!
00015 !!    EXTERNAL
00016 !!    --------
00017 !!
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!      V. Masson   *Meteo France*      
00029 !!
00030 !!    MODIFICATIONS
00031 !!    -------------
00032 !!      Original    01/2004
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 USE MODI_READ_PREP_SURF_ATM_CONF
00039 !
00040 USE MODN_PREP_TEB_GARDEN
00041 USE MODD_PREP_TEB_GARDEN, ONLY : CFILE_ISBA, CTYPE, CFILEPGD_ISBA, CTYPEPGD,      &
00042                                  CFILE_HUG, CTYPE_HUG,                            &
00043                                  CFILE_HUG_SURF, CFILE_HUG_ROOT, CFILE_HUG_DEEP,  &
00044                                  XHUG_SURF, XHUG_ROOT, XHUG_DEEP,                 &
00045                                  XHUGI_SURF, XHUGI_ROOT, XHUGI_DEEP,              &
00046                                  CFILE_TG, CTYPE_TG,                              &
00047                                  CFILE_TG_SURF, CFILE_TG_ROOT, CFILE_TG_DEEP,     &
00048                                  XTG_SURF, XTG_ROOT, XTG_DEEP  
00049 !
00050 USE MODD_SURF_PAR,   ONLY : XUNDEF
00051 !
00052 !
00053 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00054 USE PARKIND1  ,ONLY : JPRB
00055 !
00056 USE MODI_ABOR1_SFX
00057 !
00058 IMPLICIT NONE
00059 !
00060 !*       0.1   Declarations of arguments
00061 !              -------------------------
00062 !
00063  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM    ! program calling
00064  CHARACTER(LEN=7),  INTENT(IN)  :: HVAR        ! variable treated
00065  CHARACTER(LEN=28), INTENT(OUT) :: HFILE       ! file name
00066  CHARACTER(LEN=6),  INTENT(OUT) :: HFILETYPE   ! file type
00067  CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD    ! file name
00068  CHARACTER(LEN=6),  INTENT(OUT) :: HFILEPGDTYPE! file type
00069  CHARACTER(LEN=28), INTENT(IN)  :: HATMFILE    ! atmospheric file name
00070  CHARACTER(LEN=6),  INTENT(IN)  :: HATMFILETYPE! atmospheric file type
00071  CHARACTER(LEN=28), INTENT(IN)  :: HPGDFILE    ! atmospheric file name
00072  CHARACTER(LEN=6),  INTENT(IN)  :: HPGDFILETYPE! atmospheric file type
00073 INTEGER,           INTENT(IN)  :: KLUOUT      ! logical unit of output listing
00074 LOGICAL,           INTENT(OUT) :: OUNIF       ! flag for prescribed uniform field
00075 
00076 !
00077 !*       0.2   Declarations of local variables
00078 !              -------------------------------
00079 !
00080 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears 
00081                                     ! at the open of the file in LFI  routines 
00082 INTEGER           :: ILUNAM         ! Logical unit of namelist file
00083 !
00084  CHARACTER(LEN=28) :: YNAMELIST      ! namelist file
00085 !
00086 LOGICAL           :: GFOUND         ! Return code when searching namelist
00087 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00088 !-------------------------------------------------------------------------------
00089 !
00090 !
00091 IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_GARDEN_CONF',0,ZHOOK_HANDLE)
00092 HFILE    = '                         '
00093 HFILETYPE    = '      '
00094 !
00095 HFILEPGD = '                         '
00096 HFILEPGDTYPE = '      '
00097 !
00098 OUNIF    = .FALSE.
00099 !
00100 !-------------------------------------------------------------------------------
00101 !
00102 !* choice of input file
00103 !  --------------------
00104 !
00105 SELECT CASE (HVAR)
00106   CASE ('WG     ','WGI    ')
00107     IF (LEN_TRIM(CFILE_HUG)>0 .AND. LEN_TRIM(CTYPE_HUG)>0 ) THEN
00108       HFILE     = CFILE_HUG
00109       HFILETYPE = CTYPE_HUG
00110     END IF
00111   CASE ('TG     ')
00112     IF (LEN_TRIM(CFILE_TG)>0 .AND. LEN_TRIM(CTYPE_TG)>0 ) THEN
00113       HFILE     = CFILE_TG
00114       HFILETYPE = CTYPE_TG
00115     END IF
00116 END SELECT
00117 !
00118 IF (LEN_TRIM(HFILE)==0 .AND. LEN_TRIM(CFILE_ISBA)>0 .AND. LEN_TRIM(CTYPE)>0) THEN
00119   HFILE     = CFILE_ISBA
00120   HFILETYPE = CTYPE
00121 END IF
00122 !
00123 IF (LEN_TRIM(HFILEPGD)==0 .AND. LEN_TRIM(CFILEPGD_ISBA)>0 .AND. LEN_TRIM(CTYPEPGD)>0) THEN
00124   HFILEPGD     = CFILEPGD_ISBA
00125   HFILEPGDTYPE = CTYPEPGD
00126 END IF
00127 !
00128 !! If no file name in the scheme namelist,
00129 !! try to find a name in NAM_SURF_ATM
00130 !
00131 IF (LEN_TRIM(HFILE)==0) THEN
00132 !
00133  CALL READ_PREP_SURF_ATM_CONF(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
00134                              HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT)
00135 !
00136 END IF
00137 !
00138 !! If no file name in the scheme namelist,
00139 !! nor in NAM_SURF_ATM, look if ascii input files are present
00140 !
00141 SELECT CASE (HVAR)
00142   CASE ('WG     ','WGI    ')
00143     IF ( LEN_TRIM(CTYPE_HUG )>0       .AND. &
00144            LEN_TRIM(CFILE_HUG_SURF)>0   .AND. &
00145            LEN_TRIM(CFILE_HUG_ROOT)>0   .AND. &
00146            LEN_TRIM(CFILE_HUG_DEEP)>0         ) THEN  
00147        HFILETYPE = CTYPE_HUG 
00148     END IF
00149     IF (HVAR=='WGI    ' .AND. HFILETYPE=='ASCLLV') THEN
00150        OUNIF = .TRUE.
00151        IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_GARDEN_CONF',1,ZHOOK_HANDLE)
00152        RETURN
00153     ENDIF
00154   CASE ('TG     ')
00155     IF ( LEN_TRIM(CTYPE_TG )>0       .AND. &
00156            LEN_TRIM(CFILE_TG_SURF)>0   .AND. &
00157            LEN_TRIM(CFILE_TG_ROOT)>0   .AND. &
00158            LEN_TRIM(CFILE_TG_DEEP)>0         ) THEN  
00159        HFILETYPE = CTYPE_TG 
00160     END IF
00161 END SELECT
00162 !
00163 !-------------------------------------------------------------------------------
00164 !
00165 !* Is an uniform field prescribed?
00166 !  ------------------------------
00167 !
00168 SELECT CASE (HVAR)
00169   CASE ('WG     ')
00170     OUNIF = (XHUG_SURF/=XUNDEF) .OR. (XHUG_ROOT/=XUNDEF) .OR. (XHUG_DEEP/=XUNDEF)
00171     IF (OUNIF .AND. (XHUG_SURF==XUNDEF)) THEN
00172        WRITE(KLUOUT,*)'ONE OF XHUG_SURF, XHUG_ROOT OR XHUG_DEEP IS GIVEN'
00173        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XHUG_SURF MUST BE SET')
00174     END IF
00175     IF (OUNIF .AND. (XHUG_ROOT==XUNDEF)) THEN
00176        WRITE(KLUOUT,*)'ONE OF XHUG_SURF, XHUG_ROOT OR XHUG_DEEP IS GIVEN'
00177        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XHUG_ROOT MUST BE SET')
00178     END IF
00179     IF (OUNIF .AND. (XHUG_DEEP==XUNDEF)) THEN
00180        WRITE(KLUOUT,*)'ONE OF XHUG_SURF, XHUG_ROOT OR XHUG_DEEP IS GIVEN'
00181        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XHUG_DEEP MUST BE SET')
00182     END IF
00183      !
00184       CASE ('WGI    ')
00185     OUNIF = (XHUGI_SURF/=XUNDEF) .OR. (XHUGI_ROOT/=XUNDEF) .OR. (XHUGI_DEEP/=XUNDEF)
00186     IF (OUNIF .AND. (XHUGI_SURF==XUNDEF)) THEN
00187        WRITE(KLUOUT,*)'ONE OF XHUGI_SURF, XHUGI_ROOT OR XHUGI_DEEP IS GIVEN'
00188        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XHUGI_SURF MUST BE SET')
00189     END IF
00190     IF (OUNIF .AND. (XHUGI_ROOT==XUNDEF)) THEN
00191        WRITE(KLUOUT,*)'ONE OF XHUGI_SURF, XHUGI_ROOT OR XHUGI_DEEP IS GIVEN'
00192        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XHUGI_ROOT MUST BE SET')
00193     END IF
00194     IF (OUNIF .AND. (XHUGI_DEEP==XUNDEF)) THEN
00195        WRITE(KLUOUT,*)'ONE OF XHUGI_SURF, XHUGI_ROOT OR XHUGI_DEEP IS GIVEN'
00196        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XHUGI_DEEP MUST BE SET')
00197     END IF
00198     !
00199   CASE ('TG     ')
00200     OUNIF = (XTG_SURF/=XUNDEF)  .OR. (XTG_ROOT/=XUNDEF)  .OR. (XTG_DEEP/=XUNDEF)
00201     IF (OUNIF .AND. (XTG_SURF==XUNDEF)) THEN
00202        WRITE(KLUOUT,*)'ONE OF XTG_SURF, XTG_ROOT OR XTG_DEEP IS GIVEN'
00203        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XTG_SURF MUST BE SET')
00204     END IF
00205     IF (OUNIF .AND. (XTG_ROOT==XUNDEF)) THEN
00206        WRITE(KLUOUT,*)'ONE OF XTG_SURF, XTG_ROOT OR XTG_DEEP IS GIVEN'
00207        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XTG_ROOT MUST BE SET')
00208     END IF
00209     IF (OUNIF .AND. (XTG_DEEP==XUNDEF)) THEN
00210        WRITE(KLUOUT,*)'ONE OF XTG_SURF, XTG_ROOT OR XTG_DEEP IS GIVEN'
00211        CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: XTG_DEEP MUST BE SET')
00212     END IF
00213     !
00214 
00215 END SELECT
00216 !
00217 !-------------------------------------------------------------------------------
00218 !
00219 !* If no file and no uniform field is prescribed: default values used
00220 !  ---------------------------------------------
00221 !
00222 IF (LEN_TRIM(HFILETYPE)==0 .AND. .NOT. OUNIF) THEN
00223   IF (HVAR(1:2)/='TG' .AND. HVAR(1:2)/='WG' .OR. HVAR(1:3)=='WGI') THEN
00224     IF (HVAR(1:2)/='ZS') WRITE(KLUOUT,*) 'NO FILE FOR FIELD ',HVAR, &
00225                                         ': UNIFORM DEFAULT FIELD IS PRESCRIBED'
00226     IF (HVAR(1:3)=='WGI') THEN
00227       XHUGI_SURF = 0.
00228       XHUGI_ROOT = 0.
00229       XHUGI_DEEP = 0.
00230     ENDIF                                         
00231     OUNIF = .TRUE.
00232     IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_GARDEN_CONF',1,ZHOOK_HANDLE)
00233     RETURN
00234   ELSE
00235     WRITE(KLUOUT,*) 'AN INPUT FILE OR A UNIFORM VALUE IS REQUIRED FOR FIELD: ',HVAR
00236     WRITE(KLUOUT,*) 'Please complete NAM_PREP_TEB_GARDEN'
00237     CALL ABOR1_SFX('READ_PREP_TEB_GARDEN_CONF: AN INPUT FILE OR A UNIFORM VALUE IS REQUIRED FOR '//HVAR)
00238   END IF
00239 END IF
00240 IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_GARDEN_CONF',1,ZHOOK_HANDLE)
00241 !-------------------------------------------------------------------------------
00242 !
00243 END SUBROUTINE READ_PREP_TEB_GARDEN_CONF