|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE CH_INIT_DEP_ISBA_n(KCH,KLUOUT,HSV,KLU) 00003 !! ################################################## 00004 !! 00005 !!*** *CH_INIT_DEP_ISBA_n* 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! The purpose of this subroutine is to calculate the surface flux 00010 ! (emission or deposition) for the chemical (=scalar) variables 00011 !! 00012 !!** METHOD 00013 !! ------ 00014 !! The surface flux will be calculated using an exchange velocity 00015 !! and a surface mixing ratio for each species: 00016 !! Flux = v_exchange * ( C(first model level) ) 00017 !! Exchange velocity and surface concentration will be read from 00018 !! the general purpose input file, or, 00019 !! if CCH_DRY_DEP = "WES89", the Wesley method will be used 00020 !! to calculate the dry deposition velocities. The wesely code 00021 !! has been separate into four subroutines: ch_teb_depn.f90 for town area; 00022 !! ch_water_depn.f90 for inland water; ch_sea_depn.f90 for sea and 00023 !! ch_isba_depn.f90 for nature area. 00024 !! 00025 !! information read from the input file: 00026 !! surface values SURFVALU 00027 !! exchange velocities EXCHGVEL (non-Wesley) 00028 !! 00029 !! in addition for Wesley: 00030 !! chemical molecular diffusivity MASS_MOL 00031 !! molecular reactivity factor REA_FACT 00032 !! surface resistance SURF_RES 00033 !! molecular effective Henry constant HENRY_SP 00034 !! 00035 !! 00036 !! REFERENCE 00037 !! --------- 00038 !! 00039 !! AUTHOR 00040 !! ------ 00041 !! K. Suhre *Laboratoire d'Aerologie* 00042 !! 00043 !! MODIFICATIONS 00044 !! ------------- 00045 !! Original 17/11/95 00046 !! 05/08/96 (K. Suhre) restructured 00047 !! 19/02/98 (P. Tulet) add explicit dry deposition for chemical species 00048 !! 11/08/98 (N. Asencio) add parallel code 00049 !! 29/03/99 (K. Suhre) add IKB = MIN(2,SIZE(PSVT,3)) 00050 !! so that this subroutine can be called by the box model 00051 !! 16/01/01 (P. Tulet) restructured 00052 !! 18/01/01 (P. Tulet) add patch vegetative class, town and water/sea 00053 !! for friction velocity and aerodynamical resistance 00054 !! 18/07/03 (P. Tulet) surface externalisation 00055 !! 00056 !! 00057 !! EXTERNAL 00058 !! -------- 00059 USE MODI_CH_OPEN_INPUTB ! open the general purpose ASCII input file 00060 USE MODI_CONVERT_COVER_CH_ISBA 00061 ! 00062 USE MODD_CH_ISBA_n, ONLY: NBEQ, CCH_DRY_DEP, XDEP, XSOILRC_SO2, XSOILRC_O3 00063 USE MODD_CH_ISBA, ONLY: XRCCLAYSO2, XRCCLAYO3, XRCSANDSO2, XRCSANDO3, & 00064 XRCSNOWSO2, XRCSNOWO3, XLANDREXT 00065 USE MODD_ISBA_n, ONLY: XCOVER, NPATCH 00066 USE MODD_CH_SURF 00067 USE MODD_SURF_PAR, ONLY : XUNDEF 00068 !! 00069 !! IMPLICIT ARGUMENTS 00070 !! ------------------ 00071 !------------------------------------------------------------------------------- 00072 ! 00073 !* 0. DECLARATIONS 00074 ! ------------ 00075 ! 00076 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00077 USE PARKIND1 ,ONLY : JPRB 00078 ! 00079 IMPLICIT NONE 00080 ! 00081 !* 0.1 declarations of arguments 00082 INTEGER, INTENT(IN) :: KCH ! chemistry input file 00083 INTEGER, INTENT(IN) :: KLUOUT ! output listing channel 00084 CHARACTER(LEN=6), DIMENSION(:), INTENT(IN) :: HSV ! name of chemical species 00085 INTEGER, INTENT(IN) :: KLU ! number of points 00086 ! 00087 !* 0.2 declarations of local variables 00088 ! 00089 CHARACTER(LEN=40) :: YFORMAT 00090 ! format for input 00091 CHARACTER(LEN=40) :: YOUTFORMAT = '(A32,2E15.5)' 00092 ! format for output 00093 INTEGER :: IRESIS ! number of chemical reactivity factor to be read 00094 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YRESISNAME !resistance name 00095 REAL , DIMENSION(:), ALLOCATABLE :: ZRESISVAL 00096 ! chemical reactivity factor value 00097 ! 00098 INTEGER :: JI, JNREAL ! loop control variables 00099 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00100 ! 00101 !============================================================================= 00102 ! 00103 ! 00104 ! 1. Default values 00105 ! 00106 IF (LHOOK) CALL DR_HOOK('CH_INIT_DEP_ISBA_N',0,ZHOOK_HANDLE) 00107 XRCCLAYSO2 = XUNDEF 00108 XRCCLAYO3 = XUNDEF 00109 XRCSANDSO2 = XUNDEF 00110 XRCSANDO3 = XUNDEF 00111 XRCSNOWSO2 = XUNDEF 00112 XRCSNOWO3 = XUNDEF 00113 XLANDREXT = XUNDEF 00114 ! 00115 !----------------------------------------------------------------------------- 00116 ! 00117 ! 00118 IF (CCH_DRY_DEP == "WES89") THEN 00119 ! 00120 !* 2. Physiographic fields 00121 ! 00122 ALLOCATE(XSOILRC_SO2(KLU,NPATCH)) 00123 ALLOCATE(XSOILRC_O3(KLU,NPATCH)) 00124 00125 CALL CONVERT_COVER_CH_ISBA(XCOVER,XSOILRC_SO2,XSOILRC_O3) 00126 ! 00127 !--------------------------------------------------------------------------- 00128 ! 00129 ! 00130 !* 3. read surface resistance SURF_RES 00131 ! 00132 ALLOCATE(XDEP(KLU,NBEQ,NPATCH)) 00133 00134 ! open input file 00135 WRITE(KLUOUT,*) & 00136 "CH_INIT_DEP_ISBA_n: reading reactivity factor " 00137 CALL CH_OPEN_INPUTB("SURF_RES", KCH, KLUOUT) 00138 ! 00139 ! read number of input surface resistance IRESIS 00140 READ(KCH, *) IRESIS 00141 WRITE(KLUOUT,*) "number of reactivity factor : ", IRESIS 00142 ! 00143 ! read data input format 00144 READ(KCH,"(A)") YFORMAT 00145 WRITE(KLUOUT,*) "input format is: ", YFORMAT 00146 ! 00147 ! allocate fields 00148 ALLOCATE(YRESISNAME(IRESIS)) 00149 ALLOCATE(ZRESISVAL(IRESIS)) 00150 ! 00151 ! read reactivity factor 00152 DO JI = 1, IRESIS 00153 READ(KCH,YFORMAT) YRESISNAME(JI), ZRESISVAL(JI) 00154 WRITE(KLUOUT,YFORMAT) YRESISNAME(JI), ZRESISVAL(JI) 00155 END DO 00156 ! close file 00157 DO JNREAL = 1, IRESIS 00158 IF ('LANDREXT'== YRESISNAME(JNREAL) (1:8)) XLANDREXT = ZRESISVAL(JNREAL) 00159 IF ('RCSANDSO2'== YRESISNAME(JNREAL) (1:9)) XRCSANDSO2 = ZRESISVAL(JNREAL) 00160 IF ('RCSANDO3'== YRESISNAME(JNREAL) (1:8)) XRCSANDO3 = ZRESISVAL(JNREAL) 00161 IF ('RCCLAYSO2'== YRESISNAME(JNREAL) (1:9)) XRCCLAYSO2 = ZRESISVAL(JNREAL) 00162 IF ('RCCLAYO3'== YRESISNAME(JNREAL) (1:8)) XRCCLAYO3 = ZRESISVAL(JNREAL) 00163 IF ('RCSNOWSO2'== YRESISNAME(JNREAL) (1:9)) XRCSNOWSO2 = ZRESISVAL(JNREAL) 00164 IF ('RCSNOWO3'== YRESISNAME(JNREAL) (1:8)) XRCSNOWO3 = ZRESISVAL(JNREAL) 00165 END DO 00166 ! 00167 WRITE(KLUOUT,'(A)') '----------------------------------------------------' 00168 WRITE(KLUOUT,'(A)') 'SURF_RES' 00169 WRITE(KLUOUT,'(A)') 'surface resistances (s/m)' 00170 WRITE(KLUOUT,'(I4)') 7 00171 WRITE(KLUOUT,'(A)') YOUTFORMAT 00172 WRITE(KLUOUT,YOUTFORMAT) 'LANDREXT', XLANDREXT 00173 WRITE(KLUOUT,YOUTFORMAT) 'RCSANDSO2', XRCSANDSO2 00174 WRITE(KLUOUT,YOUTFORMAT) 'RCSANDO3', XRCSANDO3 00175 WRITE(KLUOUT,YOUTFORMAT) 'RCCLAYSO2', XRCCLAYSO2 00176 WRITE(KLUOUT,YOUTFORMAT) 'RCCLAYO3', XRCCLAYO3 00177 WRITE(KLUOUT,YOUTFORMAT) 'RCSNOWSO2', XRCSNOWSO2 00178 WRITE(KLUOUT,YOUTFORMAT) 'RCSNOWO3', XRCSNOWO3 00179 ! 00180 DEALLOCATE(YRESISNAME) 00181 DEALLOCATE(ZRESISVAL) 00182 ELSE 00183 ALLOCATE(XDEP(0,0,0)) 00184 END IF 00185 IF (LHOOK) CALL DR_HOOK('CH_INIT_DEP_ISBA_N',1,ZHOOK_HANDLE) 00186 ! 00187 !============================================================================= 00188 ! 00189 END SUBROUTINE CH_INIT_DEP_ISBA_n
1.8.0
