|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !############################################################# 00002 SUBROUTINE INIT_SURF_LANDUSE_n(HPROGRAM,HINIT,OLAND_USE, & 00003 KI,KSV,KSW, & 00004 HSV,PCO2,PRHOA, & 00005 PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, & 00006 PEMIS,PTSRAD, & 00007 KYEAR, KMONTH,KDAY, PTIME, & 00008 HATMFILE,HATMFILETYPE, & 00009 HTEST ) 00010 !############################################################# 00011 ! 00012 !!**** *INIT_SURF_LANDUSE_n* - routine to initialize LAND USE 00013 !! 00014 !! PURPOSE 00015 !! ------- 00016 !! 00017 !!** METHOD 00018 !! ------ 00019 !! 00020 !! EXTERNAL 00021 !! -------- 00022 !! 00023 !! 00024 !! IMPLICIT ARGUMENTS 00025 !! ------------------ 00026 !! 00027 !! REFERENCE 00028 !! --------- 00029 !! 00030 !! 00031 !! AUTHOR 00032 !! ------ 00033 !! S. Faroux *Meteo France* 00034 !! 00035 !! MODIFICATIONS 00036 !! ------------- 00037 !! 00038 !------------------------------------------------------------------------------- 00039 ! 00040 !* 0. DECLARATIONS 00041 ! ------------ 00042 ! 00043 USE MODD_ISBA_n, ONLY : XPATCH_OLD,XDG_OLD,CISBA 00044 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00045 USE PARKIND1 ,ONLY : JPRB 00046 USE MODD_ISBA_n, ONLY : NGROUND_LAYER, NPATCH 00047 ! 00048 USE MODI_INIT_IO_SURF_n 00049 USE MODI_END_IO_SURF_n 00050 ! 00051 USE MODI_GET_TYPE_DIM_n 00052 USE MODI_READ_SURF 00053 ! 00054 USE MODI_SET_VEGTYPES_FRACTIONS 00055 USE MODI_COMPUTE_ISBA_PARAMETERS 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 surf. schemes 00064 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize 00065 LOGICAL, INTENT(IN) :: OLAND_USE ! choice of doing land use or not 00066 INTEGER, INTENT(IN) :: KI ! number of points 00067 INTEGER, INTENT(IN) :: KSV ! number of scalars 00068 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00069 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables 00070 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3) 00071 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density 00072 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle 00073 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! solar azimuthal angle (rad from N, clock) 00074 REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band 00075 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band 00076 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band 00077 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity 00078 REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature 00079 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00080 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00081 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00082 REAL, INTENT(IN) :: PTIME ! current time since 00083 ! midnight (UTC, s) 00084 ! 00085 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name 00086 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type 00087 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00088 ! 00089 ! 00090 !* 0.2 Declarations of local variables 00091 ! ------------------------------- 00092 REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file 00093 INTEGER :: JLAYER 00094 INTEGER :: ILU ! 1D physical dimension 00095 INTEGER :: IRESP ! Error code after redding 00096 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00097 CHARACTER(LEN=4) :: YLVL 00098 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00099 ! 00100 !------------------------------------------------------------------------------- 00101 ! 00102 IF (LHOOK) CALL DR_HOOK('INIT_SURF_LANDUSE_N',0,ZHOOK_HANDLE) 00103 ! 00104 IF (HTEST/='OK') THEN 00105 CALL ABOR1_SFX('INIT_SURF_LANDUSEN: FATAL ERROR DURING ARGUMENT TRANSFER') 00106 END IF 00107 ! 00108 IF (.NOT. OLAND_USE)THEN 00109 IF (LHOOK) CALL DR_HOOK('INIT_SURF_LANDUSE_N',1,ZHOOK_HANDLE) 00110 RETURN 00111 ENDIF 00112 ! 00113 IF (CISBA=='DIF') THEN 00114 CALL ABOR1_SFX('INIT_SURF_LANDUSEN: LAND USE NOT IMPLEMENTED WITH DIF') 00115 ENDIF 00116 ! 00117 !------------------------------------------------------------------------------- 00118 ! 00119 !* initialization for I/O 00120 ! 00121 CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','READ ') 00122 ! 00123 !* 1D physical dimension 00124 ! 00125 CALL GET_TYPE_DIM_n('NATURE',ILU) 00126 ALLOCATE(ZWORK(ILU,NPATCH)) 00127 ! 00128 !* read old patch fraction 00129 ! 00130 ALLOCATE(XPATCH_OLD(ILU,NPATCH)) 00131 YRECFM = 'OLD_PATCH' 00132 CALL READ_SURF(HPROGRAM,YRECFM,XPATCH_OLD(:,:),IRESP) 00133 ! 00134 !* read old soil layer thicknesses (m) 00135 ! 00136 ALLOCATE(XDG_OLD(ILU,NGROUND_LAYER,NPATCH)) 00137 ! 00138 DO JLAYER=1,NGROUND_LAYER 00139 WRITE(YLVL,'(I4)') JLAYER 00140 YRECFM='OLD_DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00141 CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP) 00142 XDG_OLD(:,JLAYER,:)=ZWORK 00143 END DO 00144 DEALLOCATE(ZWORK) 00145 ! 00146 !* End of IO 00147 ! 00148 CALL END_IO_SURF_n(HPROGRAM) 00149 ! 00150 !------------------------------------------------------------------------------- 00151 ! 00152 !* read new fraction of each vege type 00153 ! and then extrapolate parameters defined by cover 00154 ! 00155 CALL SET_VEGTYPES_FRACTIONS(HPROGRAM) 00156 ! 00157 !* re-initialize ISBA with new parameters 00158 ! 00159 CALL COMPUTE_ISBA_PARAMETERS(HPROGRAM,HINIT,OLAND_USE, & 00160 KI,KSV,KSW, & 00161 HSV,PCO2,PRHOA, & 00162 PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB, & 00163 PEMIS,PTSRAD, & 00164 HTEST ) 00165 !------------------------------------------------------------------------------- 00166 ! 00167 IF (LHOOK) CALL DR_HOOK('INIT_SURF_LANDUSE_N',1,ZHOOK_HANDLE) 00168 ! 00169 END SUBROUTINE INIT_SURF_LANDUSE_n
1.8.0
