pkg/exf/exf_radiation.F

3752238fd8 Patr*0001 #include "EXF_OPTIONS.h"
                0002
701e10a905 Mart*0003 CBOP
                0004 C !ROUTINE: EXF_RADIATION
3752238fd8 Patr*0005
701e10a905 Mart*0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE EXF_RADIATION( exf_Tsf, myTime, myIter, myThid )
                0008
                0009 C !DESCRIPTION:
                0010 C Set radiative fluxes at the surface
86169a449d Jean*0011 C
701e10a905 Mart*0012 C - Use atmospheric state to compute surface fluxes.
                0013 C - Compute net from downward and downward from net longwave and
                0014 C   shortwave radiation, IF needed.
                0015 C   lwflux = Stefan-Boltzmann constant * emissivity * SST - lwdown
                0016 C   swflux = - ( 1 - albedo ) * swdown
3752238fd8 Patr*0017
701e10a905 Mart*0018 C !USES:
86169a449d Jean*0019       IMPLICIT NONE
701e10a905 Mart*0020 C == Global variables ==
3752238fd8 Patr*0021 #include "EEPARAMS.h"
                0022 #include "SIZE.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
082e18c36c Jean*0025 #include "EXF_PARAM.h"
                0026 #include "EXF_FIELDS.h"
                0027 #include "EXF_CONSTANTS.h"
3752238fd8 Patr*0028
701e10a905 Mart*0029 C !INPUT PARAMETERS:
                0030 C myTime  :: Current time in simulation
                0031 C myIter  :: Current iteration number in simulation
                0032 C myThid  :: My Thread Id number
                0033 C exf_Tsf :: local copy of global field gcmSST or extrapolated
                0034 C            surface temperature (in deg Celsius)
86169a449d Jean*0035       _RL     myTime
                0036       INTEGER myIter
                0037       INTEGER myThid
701e10a905 Mart*0038       _RL exf_Tsf(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
3752238fd8 Patr*0039
86169a449d Jean*0040 #ifdef ALLOW_DOWNWARD_RADIATION
701e10a905 Mart*0041 C !LOCAL VARIABLES: ====================================================
                0042 C bi,bj     :: Tile indices
                0043 C kl,ks    :: loop indices
86169a449d Jean*0044       INTEGER bi,bj
                0045       INTEGER i,j
                0046 #ifdef ALLOW_ATM_TEMP
701e10a905 Mart*0047 c     INTEGER ks
                0048       INTEGER kl
86169a449d Jean*0049 #endif
701e10a905 Mart*0050 CEOP
3752238fd8 Patr*0051
86169a449d Jean*0052 #ifdef ALLOW_ATM_TEMP
701e10a905 Mart*0053 c     ks = 1
c2c9eed210 Jean*0054       kl = 2
0320e25227 Mart*0055       IF ( usingPCoords ) THEN
701e10a905 Mart*0056 c      ks = Nr
0320e25227 Mart*0057        kl = Nr-1
                0058       ENDIF
3752238fd8 Patr*0059
86169a449d Jean*0060       IF ( lwfluxfile .EQ. ' ' .AND. lwdownfile .NE. ' ' ) THEN
                0061 C     Loop over tiles.
                0062        DO bj = myByLo(myThid),myByHi(myThid)
                0063         DO bi = myBxLo(myThid),myBxHi(myThid)
                0064
701e10a905 Mart*0065          DO j = 1,sNy
                0066           DO i = 1,sNx
                0067            lwflux(i,j,bi,bj) =
ae468ace59 Mart*0068      &          ocean_emissivity*stefanBoltzmann*
701e10a905 Mart*0069      &          exf_Tsf(i,j,bi,bj)**4
86169a449d Jean*0070      &          - lwdown(i,j,bi,bj)
45e2e117da Mart*0071 #ifdef EXF_LWDOWN_WITH_EMISSIVITY
701e10a905 Mart*0072      &          *ocean_emissivity
45e2e117da Mart*0073 C     the lw exitance (= out-going long wave radiation) is
                0074 C     emissivity*stefanBoltzmann*T^4 + rho*lwdown, where the
                0075 C     reflectivity rho = 1-emissivity for conservation reasons:
                0076 C     the sum of emissivity, reflectivity, and transmissivity must be
                0077 C     one, and transmissivity is zero in our case (long wave radiation
                0078 C     does not penetrate the ocean surface)
                0079 #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
86169a449d Jean*0080           ENDDO
701e10a905 Mart*0081          ENDDO
86169a449d Jean*0082
                0083 C--   end bi,bj loops
                0084         ENDDO
                0085        ENDDO
                0086       ENDIF
                0087
                0088 C-jmc: commented out: no need to compute Downward-LW (not used) from Net-LW
                0089 c     IF ( lwfluxfile .NE. ' ' .AND. lwdownfile .EQ. ' ' ) THEN
                0090 C     Loop over tiles.
                0091 c      DO bj = myByLo(myThid),myByHi(myThid)
                0092 c       DO bi = myBxLo(myThid),myBxHi(myThid)
                0093 c        DO j = 1,sNy
                0094 c         DO i = 1,sNx
                0095 c          lwdown(i,j,bi,bj) =
                0096 c    &          ocean_emissivity*stefanBoltzmann*
701e10a905 Mart*0097 c    &          ((gcmSST(i,j,bi,bj)+cen2kel)**4)
86169a449d Jean*0098 c    &          - lwflux(i,j,bi,bj)
                0099 c         ENDDO
                0100 c        ENDDO
                0101 c       ENDDO
                0102 c      ENDDO
                0103 c     ENDIF
                0104 #endif /* ALLOW_ATM_TEMP */
3752238fd8 Patr*0105
ae468ace59 Mart*0106 #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
86169a449d Jean*0107       IF ( swfluxfile .EQ. ' ' .AND. swdownfile .NE. ' ' ) THEN
94390f4f16 Gael*0108 #ifdef ALLOW_ZENITHANGLE
d106b5e2d8 Gael*0109       IF ( useExfZenAlbedo .OR. useExfZenIncoming ) THEN
94390f4f16 Gael*0110        CALL EXF_ZENITHANGLE(myTime, myIter, myThid)
4e4ad91a39 Jean*0111 #ifdef ALLOW_AUTODIFF
a208a26389 Gael*0112       ELSE
                0113        DO bj = myByLo(myThid),myByHi(myThid)
                0114         DO bi = myBxLo(myThid),myBxHi(myThid)
                0115          DO j = 1,sNy
                0116           DO i = 1,sNx
                0117            zen_albedo (i,j,bi,bj) = 0. _d 0
                0118            zen_fsol_diurnal (i,j,bi,bj) = 0. _d 0
                0119            zen_fsol_daily (i,j,bi,bj) = 0. _d 0
                0120           ENDDO
                0121          ENDDO
                0122         ENDDO
                0123        ENDDO
                0124 #endif
94390f4f16 Gael*0125       ENDIF
423768d890 Jean*0126 #endif /* ALLOW_ZENITHANGLE */
86169a449d Jean*0127        DO bj = myByLo(myThid),myByHi(myThid)
                0128         DO bi = myBxLo(myThid),myBxHi(myThid)
94390f4f16 Gael*0129 #ifdef ALLOW_ZENITHANGLE
423768d890 Jean*0130          IF ( useExfZenAlbedo ) THEN
                0131           DO j = 1,sNy
                0132            DO i = 1,sNx
                0133             swflux(i,j,bi,bj) = - swdown(i,j,bi,bj)
                0134      &                        * (1.0-zen_albedo(i,j,bi,bj))
                0135            ENDDO
86169a449d Jean*0136           ENDDO
423768d890 Jean*0137          ELSE
                0138 #endif /* ALLOW_ZENITHANGLE */
                0139           DO j = 1,sNy
                0140            DO i = 1,sNx
                0141             swflux(i,j,bi,bj) = - swdown(i,j,bi,bj)
                0142      &                        * (1.0-exf_albedo)
                0143            ENDDO
                0144           ENDDO
                0145 #ifdef ALLOW_ZENITHANGLE
                0146          ENDIF
                0147 #endif
86169a449d Jean*0148         ENDDO
                0149        ENDDO
                0150       ENDIF
                0151 C-jmc: commented out: no need to compute Downward-SW (not used) from Net-SW
                0152 c     IF ( swfluxfile .NE. ' ' .AND. swdownfile .EQ. ' ' ) THEN
                0153 c      DO bj = myByLo(myThid),myByHi(myThid)
                0154 c       DO bi = myBxLo(myThid),myBxHi(myThid)
                0155 c        DO j = 1,sNy
                0156 c         DO i = 1,sNx
                0157 c          swdown(i,j,bi,bj) = -swflux(i,j,bi,bj) / (1.0-exf_albedo)
                0158 c         ENDDO
                0159 c        ENDDO
                0160 c       ENDDO
                0161 c      ENDDO
                0162 c     ENDIF
423768d890 Jean*0163 #endif /* ALLOW_ATM_TEMP or SHORTWAVE_HEATING */
ae468ace59 Mart*0164
                0165 #endif /* ALLOW_DOWNWARD_RADIATION */
3752238fd8 Patr*0166
86169a449d Jean*0167       RETURN
                0168       END