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_CONF(HPROGRAM,HVAR,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
00003                                      HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
00004 !     #######################################################
00005 !
00006 !!****  *READ_PREP_ISBA_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_ISBA
00041 USE MODD_PREP_ISBA,  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                             XWSNOW, XTSNOW, XRSNOW, XASNOW
00050 !
00051 USE MODD_SURF_PAR,   ONLY : XUNDEF
00052 !
00053 !
00054 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00055 USE PARKIND1  ,ONLY : JPRB
00056 !
00057 USE MODI_ABOR1_SFX
00058 !
00059 IMPLICIT NONE
00060 !
00061 !*       0.1   Declarations of arguments
00062 !              -------------------------
00063 !
00064  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM    ! program calling ISBA
00065  CHARACTER(LEN=7),  INTENT(IN)  :: HVAR        ! variable treated
00066  CHARACTER(LEN=28), INTENT(OUT) :: HFILE       ! file name
00067  CHARACTER(LEN=6),  INTENT(OUT) :: HFILETYPE   ! file type
00068  CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD    ! file name
00069  CHARACTER(LEN=6),  INTENT(OUT) :: HFILEPGDTYPE! file type
00070  CHARACTER(LEN=28), INTENT(IN)  :: HATMFILE    ! atmospheric file name
00071  CHARACTER(LEN=6),  INTENT(IN)  :: HATMFILETYPE! atmospheric file type
00072  CHARACTER(LEN=28), INTENT(IN)  :: HPGDFILE    ! atmospheric file name
00073  CHARACTER(LEN=6),  INTENT(IN)  :: HPGDFILETYPE! atmospheric file type
00074 INTEGER,           INTENT(IN)  :: KLUOUT      ! logical unit of output listing
00075 LOGICAL,           INTENT(OUT) :: OUNIF       ! flag for prescribed uniform field
00076 
00077 !
00078 !*       0.2   Declarations of local variables
00079 !              -------------------------------
00080 !
00081 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00082 !-------------------------------------------------------------------------------
00083 !
00084 !
00085 IF (LHOOK) CALL DR_HOOK('READ_PREP_ISBA_CONF',0,ZHOOK_HANDLE)
00086 HFILE    = '                         '
00087 HFILETYPE    = '      '
00088 !
00089 HFILEPGD = '                         '
00090 HFILEPGDTYPE = '      '
00091 !
00092 OUNIF    = .FALSE.
00093 !
00094 !-------------------------------------------------------------------------------
00095 !
00096 !* choice of input file
00097 !  --------------------
00098 !
00099 SELECT CASE (HVAR)
00100   CASE ('WG     ','WGI    ')
00101     IF (LEN_TRIM(CFILE_HUG)>0 .AND. LEN_TRIM(CTYPE_HUG)>0 ) THEN
00102       HFILE     = CFILE_HUG
00103       HFILETYPE = CTYPE_HUG
00104     END IF
00105   CASE ('TG     ')
00106     IF (LEN_TRIM(CFILE_TG)>0 .AND. LEN_TRIM(CTYPE_TG)>0 ) THEN
00107       HFILE     = CFILE_TG
00108       HFILETYPE = CTYPE_TG
00109     END IF
00110 END SELECT
00111 !
00112 IF (LEN_TRIM(HFILE)==0 .AND. LEN_TRIM(CFILE_ISBA)>0 .AND. LEN_TRIM(CTYPE)>0) THEN
00113   HFILE     = CFILE_ISBA
00114   HFILETYPE = CTYPE
00115 END IF
00116 !
00117 IF (LEN_TRIM(HFILEPGD)==0 .AND. LEN_TRIM(CFILEPGD_ISBA)>0 .AND. LEN_TRIM(CTYPEPGD)>0) THEN
00118   HFILEPGD     = CFILEPGD_ISBA
00119   HFILEPGDTYPE = CTYPEPGD
00120 END IF
00121 !
00122 !! If no file name in the scheme namelist,
00123 !! try to find a name in NAM_SURF_ATM
00124 !
00125 IF (LEN_TRIM(HFILE)==0) THEN
00126 !
00127  CALL READ_PREP_SURF_ATM_CONF(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
00128                              HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT)
00129 !
00130 END IF
00131 !
00132 !! If no file name in the scheme namelist,
00133 !! nor in NAM_SURF_ATM, look if ascii input files are present
00134 !
00135 SELECT CASE (HVAR)
00136   CASE ('WG     ','WGI    ')
00137     IF ( LEN_TRIM(CTYPE_HUG )>0       .AND. &
00138            LEN_TRIM(CFILE_HUG_SURF)>0   .AND. &
00139            LEN_TRIM(CFILE_HUG_ROOT)>0   .AND. &
00140            LEN_TRIM(CFILE_HUG_DEEP)>0         ) THEN  
00141        HFILETYPE = CTYPE_HUG 
00142     END IF
00143     IF (HVAR=='WGI    ' .AND. HFILETYPE=='ASCLLV') THEN
00144        OUNIF = .TRUE.
00145        IF (XHUGI_SURF==XUNDEF) XHUGI_SURF = 0.
00146        IF (XHUGI_ROOT==XUNDEF) XHUGI_ROOT = 0.
00147        IF (XHUGI_DEEP==XUNDEF) XHUGI_DEEP = 0.
00148        IF (LHOOK) CALL DR_HOOK('READ_PREP_ISBA_CONF',1,ZHOOK_HANDLE)
00149        RETURN
00150     ENDIF
00151   CASE ('TG     ')
00152     IF ( LEN_TRIM(CTYPE_TG )>0       .AND. &
00153            LEN_TRIM(CFILE_TG_SURF)>0   .AND. &
00154            LEN_TRIM(CFILE_TG_ROOT)>0   .AND. &
00155            LEN_TRIM(CFILE_TG_DEEP)>0         ) THEN  
00156        HFILETYPE = CTYPE_TG 
00157     END IF
00158 END SELECT
00159 !
00160 !-------------------------------------------------------------------------------
00161 !
00162 !* Is an uniform field prescribed?
00163 !  ------------------------------
00164 !
00165 SELECT CASE (HVAR)
00166   CASE ('WG     ')
00167     OUNIF = (XHUG_SURF/=XUNDEF) .OR. (XHUG_ROOT/=XUNDEF) .OR. (XHUG_DEEP/=XUNDEF)
00168     IF (OUNIF .AND. (XHUG_SURF==XUNDEF)) THEN
00169        WRITE(KLUOUT,*)'ONE OF XHUG_SURF, XHUG_ROOT OR XHUG_DEEP IS GIVEN'
00170        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XHUG_SURF MUST BE SET')
00171     END IF
00172     IF (OUNIF .AND. (XHUG_ROOT==XUNDEF)) THEN
00173        WRITE(KLUOUT,*)'ONE OF XHUG_SURF, XHUG_ROOT OR XHUG_DEEP IS GIVEN'
00174        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XHUG_ROOT MUST BE SET')
00175     END IF
00176     IF (OUNIF .AND. (XHUG_DEEP==XUNDEF)) THEN
00177        WRITE(KLUOUT,*)'ONE OF XHUG_SURF, XHUG_ROOT OR XHUG_DEEP IS GIVEN'
00178        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XHUG_DEEP MUST BE SET')
00179     END IF
00180     !
00181       CASE ('WGI    ')
00182     OUNIF = (XHUGI_SURF/=XUNDEF) .OR. (XHUGI_ROOT/=XUNDEF) .OR. (XHUGI_DEEP/=XUNDEF)
00183     IF (OUNIF .AND. (XHUGI_SURF==XUNDEF)) THEN
00184        WRITE(KLUOUT,*)'ONE OF XHUGI_SURF, XHUGI_ROOT OR XHUGI_DEEP IS GIVEN'
00185        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XHUGI_SURF MUST BE SET')
00186     END IF
00187     IF (OUNIF .AND. (XHUGI_ROOT==XUNDEF)) THEN
00188        WRITE(KLUOUT,*)'ONE OF XHUGI_SURF, XHUGI_ROOT OR XHUGI_DEEP IS GIVEN'
00189        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XHUGI_ROOT MUST BE SET')
00190     END IF
00191     IF (OUNIF .AND. (XHUGI_DEEP==XUNDEF)) THEN
00192        WRITE(KLUOUT,*)'ONE OF XHUGI_SURF, XHUGI_ROOT OR XHUGI_DEEP IS GIVEN'
00193        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XHUGI_DEEP MUST BE SET')
00194     END IF
00195    !
00196   CASE ('TG     ')
00197     OUNIF = (XTG_SURF/=XUNDEF)  .OR. (XTG_ROOT/=XUNDEF)  .OR. (XTG_DEEP/=XUNDEF)
00198     IF (OUNIF .AND. (XTG_SURF==XUNDEF)) THEN
00199        WRITE(KLUOUT,*)'ONE OF XTG_SURF, XTG_ROOT OR XTG_DEEP IS GIVEN'
00200        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XTG_SURF MUST BE SET')
00201     END IF
00202     IF (OUNIF .AND. (XTG_ROOT==XUNDEF)) THEN
00203        WRITE(KLUOUT,*)'ONE OF XTG_SURF, XTG_ROOT OR XTG_DEEP IS GIVEN'
00204        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XTG_ROOT MUST BE SET')
00205     END IF
00206     IF (OUNIF .AND. (XTG_DEEP==XUNDEF)) THEN
00207        WRITE(KLUOUT,*)'ONE OF XTG_SURF, XTG_ROOT OR XTG_DEEP IS GIVEN'
00208        CALL ABOR1_SFX('READ_PREP_ISBA_CONF: XTG_DEEP MUST BE SET')
00209     END IF
00210     !
00211 END SELECT
00212 !
00213 !-------------------------------------------------------------------------------
00214 !
00215 !* no file given ? nor specific value in namelist? One takes the default value.
00216 !
00217 IF (HFILETYPE=='      ' .AND. .NOT. OUNIF) THEN
00218   IF (HVAR(1:2)/='ZS') WRITE(KLUOUT,*) 'NO FILE FOR FIELD ',HVAR, &
00219                                         ': UNIFORM DEFAULT FIELD IS PRESCRIBED'
00220   IF (HVAR(1:3)=='WGI') THEN
00221     XHUGI_SURF = 0.
00222     XHUGI_ROOT = 0.
00223     XHUGI_DEEP = 0.
00224   ENDIF                                     
00225   OUNIF = .TRUE.
00226 END IF
00227 IF (LHOOK) CALL DR_HOOK('READ_PREP_ISBA_CONF',1,ZHOOK_HANDLE)
00228 !
00229 !-------------------------------------------------------------------------------
00230 !
00231 END SUBROUTINE READ_PREP_ISBA_CONF