|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE CH_EMISSION_SNAP_n(HPROGRAM,KSIZE,PSIMTIME,PSUNTIME, & 00003 KYEAR,KMONTH,KDAY,PRHOA,PLON ) 00004 ! ###################################################################### 00005 !! 00006 !!*** *CH_EMISSION_SNAP_n* - 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! Return a time-dependent emission flux based on tabulated values 00011 !! 00012 !!** METHOD 00013 !! ------ 00014 !! 00015 !! AUTHOR 00016 !! ------ 00017 !! S. Queguiner 00018 !! 00019 !! MODIFICATIONS 00020 !! ------------- 00021 !! Original 10/2011 00022 !! 00023 !! EXTERNAL 00024 !! -------- 00025 !! 00026 !! 00027 !! IMPLICIT ARGUMENTS 00028 !! ------------------ 00029 USE MODD_CSTS, ONLY: XDAY 00030 USE MODD_CH_SNAP_n, ONLY: NEMIS_SNAP, XEMIS_FIELDS, NEMIS_NBR, & 00031 XEMIS_FIELDS_SNAP, XCONVERSION, & 00032 XSNAP_MONTHLY, XSNAP_DAILY, XSNAP_HOURLY,& 00033 CCONVERSION, LEMIS_FIELDS, & 00034 CSNAP_TIME_REF, XDELTA_LEGAL_TIME 00035 ! 00036 USE MODI_ADD_FORECAST_TO_DATE_SURF 00037 USE MODI_SUBSTRACT_TO_DATE_SURF 00038 USE MODI_CH_CONVERSION_FACTOR 00039 !------------------------------------------------------------------------------ 00040 ! 00041 !* 0. DECLARATIONS 00042 ! ----------------- 00043 ! 00044 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00045 USE PARKIND1 ,ONLY : JPRB 00046 ! 00047 ! 00048 IMPLICIT NONE 00049 ! 00050 !* 0.1 declaration of arguments 00051 ! 00052 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM! program calling surf. schemes 00053 INTEGER, INTENT(IN) :: KSIZE ! number of points 00054 REAL, INTENT(IN) :: PSIMTIME! time of simulation in sec UTC 00055 ! (counting from midnight of 00056 ! the current day) 00057 REAL, DIMENSION(KSIZE), INTENT(IN) :: PSUNTIME! Solar time (s since midnight) 00058 INTEGER, INTENT(IN) :: KYEAR,KMONTH,KDAY ! UTC year, month, day 00059 REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHOA ! Air density 00060 REAL, DIMENSION(KSIZE), INTENT(IN) :: PLON ! Longitude (°, from Greenwich) 00061 ! ! (must be between -180° and 180°) 00062 ! 00063 !* 0.2 declaration of local variables 00064 ! 00065 REAL, DIMENSION(KSIZE) :: ZLON ! Longitude centered in Greenwich meridian 00066 REAL, DIMENSION(KSIZE) :: ZTIME0 00067 INTEGER,DIMENSION(KSIZE,2) :: IYEAR ! Year at the begining of current hour 00068 INTEGER,DIMENSION(KSIZE,2) :: IMONTH! Month at the begining of current hour 00069 INTEGER,DIMENSION(KSIZE,2) :: IDAY ! Day at the begining of current hour 00070 INTEGER,DIMENSION(KSIZE,2) :: IDOW ! Day of Week at the begining of current hour 00071 INTEGER,DIMENSION(KSIZE,2) :: IHOUR ! Entire hour at the begining of current hour 00072 REAL, DIMENSION(KSIZE,2) :: ZTIME ! time (s) at the begining of current hour 00073 INTEGER :: JSPEC ! Loop counter on chemical species 00074 INTEGER :: JSNAP ! Loop counter on snap categories 00075 INTEGER :: JI, JT ! Loop counter on points 00076 REAL,DIMENSION(KSIZE,2) :: ZE ! Emissions at beginning and end of the hour 00077 ! 00078 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00079 ! 00080 !------------------------------------------------------------------------------ 00081 ! 00082 !* EXECUTABLE STATEMENTS 00083 ! --------------------- 00084 ! 00085 IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N',0,ZHOOK_HANDLE) 00086 ! 00087 !------------------------------------------------------------------------------ 00088 ! 00089 !* 1. Updates Conversion Factor (may depends on air density) 00090 ! ------------------------------------------------------ 00091 ! 00092 CALL CH_CONVERSION_FACTOR(CCONVERSION,PRHOA(:)) 00093 ! 00094 !------------------------------------------------------------------------------ 00095 ! 00096 !* 2. time and date for each point depending on Time reference 00097 ! -------------------------------------------------------- 00098 ! 00099 !* 2.1 time at the beginning of current hour 00100 ! 00101 IDAY (:,1)=KDAY 00102 IMONTH(:,1)=KMONTH 00103 IYEAR (:,1)=KYEAR 00104 ! 00105 SELECT CASE (CSNAP_TIME_REF) 00106 CASE ('UTC ') 00107 ZTIME0(:)=PSIMTIME 00108 CASE ('SOLAR') 00109 ZLON(:)=PLON(:) 00110 WHERE(PLON(:)> 180.) ZLON(:)=PLON(:)-360. 00111 WHERE(PLON(:)<=-180.) ZLON(:)=PLON(:)+360. 00112 !* retrieves solar date and time 00113 ZTIME0(:)=PSIMTIME + ZLON(:)*240. ! first guess is approximated solar time. 00114 ! The suntime should be close to this. 00115 DO JI=1,KSIZE 00116 IF (ZTIME0(JI)>PSUNTIME(JI)+XDAY/2.) THEN 00117 ZTIME0(JI) = PSUNTIME(JI) + XDAY 00118 ELSEIF (ZTIME0(JI)<PSUNTIME(JI)-XDAY/2.) THEN 00119 ZTIME0(JI) = PSUNTIME(JI) - XDAY 00120 ELSE 00121 ZTIME0(JI) = PSUNTIME(JI) 00122 END IF 00123 CALL ADD_FORECAST_TO_DATE_SURF(IYEAR(JI,1),IMONTH(JI,1),IDAY(JI,1),ZTIME0(JI)) 00124 CALL SUBSTRACT_TO_DATE_SURF (IYEAR(JI,1),IMONTH(JI,1),IDAY(JI,1),ZTIME0(JI)) 00125 ENDDO 00126 00127 CASE ('LEGAL') 00128 ZTIME0(:)=PSIMTIME + XDELTA_LEGAL_TIME(:) * 3600. 00129 DO JI=1,KSIZE 00130 CALL ADD_FORECAST_TO_DATE_SURF(IYEAR(JI,1),IMONTH(JI,1),IDAY(JI,1),ZTIME0(JI)) 00131 CALL SUBSTRACT_TO_DATE_SURF (IYEAR(JI,1),IMONTH(JI,1),IDAY(JI,1),ZTIME0(JI)) 00132 ENDDO 00133 00134 END SELECT 00135 ! 00136 CALL DAY_OF_WEEK(IDAY(:,1), IMONTH(:,1), IYEAR(:,1), IDOW(:,1)) 00137 ! 00138 IHOUR(:,1) = INT((ZTIME0(:)+1.E-10)/3600.)! 1.E-10 and the where condition after are 00139 WHERE (IHOUR(:,1)==24) IHOUR(:,1)=23 ! set to avoid computer precision problems 00140 ZTIME(:,1) = IHOUR(:,1) * 3600. 00141 ! 00142 !* 2.2 time at the end of current hour 00143 ! 00144 IDAY (:,2)=IDAY (:,1) 00145 IMONTH(:,2)=IMONTH(:,1) 00146 IYEAR (:,2)=IYEAR (:,1) 00147 ! 00148 ZTIME(:,2) = (IHOUR(:,1)+1) * 3600. 00149 ! 00150 DO JI=1,KSIZE 00151 CALL ADD_FORECAST_TO_DATE_SURF(IYEAR(JI,2),IMONTH(JI,2),IDAY(JI,2),ZTIME(JI,2)) 00152 ENDDO 00153 ! 00154 CALL DAY_OF_WEEK(IDAY(:,2), IMONTH(:,2), IYEAR(:,2), IDOW(:,2)) 00155 ! 00156 IHOUR(:,2)=NINT(ZTIME(:,2))/3600 00157 ! 00158 !------------------------------------------------------------------------------ 00159 ! 00160 !* 3. Emission at the begining of the current hour 00161 ! -------------------------------------------- 00162 ! 00163 XEMIS_FIELDS(:,:)=0. 00164 ! 00165 DO JSPEC=1,NEMIS_NBR 00166 ! 00167 ZE(:,:) = 0. 00168 ! 00169 DO JSNAP=1,NEMIS_SNAP 00170 ! 00171 DO JT=1,2 00172 ! 00173 DO JI=1,KSIZE 00174 ! 00175 ZE(JI,JT) = ZE(JI,JT) + XEMIS_FIELDS_SNAP(JI,JSNAP,JSPEC) & 00176 *XSNAP_MONTHLY(IMONTH(JI,JT) ,JSNAP,JSPEC) & 00177 *XSNAP_DAILY (IDOW (JI,JT) ,JSNAP,JSPEC) & 00178 *XSNAP_HOURLY (IHOUR (JI,JT)+1,JSNAP,JSPEC) & 00179 *XCONVERSION(JI) 00180 ENDDO 00181 ! 00182 ENDDO 00183 ! 00184 ENDDO 00185 ! 00186 !* 5. Temporal interpolation within the current hour 00187 ! ---------------------------------------------- 00188 ! 00189 XEMIS_FIELDS(:,JSPEC) = ZE(:,1) + (ZE(:,2)-ZE(:,1))/3600.*(ZTIME0(:)-IHOUR(:,1)*3600.) 00190 00191 END DO 00192 ! 00193 LEMIS_FIELDS = .TRUE. 00194 ! 00195 IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N',1,ZHOOK_HANDLE) 00196 ! 00197 !------------------------------------------------------------------------------- 00198 CONTAINS 00199 ! 00200 SUBROUTINE DAY_OF_WEEK(DATE, MONTH, YEAR, DOW) 00201 !! AUTHOR 00202 !! ------ 00203 !! J.Arteta 00204 !! Original August 2010 00205 !! 00206 !! 00207 !! MODifICATIONS 00208 !! ------------- 00209 !! S. Queguiner 10/2011 DAY:Monday->Sunday => DOW:1->7 00210 ! 00211 IMPLICIT NONE 00212 INTEGER, DIMENSION(:), INTENT(IN) :: DATE, MONTH, YEAR 00213 INTEGER, DIMENSION(:), INTENT(OUT):: DOW 00214 INTEGER, DIMENSION(SIZE(DOW)) :: DAY, YR, MN, N1, N2 00215 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00216 ! 00217 IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N:DAY_OF_WEEK',0,ZHOOK_HANDLE) 00218 ! 00219 YR = YEAR 00220 MN = MONTH 00221 ! 00222 WHERE (MN.LE.2) 00223 MN = MN + 12 00224 YR = YR -1 00225 END WHERE 00226 ! 00227 N1 = (26 * (MN + 1)) /10 00228 N2 = (125 * YR) / 100 00229 DAY = (DATE + N1 + N2 - (YR / 100) + (YR / 400) - 1) 00230 ! 00231 DOW = MOD(DAY,7) + 7 00232 WHERE (DOW.GT.7) DOW = DOW - 7 00233 ! 00234 IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N:DAY_OF_WEEK',1,ZHOOK_HANDLE) 00235 END SUBROUTINE DAY_OF_WEEK 00236 ! 00237 END SUBROUTINE CH_EMISSION_SNAP_n
1.8.0
