SUBROUTINE ALBAER(SLMSK,SNOWF,ZORLF,COSZF,TSEAF,HPRIF,TGDF, & ALVSF,ALNSF,ALVWF,ALNWF,FACSF,FACWF,PI,DLTG, & KPRFG,IDXCG,CMIXG,DENNG,XLAT,XLON, & ALVBR,ALNBR,ALVDR,ALNDR,KAER,KPRF,IDXC, & CMIX,DENN,NXC,NDN,IMXAE,JMXAE,LEN,T0C) !FPP$ NOCONCUR R !******************************************************************* ! THIS PROGRAM COMPUTES FOUR COMPONENTS OF SURFACE ALBEDOS (I.E. ! VIS-NIR, DIRECT-DIFFUSED), from vis/nir strong/weak zenith angle ! dependency, BASED ON BRIEGLEB'S SCHEME. AND ! BILINEARLY INTERPOLATES ALBEDO AND AEROSOL DISTRIBUTION TO ! RADIATION GRID....SEASONAL INTERPOLATION DONE IN CYCLE..HLP FEB98 ! ! INPUT VARIABLES: ! SLMSK - SEA(0),LAND(1),ICE(2) MASK ON FCST MODEL GRID ! SNOWF - SNOW DEPTH WATER EQUIVALENT IN MM ! ZORLF - SURFACE ROUGHNESS IN CM ! COSZF - COSIN OF SOLAR ZENITH ANGLE ! TSEAF - SEA SURFACE TEMPERATURE IN K ! HPRIF - TOPOGRAPHIC SDV IN M ! TGDF - GROUND SOIL TEMPERATURE IN K ! ALVSF - MEAN VIS ALBEDO WITH STRONG COSZ DEPENDENCY ! ALNSF - MEAN NIR ALBEDO WITH STRONG COSZ DEPENDENCY ! ALVWF - MEAN VIS ALBEDO WITH WEAK COSZ DEPENDENCY ! ALNWF - MEAN NIR ALBEDO WITH WEAK COSZ DEPENDENCY ! FACSF - FRACTIONAL COVERAGE WITH STRONG COSZ DEPENDENCY ! FACWF - FRACTIONAL COVERAGE WITH WEAK COSZ DEPENDENCY ! KPRFG, IDXCG, CMIXG, DENNG ! - GLOBAL DIST OF TROPOSPHERIC AEROSOLS DATA: ! PROFILE TYPE, COMPONENT INDEX, COMPONENT MIXING RATIO, ! AND NUMBER DENSITY (FOR FIRST AND SECOND LAYERS) ! XLON, XLAT ! - LONGITUDE AND LATITUDE OF GIVEN POINTS IN RADIANCE ! ! OUTPUT VARIABLES: (ALL ON RADIATION GRID) ! ALVBR - VIS BEAM SURFACE ALBEDO ! ALNBR - NIR BEAM SURFACE ALBEDO ! ALVDR - VIS DIFF SURFACE ALBEDO ! ALNDR - NIR DIFF SURFACE ALBEDO ! KPRF, IDXC, CMIX, DENN ! - AEROSOL DATA FOR THE SELECTED GRID POINTS ! ! Nov. 97 - MODIFIED SNOW ALBEDO (USE HPRIF, JSNO) - YH ! JAN 98 - TO INCLUDE GRUMBINE'S SEAICE SCHEME ! AND USE SLMSKR TO SETUP TWO BASIC ! TYPES OF AEROSOLS (CONT-I, MAR-I) - YH ! MAR 00 - MODIFIED TO USE OPAC AEROSOL DATA(1998) - YH ! !****************************************************************** ! --- INPUT ! USE MACHINE , ONLY : kind_rad implicit none ! integer len, imxae, jmxae, nxc, ndn, kaer ! --- INPUT real (kind=kind_rad) SLMSK(LEN), SNOWF(LEN), ZORLF(LEN) &, TSEAF(LEN), COSZF(LEN), HPRIF(LEN) &, ALVSF(LEN), ALNSF(LEN), ALVWF(LEN) &, ALNWF(LEN), FACSF(LEN), FACWF(LEN) &, TGDF(LEN), PI, DLTG &, CMIXG(NXC,IMXAE,JMXAE), XLON(LEN) &, DENNG(NDN,IMXAE,JMXAE), XLAT(LEN) ! integer IDXCG(NXC,IMXAE,JMXAE),KPRFG(IMXAE,JMXAE) ! --- OUTPUT real (kind=kind_rad) ALVBR(LEN), ALNBR(LEN), ALVDR(LEN) &, ALNDR(LEN), CMIX(NXC,LEN), DENN(NDN,LEN) &, TEMP1, TEMP2 integer IDXC(NXC,LEN), KPRF(LEN) ! --- Local VARIABLES real (kind=kind_rad) ASNVB, ASNNB, ASNVD, ASNND, ASEVB &, ASENB, ASEVD, ASEND, FSNO, FSEA &, RFCS, RFCW, FLND ! &, ASNOW, ARGH, HRGH, FSNO0, FSNO1 &, FLND0, FSEA0, DTSQ, DTGD, CSNOW &, A1, A2, B1, B2, T0C &, tmp1, tmp2, hdlt, rdg integer i,i1, i2, j1, j2, j3, k ! DO I=1,LEN ! ! --- MODIFIED SNOW ALBEDO SCHEME - UNITS CONVERT TO M ! (ORIGINALLY SNOWF IN MM; ZORLF IN CM) ASNOW = 0.02*SNOWF(I) ARGH = MIN(0.50, MAX(.025, 0.01*ZORLF(I))) HRGH = MIN(1.0, MAX(0.20, 1.0577-1.1538E-3*HPRIF(I) ) ) FSNO0 = ASNOW / (ARGH + ASNOW) * HRGH IF (SLMSK(I).EQ.0.0 .AND. TSEAF(I).GT.271.2) FSNO0 = 0.0 FSNO1 = 1.0 - FSNO0 FLND0 = MIN(1.0, FACSF(I)+FACWF(I)) FSEA0 = MAX(0.0, 1.0 - FLND0) FSNO = FSNO0 FSEA = FSEA0 * FSNO1 FLND = FLND0 * FSNO1 ! --- DIFFUSED SEA SURFACE ALBEDO IF (TSEAF(I) .GE. 271.5) THEN ASEVD = 0.06 ASEND = 0.06 ELSE IF (TSEAF(I) .LT. 271.1) THEN ASEVD = 0.70 ASEND = 0.65 ELSE DTSQ = (TSEAF(I) - 271.1)**2 ASEVD = 0.7 - 4.0*DTSQ ASEND = 0.65 - 3.6875*DTSQ END IF ! --- DIFFUSED SNOW ALBEDO IF (SLMSK(I) .EQ. 2.0) THEN ! (Bob Grumbine's method for snow covered sea ice) DTGD = MAX(0.0, MIN(5.0, 273.16-TGDF(I)) ) ASNVD = 0.70 + 0.03 * DTGD ASNND = 0.60 + 0.03 * DTGD ASEVD = 0.70 ASEND = 0.65 ELSE ASNVD = 0.90 ASNND = 0.75 END IF ! ! --- DIRECT SNOW ALBEDO IF (COSZF(I) .LT. 0.5) THEN CSNOW = 0.5 * (3.0 / (1.0+4.0*COSZF(I)) - 1.0) ASNVB = MIN( 0.98, ASNVD+(1.0-ASNVD)*CSNOW ) ASNNB = MIN( 0.98, ASNND+(1.0-ASNND)*CSNOW ) ELSE ASNVB = ASNVD ASNNB = ASNND END IF ! --- DIRECT SEA SURFACE ALBEDO IF (COSZF(I) .GT.0.0) THEN RFCS = 1.4 / (1.0 + 0.8*COSZF(I)) !ERROR RFCS = 1.4 / (1.0 + 0.4*COSZF(I)) RFCW = 1.1 / (1.0 + 0.2*COSZF(I)) IF (TSEAF(I) .GE. T0C) THEN ASEVB = MAX(ASEVD, 0.026/(COSZF(I)**1.7+0.065) & + 0.15 * (COSZF(I)-0.1) * (COSZF(I)-0.5) & * (COSZF(I)-1.0)) ASENB = ASEVB ELSE ASEVB = ASEVD ASENB = ASEND END IF ELSE RFCS = 1.0 RFCW = 1.0 ASEVB = ASEVD ASENB = ASEND END IF ! A1 = ALVSF(I) * FACSF(I) B1 = ALVWF(I) * FACWF(I) A2 = ALNSF(I) * FACSF(I) B2 = ALNWF(I) * FACWF(I) ALVBR(I) = (A1*RFCS + B1*RFCW) *FLND & + ASEVB*FSEA + ASNVB*FSNO ALVDR(I) = (A1 + B1 )*FLND & + ASEVD*FSEA + ASNVD*FSNO ALNBR(I) = (A2*RFCS + B2*RFCW) *FLND & + ASENB*FSEA + ASNNB*FSNO ALNDR(I) = (A2 + B2 )*FLND & + ASEND*FSEA + ASNND*FSNO ! ENDDO ! if (kaer .gt. 0) then ! !.... AEROSOL DISTRIBUTIONS !YH0400 USE OPAC AEROSOL DATA RDG = 180.0 / PI HDLT = 0.5 * DLTG ! I2 = 1 J2 = 1 DO I=1,LEN TMP1 = XLON(I) * RDG DO I1=1,IMXAE TMP2 = DLTG * (I1 - 1) IF (TMP2 .GT. 360.0-HDLT) THEN TMP2 = TMP2 - 360.0 END IF IF (ABS(TMP1-TMP2) .LE. HDLT) THEN I2 = I1 GO TO 40 END IF END DO 40 TMP1 = XLAT(I) * RDG DO J1=1,JMXAE TMP2 = 90.0 - DLTG * (J1 - 1) IF (ABS(TMP1-TMP2) .LE. HDLT) THEN J2 = J1 GO TO 50 END IF END DO ! 50 KPRF(I) = KPRFG(I2,J2) DO K=1,NXC IDXC(K,I) = IDXCG(K,I2,J2) CMIX(K,I) = CMIXG(K,I2,J2) END DO DO K=1,NDN DENN(K,I) = DENNG(K,I2,J2) END DO ENDDO endif ! RETURN END