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