exchange_with_atmosphere.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\exchange_with_atmosphere.f
00002 !
00148                       MODULE EXCHANGE_WITH_ATMOSPHERE
00149 !                     *******************************
00150 !
00151 !***********************************************************************
00152 ! TELEMAC3D   V7P0                                   03/07/2014
00153 !***********************************************************************
00154 !
00155 !
00156 !
00157 !
00158 !
00159 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00160 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00161 !
00162       IMPLICIT NONE
00163 !
00164       PRIVATE
00165       PUBLIC :: SOLRAD,SHORTRAD,EVAPO,RO0,CP
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169 !  BOLT: BOLTZMANN'S CONSTANT
00170       DOUBLE PRECISION, PARAMETER :: BOLT      = 5.67D-8
00171 !  RO0: REFERENCE DENSITY OF WATER AT 4 C AND SAL = 0
00172       DOUBLE PRECISION, PARAMETER :: RO0       = 999.972D0
00173 !  CP: SPECIFIC HEAT OF WATER AT CONSTANT PRESSURE
00174       DOUBLE PRECISION, PARAMETER :: CP        = 4.18D3
00175 !  CP_AIR: SPECIFIC HEAT OF AIR AT CONSTANT PRESSURE
00176       DOUBLE PRECISION, PARAMETER :: CP_AIR    = 1005.D0
00177 !  EMI_EAU: WATER EMISSIVITY
00178       DOUBLE PRECISION, PARAMETER :: EMI_EAU   = 0.97D0
00179 !
00180 !-----------------------------------------------------------------------
00181 !
00182       CONTAINS
00183 !
00184 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00185 !
00186 !                    *****************
00187                      SUBROUTINE SOLRAD
00188 !                    *****************
00189 !
00190      &(RAY_SOL,NEBU,MARDAT,MARTIM,AT,LATITUDE,LONGITUDE)
00191 !
00192 !***********************************************************************
00193 ! TELEMAC-3D V7P0                             22/06/2012
00194 !***********************************************************************
00195 !
00196 !
00197 !
00198 !
00199 !
00200 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00201 !| AT             |-->| CURRENT TIME
00202 !| NEBU           |-->| NEBULOSITY (IN OCTAS)
00203 !| LATITUDE       |-->| LATITUDE
00204 !| LONGITUDE      |-->| LONGITUDE
00205 !| MARDAT         |-->| DATE (YEAR, MONTH,DAY)
00206 !| MARTIM         |-->| TIME (HOUR, MINUTE,SECOND)
00207 !| RAY_SOL        |<--| SOLAR RADIATION INCIDENT ON THE SEA SURFACE
00208 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00209 !
00210       IMPLICIT NONE
00211 !
00212 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00213 !
00214       INTEGER, INTENT(IN)           :: MARDAT(3),MARTIM(3)
00215       DOUBLE PRECISION, INTENT(IN)  :: AT,NEBU
00216       DOUBLE PRECISION, INTENT(IN)  :: LATITUDE,LONGITUDE
00217       DOUBLE PRECISION, INTENT(OUT) :: RAY_SOL
00218 !
00219 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00220 !
00221       INTEGER IYEAR,IMONTH,IDAY,IHOUR,IMIN,ISEC
00222 !  TYPE OF SKY
00223       INTEGER ISKYTYPE
00224 !
00225       DOUBLE PRECISION DTR,PI,ALB
00226       DOUBLE PRECISION DAY,DAYREEL,NDAYS
00227 !  HA  : SUN'S HOUR ANGLE         [rad]
00228 !  HR  : TIME OF THE DAY IN HOURS (GMT)
00229 !  RDEC: SUN'S DECLINATION        [rad]
00230 !  RLAT: LATITUDE                 [rad]
00231 !  SING: SIN(GAMMA)
00232 !  TE  : TIME EQUATION            [hours]
00233       DOUBLE PRECISION HA,HR,RDEC,RLAT,SING,TE
00234 !  AA,BB: COEFFICIENTS DEALING WITH LUMINOSITY AND SKY COLOUR
00235       DOUBLE PRECISION AA,BB
00236 !
00237 !     INTEGER  LEAP,DAYNUM
00238 !     EXTERNAL LEAP,DAYNUM
00239 !
00240 !-----------------------------------------------------------------------
00241 !
00242 !  DEFAULT VALUE, MAY BE CHANGED
00243       ISKYTYPE = 2
00244 !
00245       IF(ISKYTYPE.EQ.1) THEN
00246 !  VERY PURE SKY
00247         AA = 1130.D0
00248         BB = 1.15D0
00249       ELSEIF(ISKYTYPE.EQ.2) THEN
00250 !  MEAN PURE SKY
00251         AA = 1080.D0
00252         BB = 1.22D0
00253       ELSEIF(ISKYTYPE.EQ.3) THEN
00254 !  INDUSTRIAL AREA
00255         AA = 995.D0
00256         BB = 1.25D0
00257       ENDIF
00258 !
00259       IYEAR  = MARDAT(1)
00260       IMONTH = MARDAT(2)
00261       IDAY   = MARDAT(3)
00262       IHOUR  = MARTIM(1)
00263       IMIN   = MARTIM(2)
00264       ISEC   = MARTIM(3)
00265 !
00266 !-----------------------------------------------------------------------
00267 !
00268       PI  = 4.D0*ATAN(1.D0)
00269       DTR = PI/180.D0
00270 !
00271 !  DAY NUMBER, ORBITAL CORRECTION
00272       DAY = DAYNUM(IYEAR,IMONTH,IDAY,IHOUR,IMIN,ISEC)
00273      &    + FLOOR(AT/86400.D0)
00274       NDAYS = 365.D0 + REAL(LEAP(IYEAR))
00275       DAYREEL = MODULO(DAY, NDAYS)
00276 
00277 !  ALBEDO WITH RESPECT OF THE MONTH
00278       IF(DAYREEL.GE.0.D0.AND.DAYREEL.LE.31.D0) THEN
00279         ALB = 0.11D0
00280       ELSEIF(DAYREEL.GT.31.D0.AND.DAYREEL.LE.59.D0) THEN
00281         ALB = 0.10D0
00282       ELSEIF(DAYREEL.GT.59.D0.AND.DAYREEL.LE.90.D0) THEN
00283         ALB = 0.08D0
00284       ELSEIF(DAYREEL.GT.90.D0.AND.DAYREEL.LE.120.D0) THEN
00285         ALB = 0.07D0
00286       ELSEIF(DAYREEL.GT.120.D0.AND.DAYREEL.LE.151.D0) THEN
00287         ALB = 0.06D0
00288       ELSEIF(DAYREEL.GT.151.D0.AND.DAYREEL.LE.181.D0) THEN
00289         ALB = 0.06D0
00290       ELSEIF(DAYREEL.GT.181.D0.AND.DAYREEL.LE.212.D0) THEN
00291         ALB = 0.06D0
00292       ELSEIF(DAYREEL.GT.212.D0.AND.DAYREEL.LE.243.D0) THEN
00293         ALB = 0.07D0
00294       ELSEIF(DAYREEL.GT.243.D0.AND.DAYREEL.LE.273.D0) THEN
00295         ALB = 0.07D0
00296       ELSEIF(DAYREEL.GT.273.D0.AND.DAYREEL.LE.304.D0) THEN
00297         ALB = 0.08D0
00298       ELSEIF(DAYREEL.GT.304.D0.AND.DAYREEL.LE.334.D0) THEN
00299         ALB = 0.11D0
00300       ELSEIF(DAYREEL.GT.334.D0.AND.DAYREEL.LE.365.D0) THEN
00301         ALB = 0.12D0
00302       ENDIF
00303 
00304 !  DECLINATION OF SUN (COOPER'S FORMULA)
00305 !      RDEC = (23.45D0*SIN(2.D0*PI*(DAYREEL+284.D0)/NDAYS))*DTR
00306       RDEC = (23.45D0*COS(2.D0*PI*(172.D0-DAYREEL)/NDAYS))*DTR
00307 
00308 !  TIME EQUATION
00309       TE = ( 450.68D0*SIN(2.D0*PI*DAYREEL/NDAYS-0.026903D0)
00310      &      +595.40D0*SIN(4.D0*PI*DAYREEL/NDAYS+0.352835D0))/3600.D0
00311 !  SOLAR ALTITUDE
00312       HR = IHOUR+MODULO(AT,86400.D0)/3600.D0
00313 !
00314       RLAT = LATITUDE*DTR
00315       HA   = (HR-TE-12.D0 + LONGITUDE/15.D0)*PI/12.D0
00316       SING = SIN(RLAT)*SIN(RDEC) + COS(RLAT)*COS(RDEC)*COS(HA)
00317 !  SOLAR RADIATION
00318       IF(SING.LE.0.D0) THEN
00319         RAY_SOL = 0.D0
00320       ELSE
00321 !  THE NEBULOSITY IS GIVEN IN OCTAS
00322         RAY_SOL = AA*(SING**BB)*(1.D0-0.65D0*(NEBU/8.D0)**2)
00323      &              *(1.D0-ALB)
00324       ENDIF
00325 !
00326 !-----------------------------------------------------------------------
00327 !
00328       RETURN
00329       END SUBROUTINE SOLRAD
00330 
00331 !                        *********************
00332                          INTEGER FUNCTION LEAP
00333 !                        *********************
00334 !
00335      &(IYEAR)
00336 !
00337 !***********************************************************************
00338 ! TELEMAC-3D V6P2                             27/06/2012
00339 !***********************************************************************
00340 !
00341 !
00342 !
00343 !
00344 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00345 !| IYEAR          |-->| INDEX OF YEAR
00346 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00347 !
00348       IMPLICIT NONE
00349 !
00350 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00351 !
00352       INTEGER, INTENT(IN) :: IYEAR
00353 !
00354 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00355 !
00356       IF( MOD(IYEAR,4).EQ.0.AND.
00357      &   (MOD(IYEAR,100).NE.0.OR.MOD(IYEAR,400).EQ.0)) THEN
00358         LEAP = 1
00359       ELSE
00360         LEAP = 0
00361       ENDIF
00362 !
00363 !-----------------------------------------------------------------------
00364 !
00365       RETURN
00366       END FUNCTION LEAP
00367 
00368 !                   ********************************
00369                     DOUBLE PRECISION FUNCTION DAYNUM
00370 !                   ********************************
00371 !
00372      &(IYEAR,IMONTH,IDAY,IHOUR,IMIN,ISEC)
00373 !
00374 !***********************************************************************
00375 ! TELEMAC-3D V6P2                             27/06/2012
00376 !***********************************************************************
00377 !
00378 !
00379 !
00380 !
00381 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00382 !| IDAY           |-->| INDEX OF DAY
00383 !| IHOUR          |-->| INDEX OF HOUR
00384 !| IMIN           |-->| INDEX OF MINUTE
00385 !| IMONTH         |-->| INDEX OF MONTH
00386 !| ISEC           |-->| INDEX OF SECOND
00387 !| IYEAR          |-->| INDEX OF YEAR
00388 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00389 !
00390       IMPLICIT NONE
00391 !
00392 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00393 !
00394       INTEGER, INTENT(IN) :: IYEAR,IMONTH,IDAY,IHOUR,IMIN,ISEC
00395 !
00396 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00397 !
00398 !
00399 !     INTEGER  LEAP
00400 !     EXTERNAL LEAP
00401 !
00402       INTEGER MONTH(12)
00403       DATA MONTH /0,31,59,90,120,151,181,212,243,273,304,334/
00404 !
00405 !-----------------------------------------------------------------------
00406 !
00407       DAYNUM = REAL(MONTH(IMONTH)+IDAY)
00408      &       + REAL(IHOUR)/24.D0+REAL(IMIN)/1440.D0+REAL(ISEC)/86400.D0
00409       IF(IMONTH.GT.2) DAYNUM = DAYNUM + REAL(LEAP(IYEAR))
00410 !
00411 !-----------------------------------------------------------------------
00412 !
00413       RETURN
00414       END FUNCTION DAYNUM
00415 
00416 !                    *******************
00417                      SUBROUTINE SHORTRAD
00418 !                    *******************
00419 !
00420      &(TREEL,TAIR,NEBU,RAY_ATM,RAY_EAU)
00421 !
00422 !***********************************************************************
00423 ! TELEMAC-3D V7P0                             22/06/2012
00424 !***********************************************************************
00425 !
00426 !
00427 !
00428 !
00429 !
00430 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00431 !| NEBU           |-->| NEBULOSITY (IN OCTAS)
00432 !| RAY_ATM        |<--| ATMOSPHERIC RADIATION
00433 !| RAY_EAU        |<--| WATER RADIATION
00434 !| TAIR           |-->| AIR TEMPERATURE
00435 !| TREEL          |-->| REAL WATER TEMPERATURE
00436 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00437 !
00438       IMPLICIT NONE
00439 !
00440 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00441 !
00442       DOUBLE PRECISION, INTENT(IN)  :: TREEL,TAIR,NEBU
00443       DOUBLE PRECISION, INTENT(OUT) :: RAY_ATM,RAY_EAU
00444 !
00445 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00446 !
00447 !  EMI_AIR: AIR EMISSIVITY
00448       DOUBLE PRECISION EMI_AIR
00449 !  NUA: COEFFICIENT DEPENDING ON THE TYPE OF CLOUDS
00450       DOUBLE PRECISION NUA
00451 !  TYPE OF CLOUD
00452       INTEGER ICLOUDTYPE
00453 !
00454 !-----------------------------------------------------------------------
00455 !
00456 !  DEFAULT VALUE, MAY BE CHANGED
00457       ICLOUDTYPE = 3
00458 !
00459       IF(ICLOUDTYPE.EQ.1) THEN
00460 !  CIRRUS
00461         NUA = 0.04D0
00462       ELSEIF(ICLOUDTYPE.EQ.2) THEN
00463 !  CIRRO STRATUS
00464         NUA = 0.08D0
00465       ELSEIF(ICLOUDTYPE.EQ.3) THEN
00466 !  ALTO CUMULUS (MEAN VALUE, USUALLY USED: T.V.A. 1972)
00467         NUA = 0.17D0
00468       ELSEIF(ICLOUDTYPE.EQ.4) THEN
00469 !  ALTO STRATUS
00470         NUA = 0.20D0
00471       ELSEIF(ICLOUDTYPE.EQ.5) THEN
00472 !  STRATUS
00473         NUA = 0.24D0
00474       ENDIF
00475 !
00476 !  ATMOSPHERE RADIATION
00477       EMI_AIR = 0.937D-5*((TAIR+273.15D0)**2)
00478 !  THE NEBULOSITY IS GIVEN IN OCTAS
00479       RAY_ATM = 0.97D0*EMI_AIR*BOLT*(TAIR+273.15D0)**4
00480      &                *(1.D0+NUA*(NEBU/8.D0)**2)
00481 !  WATER RADIATION
00482       RAY_EAU = EMI_EAU*BOLT*(TREEL+273.15D0)**4
00483 !
00484 !-----------------------------------------------------------------------
00485 !
00486       RETURN
00487       END SUBROUTINE SHORTRAD
00488 
00489 !                    ****************
00490                      SUBROUTINE EVAPO
00491 !                    ****************
00492 !
00493      &(TREEL,TAIR,W2,PATM,HREL,RO,FLUX_EVAP,FLUX_SENS,DEBEVAP,B)
00494 !
00495 !***********************************************************************
00496 ! TELEMAC-3D V7P0                             25/06/2012
00497 !***********************************************************************
00498 !
00499 !
00500 !
00501 !
00502 !
00503 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00504 !| B              |-->| PARAMETER TO CALIBRATE
00505 !| DEB_EVAP       |<--| EVAPORATION FLOWRATE AT THE SURFACE
00506 !| FLUX_EVAP      |<--| EVAPORATED WATER FLOWRATE
00507 !| FLUX_SENS      |<--| HEAT FLUX BY CONVECTION
00508 !| HREL           |-->| RELATIVE HUMIDITY
00509 !| PATM           |-->| ATMOSPHERIC PRESSURE
00510 !| RO             |-->| DENSITY
00511 !| TAIR           |-->| AIR TEMPERATURE
00512 !| TREEL          |-->| REAL WATER TEMPERATURE
00513 !| W2             |-->| RELATIVE MAGNITUDE OF WIND AT 2 M
00514 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00515 !
00516       IMPLICIT NONE
00517 !
00518 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00519 !
00520       DOUBLE PRECISION, INTENT(IN)  :: TREEL,TAIR,W2,PATM,HREL,RO,B
00521       DOUBLE PRECISION, INTENT(OUT) :: FLUX_EVAP,FLUX_SENS,DEBEVAP
00522 !
00523 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00524 !
00525       DOUBLE PRECISION Q_SAT_EAU,Q_SAT_AIR,HUMI_EAU,HUMI_AIR,FWW,ROAIR
00526 !
00527 !-----------------------------------------------------------------------
00528 !
00529 !  SATURATION VAPOUR PRESSURE (MAGNUS TETENS)
00530       Q_SAT_EAU  = EXP(2.3026D0*(7.5D0*TREEL/(TREEL+237.3D0)+0.7858D0))
00531       Q_SAT_AIR  = EXP(2.3026D0*(7.5D0*TAIR/(TAIR+237.3D0)+0.7858D0))
00532 
00533 !  AIR DENSITY : IDEAL GAZ LAW
00534       ROAIR =    PATM*100.D0/(287.D0*(TAIR+273.15D0))
00535      &      - 1.32D-5*HREL*Q_SAT_AIR/(TAIR+273.15D0)
00536 
00537 !  HUMIDITY
00538 !  0.378D0 = 1.D0-0.622D0
00539       HUMI_EAU  = 0.622D0*Q_SAT_EAU/(PATM-0.378D0*Q_SAT_EAU)
00540       HUMI_AIR  =        0.622D0*(HREL/100.D0)*Q_SAT_AIR
00541      &          / (PATM-(0.378D0*(HREL/100.D0)*Q_SAT_AIR))
00542 !  HEAT FLUX BY EVAPORATION (SALENCON)
00543       FWW       = B*(1.D0+W2)
00544 !
00545       FLUX_EVAP = ROAIR*(2500.9D3-TREEL*2.365D3)*FWW
00546      &                 *(HUMI_EAU-HUMI_AIR)
00547 !  HEAT FLUX BY CONVECTION
00548       FLUX_SENS = CP_AIR*ROAIR*FWW*(TREEL-TAIR)
00549 !  EVAPORATION FLOWRATE AT THE SURFACE
00550       DEBEVAP   = ROAIR*FWW/RO*(HUMI_EAU-HUMI_AIR)
00551 !
00552 !-----------------------------------------------------------------------
00553 !
00554       RETURN
00555       END SUBROUTINE EVAPO
00556 !
00557 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00558 !
00559       END MODULE EXCHANGE_WITH_ATMOSPHERE

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0