|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE BUILD_EMISSTAB_n(HPROGRAM,KCH,HEMIS_GR_NAME, KNBTIMES,& 00003 KEMIS_GR_TIME,KOFFNDX,TPEMISS,KSIZE,KLUOUT, KVERB,PRHODREF) 00004 !! ##################################################################### 00005 !! 00006 !!*** *BUILD_EMISSTAB* 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! AUTHOR 00015 !! ------ 00016 !! D. Gazen 00017 !! 00018 !! MODIFICATIONS 00019 !! ------------- 00020 !! Original 01/02/00 00021 !! C. Mari 30/10/00 call of MODD_TYPE_EFUTIL and MODD_CST 00022 !! D.Gazen 01/12/03 change emissions handling for surf. externalization!! 00023 !! P.Tulet 01/01/04 change conversion for externalization (flux unit is 00024 !! molec./m2/s) 00025 !! 00026 !! EXTERNAL 00027 !! -------- 00028 USE MODI_CH_OPEN_INPUTB 00029 USE MODI_READ_SURF 00030 !! 00031 !! IMPLICIT ARGUMENTS 00032 !! ------------------ 00033 USE MODD_TYPE_EFUTIL, ONLY : EMISSVAR_T 00034 USE MODD_CSTS, ONLY : NDAYSEC, XMD, XAVOGADRO 00035 USE MODD_CH_SURF_n, ONLY : XCONVERSION 00036 !------------------------------------------------------------------------------ 00037 ! 00038 !* 0. DECLARATIONS 00039 ! ----------------- 00040 ! 00041 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00042 USE PARKIND1 ,ONLY : JPRB 00043 ! 00044 USE MODI_ABOR1_SFX 00045 ! 00046 IMPLICIT NONE 00047 ! 00048 !* 0.1 declaration of arguments 00049 ! 00050 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name 00051 INTEGER, INTENT(IN) :: KCH 00052 CHARACTER(LEN=*),DIMENSION(:), INTENT(IN) :: HEMIS_GR_NAME ! Offline species name 00053 INTEGER, DIMENSION(:), INTENT(IN) :: KNBTIMES ! nb of emis times array 00054 INTEGER, DIMENSION(:), INTENT(IN) :: KEMIS_GR_TIME 00055 INTEGER, DIMENSION(:), INTENT(IN) :: KOFFNDX ! index of offline species 00056 TYPE(EMISSVAR_T),DIMENSION(:), INTENT(OUT):: TPEMISS ! emission struct array to fill 00057 INTEGER, INTENT(IN) :: KSIZE ! size X*Y (1D) of physical domain 00058 INTEGER, INTENT(IN) :: KLUOUT ! output listing channel 00059 INTEGER, INTENT(IN) :: KVERB ! verbose level 00060 REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! dry density for ref. state 00061 ! 00062 ! 00063 !* 0.2 declaration of local variables 00064 ! 00065 CHARACTER(LEN=3):: YUNIT ! unit of the flux 00066 INTEGER :: INBTS ! Number of emis times for a species 00067 INTEGER :: IRESP ! I/O return value 00068 INTEGER :: IIND1, IIND2 00069 INTEGER :: JSPEC ! loop index 00070 INTEGER :: ITIME ! loop index 00071 INTEGER :: IWS_DEFAULT ! Default Memory window size for emission reading 00072 CHARACTER (LEN=16):: YRECFM ! LFI article name 00073 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00074 00075 ! 00076 !------------------------------------------------------------------------------ 00077 ! 00078 !* EXECUTABLE STATEMENTS 00079 ! --------------------- 00080 ! 00081 00082 IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',0,ZHOOK_HANDLE) 00083 IF (KVERB >= 5) THEN 00084 WRITE(KLUOUT,*) '******** SUBROUTINE (CHIMIE): BUILD_EMISSTAB_n ********' 00085 END IF 00086 ! 00087 !* 1. READ DATA 00088 ! -------------- 00089 ! 00090 CALL CH_OPEN_INPUTB("EMISUNIT", KCH, KLUOUT) 00091 ! 00092 ! read unit identifier 00093 READ(KCH,'(A3)') YUNIT 00094 ! 00095 ! 00096 !* 2. MAP DATA ONTO PROGNOSTIC VARIABLES 00097 ! --------------------------------------- 00098 ! 00099 ALLOCATE (XCONVERSION(SIZE(PRHODREF,1))) 00100 ! determine the conversion factor 00101 XCONVERSION(:) = 1. 00102 SELECT CASE (YUNIT) 00103 CASE ('MIX') ! flux given ppp*m/s, conversion to molec/m2/s 00104 ! where 1 molecule/cm2/s = (224.14/6.022136E23) ppp*m/s 00105 XCONVERSION(:) = XAVOGADRO * PRHODREF(:) / XMD 00106 CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s 00107 XCONVERSION(:) = 1E4 00108 CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s 00109 ! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s 00110 !XCONVERSION(:) = (22.414/86.400)*1E-12 * XAVOGADRO * PRHODREF(:) / XMD 00111 XCONVERSION(:) = 1E-6 * XAVOGADRO / 86400. 00112 00113 CASE DEFAULT 00114 CALL ABOR1_SFX('CH_BUILDEMISSN: UNKNOWN CONVERSION FACTOR') 00115 END SELECT 00116 ! 00117 ! Read Window size default value >= 2 00118 IWS_DEFAULT = 5 ! Should be set by namelist 00119 IF (IWS_DEFAULT < 2) IWS_DEFAULT = 2 00120 ! 00121 IIND1 = 0 00122 IIND2 = 0 00123 DO JSPEC=1,SIZE(TPEMISS) ! loop on offline emission species 00124 ! 00125 INBTS = KNBTIMES(JSPEC) 00126 ! 00127 ! Fill %CNAME 00128 TPEMISS(JSPEC)%CNAME = HEMIS_GR_NAME(KOFFNDX(JSPEC)) 00129 ! Allocate and Fill %NETIMES 00130 ALLOCATE(TPEMISS(JSPEC)%NETIMES(INBTS)) 00131 IIND1 = IIND2+1 00132 IIND2 = IIND2+INBTS 00133 TPEMISS(JSPEC)%NETIMES(:) = KEMIS_GR_TIME(IIND1:IIND2) 00134 ! 00135 ! Update %NWS, %NDX, %NTX, %LREAD, %XEMISDATA 00136 IF (INBTS <= IWS_DEFAULT) THEN 00137 ! Number of times smaller than read window size allowed 00138 ! Read emis data once and for all 00139 TPEMISS(JSPEC)%NWS = INBTS 00140 TPEMISS(JSPEC)%NDX = 1 00141 TPEMISS(JSPEC)%NTX = 1 00142 TPEMISS(JSPEC)%LREAD = .FALSE. ! to prevent future reading 00143 ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,INBTS)) 00144 ! Read file for emission data 00145 YRECFM='EMIS_'//TRIM(TPEMISS(JSPEC)%CNAME) 00146 CALL READ_SURF(HPROGRAM,YRECFM,TPEMISS(JSPEC)%XEMISDATA(:,:),IRESP) 00147 ! 00148 ! Correction : Replace 999. with 0. value in the Emission FLUX 00149 ! and apply conversion 00150 WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 999.) 00151 TPEMISS(JSPEC)%XEMISDATA(:,:) = 0. 00152 END WHERE 00153 WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 1.E20) 00154 TPEMISS(JSPEC)%XEMISDATA(:,:) = 0. 00155 END WHERE 00156 DO ITIME=1,INBTS 00157 ! XCONVERSION HAS BEEN ALREADY APPLY IN CH_EMISSION_FLUXN 00158 !TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * XCONVERSION(:) 00159 TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) 00160 END DO 00161 ELSE 00162 ! Read window size is smaller than number of emission times 00163 TPEMISS(JSPEC)%NWS = IWS_DEFAULT 00164 TPEMISS(JSPEC)%NDX = IWS_DEFAULT 00165 TPEMISS(JSPEC)%NTX = 0 00166 TPEMISS(JSPEC)%LREAD = .TRUE. 00167 ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,IWS_DEFAULT)) 00168 END IF 00169 00170 IF (INBTS == 1) THEN 00171 TPEMISS(JSPEC)%XFWORK=>TPEMISS(JSPEC)%XEMISDATA(:,1) 00172 ELSE 00173 ALLOCATE(TPEMISS(JSPEC)%XFWORK(KSIZE)) 00174 END IF 00175 ! Compute index for periodic case 00176 TPEMISS(JSPEC)%NPX = MAXVAL(MINLOC(TPEMISS(JSPEC)%NETIMES(:)+& 00177 (1+(TPEMISS(JSPEC)%NETIMES(INBTS)-& 00178 TPEMISS(JSPEC)%NETIMES(:))/NDAYSEC)*NDAYSEC)) 00179 ! 00180 ! Some di###ay 00181 IF (KVERB >= 6) THEN 00182 WRITE(KLUOUT,*) '====== Species ',TRIM(TPEMISS(JSPEC)%CNAME), ' ======' 00183 WRITE(KLUOUT,*) ' Emission Times :' ,TPEMISS(JSPEC)%NETIMES 00184 WRITE(KLUOUT,*) ' Current time index :' ,TPEMISS(JSPEC)%NTX 00185 WRITE(KLUOUT,*) ' Current data index :' ,TPEMISS(JSPEC)%NDX 00186 WRITE(KLUOUT,*) ' Periodic index = ',TPEMISS(JSPEC)%NPX,& 00187 ' at time :',TPEMISS(JSPEC)%NETIMES(TPEMISS(JSPEC)%NPX) 00188 WRITE(KLUOUT,*) ' Read window size :', TPEMISS(JSPEC)%NWS 00189 IF (TPEMISS(JSPEC)%LREAD) THEN 00190 WRITE(KLUOUT,*) ' -> Data must be read during simulation.' 00191 ELSE 00192 WRITE(KLUOUT,*) ' -> Data already in memory.' 00193 END IF 00194 END IF 00195 END DO 00196 00197 IF (KVERB >= 5) THEN 00198 WRITE(KLUOUT,*) '******** END SUBROUTINE (CHIMIE) : BUILD_EMISSTAB_n ********' 00199 END IF 00200 IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',1,ZHOOK_HANDLE) 00201 00202 END SUBROUTINE BUILD_EMISSTAB_n
1.8.0
