pkg/exf/exf_zenithangle_table.F

94390f4f16 Gael*0001 #include "EXF_OPTIONS.h"
                0002
54dfefdf91 Jean*0003       SUBROUTINE EXF_ZENITHANGLE_TABLE( myThid )
94390f4f16 Gael*0004
                0005 C     ==================================================================
                0006 C     SUBROUTINE exf_zenithangle_table
                0007 C     ==================================================================
                0008 C
                0009 C     o compute table of daily mean albedo that will be used in exf_zenithangle.F
                0010 C
                0011 C     ==================================================================
                0012 C     SUBROUTINE exf_zenithangle_table
                0013 C     ==================================================================
                0014
                0015       IMPLICIT NONE
                0016
                0017 C     == global variables ==
                0018 #include "EEPARAMS.h"
                0019 #include "SIZE.h"
                0020 #include "PARAMS.h"
                0021 #include "GRID.h"
                0022 #include "EXF_PARAM.h"
                0023 #include "EXF_FIELDS.h"
                0024 #include "EXF_CONSTANTS.h"
                0025
                0026 C     == routine arguments ==
                0027       INTEGER myThid
                0028
                0029 #ifdef ALLOW_DOWNWARD_RADIATION
                0030 #ifdef ALLOW_ZENITHANGLE
                0031 C     == local variables ==
                0032       INTEGER bi,bj
                0033       INTEGER i,j
                0034       _RL FSOL, dD0dDsq, SOLC, tmpINT1, tmpINT2
                0035       _RL LLLAT, TYEAR, TDAY, ALPHA, CZEN, ALBSEA1
                0036       _RL DECLI, ZS, ZC, SJ, CJ, TMPA, TMPB
54dfefdf91 Jean*0037       INTEGER iLat,iTyear,iTday
94390f4f16 Gael*0038 C     == end of interface ==
                0039
d106b5e2d8 Gael*0040       _BEGIN_MASTER( myThid )
94390f4f16 Gael*0041
54dfefdf91 Jean*0042 C solar constant
                0043 C --------------
94390f4f16 Gael*0044       SOLC   = 1368. _d 0
                0045
                0046          DO iLat=1,181
e19d0cc6b2 Gael*0047           DO iTyear=1,366
94390f4f16 Gael*0048
e19d0cc6b2 Gael*0049         LLLAT=(iLat-91. _d 0)
                0050         TYEAR=(iTyear-1. _d 0)/365. _d 0
94390f4f16 Gael*0051
54dfefdf91 Jean*0052 C determine solar declination
                0053 C ---------------------------
                0054 C       (formula from Hartmann textbook, after Spencer 1971)
94390f4f16 Gael*0055         ALPHA= 2. _d 0*PI*TYEAR
                0056         DECLI = 0.006918 _d 0
                0057      &       - 0.399912 _d 0 * cos ( 1. _d 0 * ALPHA )
                0058      &       + 0.070257 _d 0 * sin ( 1. _d 0 * ALPHA )
                0059      &       - 0.006758 _d 0 * cos ( 2. _d 0 * ALPHA )
                0060      &       + 0.000907 _d 0 * sin ( 2. _d 0 * ALPHA )
                0061      &       - 0.002697 _d 0 * cos ( 3. _d 0 * ALPHA )
                0062      &       + 0.001480 _d 0 * sin ( 3. _d 0 * ALPHA )
                0063
                0064         ZC = COS(DECLI)
                0065         ZS = SIN(DECLI)
                0066         SJ = SIN(LLLAT * deg2rad)
                0067         CJ = COS(LLLAT * deg2rad)
                0068         TMPA = SJ*ZS
                0069         TMPB = CJ*ZC
                0070
54dfefdf91 Jean*0071 C compute squared earth-sun distance ratio
                0072 C ----------------------------------------
                0073 C       (formula from Hartmann textbook, after Spencer 1971)
                0074         dD0dDsq = 1.000110 _d 0
94390f4f16 Gael*0075      &         + 0.034221 _d 0 * cos ( 1. _d 0 * ALPHA )
                0076      &         + 0.001280 _d 0 * sin ( 1. _d 0 * ALPHA )
                0077      &         + 0.000719 _d 0 * cos ( 2. _d 0 * ALPHA )
                0078      &         + 0.000077 _d 0 * sin ( 2. _d 0 * ALPHA )
                0079
                0080         tmpINT1=0. _d 0
54dfefdf91 Jean*0081         tmpINT2=0. _d 0
e19d0cc6b2 Gael*0082         DO iTday=1,100
                0083             TDAY=iTday/100. _d 0
54dfefdf91 Jean*0084 C determine DAILY VARYING cos of solar zenith angle CZEN
                0085 C ------------------------------------------------------
                0086             CZEN = TMPA + TMPB *
94390f4f16 Gael*0087      &         cos( 2. _d 0 *PI* TDAY + 0. _d 0 * deg2rad )
54dfefdf91 Jean*0088             IF ( CZEN .LE.0 ) CZEN = 0. _d 0
                0089 C compute incoming flux at the top of the atm.:
                0090 C ---------------------------------------------
94390f4f16 Gael*0091             FSOL = SOLC * dD0dDsq * MAX( 0. _d 0, CZEN )
54dfefdf91 Jean*0092 C determine direct ocean albedo
                0093 C -----------------------------
                0094 C       (formula from Briegleb, Minnis, et al 1986)
94390f4f16 Gael*0095             ALBSEA1 = ( ( 2.6 _d 0 / (CZEN**(1.7 _d 0) + 0.065 _d 0) )
                0096      &          + ( 15. _d 0 * (CZEN-0.1 _d 0) * (CZEN-0.5 _d 0)
                0097      &          * (CZEN-1.0 _d 0) ) ) / 100.0 _d 0
54dfefdf91 Jean*0098 C accumulate averages
                0099 C -------------------
94390f4f16 Gael*0100             tmpINT1=tmpINT1+FSOL*ALBSEA1/100. _d 0
                0101             tmpINT2=tmpINT2+FSOL/100. _d 0
e19d0cc6b2 Gael*0102          ENDDO
54dfefdf91 Jean*0103 C compute weighted average of albedo
                0104 C ----------------------------------
                0105          IF ( 0.5 _d 0 * tmpINT2 .GT. tmpINT1) THEN
d106b5e2d8 Gael*0106             zen_albedo_table(iTyear,iLat)=tmpINT1/tmpINT2
54dfefdf91 Jean*0107          ELSE
d106b5e2d8 Gael*0108             zen_albedo_table(iTyear,iLat)=0.5 _d 0
54dfefdf91 Jean*0109          ENDIF
94390f4f16 Gael*0110
                0111           ENDDO
                0112          ENDDO
                0113
d106b5e2d8 Gael*0114       _END_MASTER( myThid )
                0115       _BARRIER
94390f4f16 Gael*0116
                0117
54dfefdf91 Jean*0118 C determine interpolation coefficient for each grid point
94390f4f16 Gael*0119        DO bj = myByLo(myThid),myByHi(myThid)
e19d0cc6b2 Gael*0120         DO bi = myBxLo(myThid),myBxHi(myThid)
                0121          DO j = 1,sNy
                0122           DO i = 1,sNx
94390f4f16 Gael*0123            LLLAT=yC(i,j,bi,bj)+91. _d 0
54dfefdf91 Jean*0124 C ensure that it is in valid range
d106b5e2d8 Gael*0125            LLLAT=max(LLLAT, 1. _d 0)
                0126            LLLAT=min(LLLAT, 181. _d 0)
54dfefdf91 Jean*0127 C store
94390f4f16 Gael*0128            zen_albedo_pointer(i,j,bi,bj)=LLLAT
                0129           ENDDO
                0130          ENDDO
                0131         ENDDO
                0132        ENDDO
                0133
                0134 #endif /* ALLOW_ZENITHANGLE */
                0135 #endif /* ALLOW_DOWNWARD_RADIATION */
                0136
                0137       RETURN
                0138       END