SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE READ_TEB_VEG_CONF_n(HPROGRAM) 00003 ! ####################################################### 00004 ! 00005 !!**** *READ_TEB_VEG_CONF* - routine to read the configuration for VEG 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! V. Masson *Meteo France* 00027 !! 00028 !! MODIFICATIONS 00029 !! ------------- 00030 !! Original 01/2003 00031 !! P Le Moigne 09/2005 AGS modifs of L. Jarlan 00032 !! P Le Moigne 09/2005 CSNOWRES option 00033 !! Modified by P. Le Moigne (06/2006): seeding and irrigation 00034 !! Modified by P. Le Moigne (05/2008): deep soil characteristics 00035 !------------------------------------------------------------------------------- 00036 ! 00037 !* 0. DECLARATIONS 00038 ! ------------ 00039 ! 00040 USE MODE_MODELN_SURFEX_HANDLER 00041 ! 00042 USE MODE_POS_SURF 00043 ! 00044 USE MODI_TEST_NAM_VAR_SURF 00045 USE MODI_GET_LUOUT 00046 USE MODI_OPEN_NAMELIST 00047 USE MODI_CLOSE_NAMELIST 00048 ! 00049 USE MODN_TEB_VEG_n 00050 ! 00051 USE MODD_READ_NAMELIST, ONLY : LNAM_READ 00052 USE MODD_SURF_PAR, ONLY : XUNDEF 00053 ! 00054 ! 00055 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00056 USE PARKIND1 ,ONLY : JPRB 00057 ! 00058 IMPLICIT NONE 00059 ! 00060 !* 0.1 Declarations of arguments 00061 ! ------------------------- 00062 ! 00063 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA 00064 00065 ! 00066 !* 0.2 Declarations of local variables 00067 ! ------------------------------- 00068 ! 00069 ! 00070 LOGICAL :: GFOUND ! Return code when searching namelist 00071 INTEGER :: ILUOUT ! logical unit of output file 00072 INTEGER :: INAM ! logical unit of namelist file 00073 INTEGER :: IMI 00074 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00075 !------------------------------------------------------------------------------- 00076 ! 00077 !* get output listing file logical unit 00078 ! 00079 IF (LHOOK) CALL DR_HOOK('READ_TEB_VEG_CONF_N',0,ZHOOK_HANDLE) 00080 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00081 ! 00082 IMI=GET_CURRENT_MODEL_INDEX_SURFEX() 00083 ! 00084 IF (IMI.NE.-1 .AND. LNAM_READ) THEN 00085 CALL INIT_NAM_TEB_VEGn 00086 CALL INIT_NAM_CH_CONTROLn 00087 CALL INIT_NAM_CH_TEB_VEGn 00088 CALL INIT_NAM_SGH_TEB_VEGn 00089 ENDIF 00090 00091 IF (LNAM_READ) THEN 00092 ! 00093 !* open namelist file 00094 ! 00095 CALL OPEN_NAMELIST(HPROGRAM,INAM) 00096 ! 00097 !* reading of namelist 00098 ! ------------------- 00099 ! 00100 CALL POSNAM(INAM,'NAM_ISBAN',GFOUND,ILUOUT) 00101 IF (GFOUND) READ(UNIT=INAM,NML=NAM_ISBAn) 00102 CALL POSNAM(INAM,'NAM_CH_ISBAN',GFOUND,ILUOUT) 00103 IF (GFOUND) READ(UNIT=INAM,NML=NAM_CH_ISBAn) 00104 CALL POSNAM(INAM,'NAM_CH_CONTROLN',GFOUND,ILUOUT) 00105 IF (GFOUND) READ(UNIT=INAM,NML=NAM_CH_CONTROLn) 00106 CALL POSNAM(INAM,'NAM_SGH_ISBAN',GFOUND,ILUOUT) 00107 IF (GFOUND) READ(UNIT=INAM,NML=NAM_SGH_ISBAn) 00108 ! 00109 CALL TEST_NAM_VAR_SURF(ILUOUT,'CROUGH',CROUGH,'NONE','Z01D','Z04D','BE04','UNDE') 00110 CALL TEST_NAM_VAR_SURF(ILUOUT,'CSCOND',CSCOND,'NP89','PL98') 00111 CALL TEST_NAM_VAR_SURF(ILUOUT,'CALBEDO',CALBEDO,'EVOL','DRY ','WET ','MEAN','USER') 00112 CALL TEST_NAM_VAR_SURF(ILUOUT,'CC1DRY',CC1DRY,'DEF ','GB93') 00113 CALL TEST_NAM_VAR_SURF(ILUOUT,'CSOILFRZ',CSOILFRZ,'DEF','LWT') 00114 CALL TEST_NAM_VAR_SURF(ILUOUT,'CDIFSFCOND',CDIFSFCOND,'DEF ','MLCH') 00115 CALL TEST_NAM_VAR_SURF(ILUOUT,'CSNOWRES',CSNOWRES,'DEF','RIL') 00116 CALL TEST_NAM_VAR_SURF(ILUOUT,'CCPSURF',CCPSURF,'DRY','HUM') 00117 ! 00118 CALL TEST_NAM_VAR_SURF(ILUOUT,'CRUNOFF',CRUNOFF,'WSAT','DT92','SGH ') 00119 CALL TEST_NAM_VAR_SURF(ILUOUT,'CTOPREG',CTOPREG,'DEF','NON') 00120 CALL TEST_NAM_VAR_SURF(ILUOUT,'CKSAT',CKSAT,'DEF','SGH') 00121 CALL TEST_NAM_VAR_SURF(ILUOUT,'CHORT',CHORT,'DEF','SGH') 00122 ! 00123 !* close namelist file 00124 ! 00125 CALL CLOSE_NAMELIST(HPROGRAM,INAM) 00126 ! 00127 ENDIF 00128 ! 00129 IF (IMI.NE.-1) THEN 00130 CALL UPDATE_NAM_TEB_VEGn 00131 CALL UPDATE_NAM_CH_TEB_VEGn 00132 CALL UPDATE_NAM_CH_CONTROLn 00133 CALL UPDATE_NAM_SGH_TEB_VEGn 00134 ENDIF 00135 IF (LHOOK) CALL DR_HOOK('READ_TEB_VEG_CONF_N',1,ZHOOK_HANDLE) 00136 ! 00137 !------------------------------------------------------------------------------- 00138 ! 00139 !* surface time-step forced by the atmosphere 00140 ! 00141 !XTSTEP = XUNDEF 00142 ! 00143 !------------------------------------------------------------------------------- 00144 ! 00145 END SUBROUTINE READ_TEB_VEG_CONF_n