Back to home page

MITgcm
 
 

    

File indexing completed on 2021-08-12 05:11:36 UTC

view on githubraw file Latest commit 0320e252 on 2021-08-11 16:08:52 UTC
3752238fd8 Patr*0001 #include "EXF_OPTIONS.h"
                0002 
423768d890 Jean*0003       SUBROUTINE EXF_RADIATION( myTime, myIter, myThid )
3752238fd8 Patr*0004 
86169a449d Jean*0005 C     ==================================================================
                0006 C     SUBROUTINE exf_radiation
                0007 C     ==================================================================
                0008 C
                0009 C     o Set radiative fluxes at the surface.
                0010 C
                0011 C     ==================================================================
                0012 C     SUBROUTINE exf_radiation
                0013 C     ==================================================================
3752238fd8 Patr*0014 
86169a449d Jean*0015       IMPLICIT NONE
3752238fd8 Patr*0016 
86169a449d Jean*0017 C     == global variables ==
3752238fd8 Patr*0018 
                0019 #include "EEPARAMS.h"
                0020 #include "SIZE.h"
                0021 #include "PARAMS.h"
                0022 #include "DYNVARS.h"
                0023 #include "GRID.h"
                0024 
082e18c36c Jean*0025 #include "EXF_PARAM.h"
                0026 #include "EXF_FIELDS.h"
                0027 #include "EXF_CONSTANTS.h"
3752238fd8 Patr*0028 
86169a449d Jean*0029 C     == routine arguments ==
3752238fd8 Patr*0030 
86169a449d Jean*0031       _RL     myTime
                0032       INTEGER myIter
                0033       INTEGER myThid
3752238fd8 Patr*0034 
86169a449d Jean*0035 #ifdef ALLOW_DOWNWARD_RADIATION
                0036 C     == local variables ==
3752238fd8 Patr*0037 
86169a449d Jean*0038       INTEGER bi,bj
                0039       INTEGER i,j
                0040 #ifdef ALLOW_ATM_TEMP
c2c9eed210 Jean*0041       INTEGER ks, kl
86169a449d Jean*0042       _RL Tsf, SSTtmp, TsfSq
                0043 #endif
3752238fd8 Patr*0044 
86169a449d Jean*0045 C     == end of interface ==
3752238fd8 Patr*0046 
86169a449d Jean*0047 C--   Use atmospheric state to compute surface fluxes.
3752238fd8 Patr*0048 
86169a449d Jean*0049 C--   Compute net from downward and downward from net longwave and
                0050 C     shortwave radiation, IF needed.
                0051 C     lwflux = Stefan-Boltzmann constant * emissivity * SST - lwdown
                0052 C     swflux = - ( 1 - albedo ) * swdown
3752238fd8 Patr*0053 
86169a449d Jean*0054 #ifdef ALLOW_ATM_TEMP
c2c9eed210 Jean*0055       ks = 1
                0056       kl = 2
0320e25227 Mart*0057       IF ( usingPCoords ) THEN
                0058        ks = Nr
                0059        kl = Nr-1
                0060       ENDIF
3752238fd8 Patr*0061 
86169a449d Jean*0062       IF ( lwfluxfile .EQ. ' ' .AND. lwdownfile .NE. ' ' ) THEN
                0063 C     Loop over tiles.
                0064        DO bj = myByLo(myThid),myByHi(myThid)
                0065         DO bi = myBxLo(myThid),myBxHi(myThid)
                0066 
c2c9eed210 Jean*0067          IF ( Nr.GE.2 .AND. sstExtrapol.GT.0. _d 0 ) THEN
86169a449d Jean*0068           DO j = 1,sNy
                0069            DO i = 1,sNx
c2c9eed210 Jean*0070             Tsf = theta(i,j,ks,bi,bj) + cen2kel
86169a449d Jean*0071             SSTtmp = sstExtrapol
c2c9eed210 Jean*0072      &             *( theta(i,j,ks,bi,bj)-theta(i,j,kl,bi,bj) )
                0073      &             *  maskC(i,j,kl,bi,bj)
86169a449d Jean*0074             Tsf = Tsf + MAX( SSTtmp, 0. _d 0 )
                0075             TsfSq = Tsf*Tsf
                0076             lwflux(i,j,bi,bj) =
                0077      &          ocean_emissivity*stefanBoltzmann*TsfSq*TsfSq
ae468ace59 Mart*0078      &          - lwdown(i,j,bi,bj)
45e2e117da Mart*0079 #ifdef EXF_LWDOWN_WITH_EMISSIVITY
                0080      &           *ocean_emissivity
                0081 C     the lw exitance (= out-going long wave radiation) is
                0082 C     emissivity*stefanBoltzmann*T^4 + rho*lwdown, where the
                0083 C     reflectivity rho = 1-emissivity for conservation reasons:
                0084 C     the sum of emissivity, reflectivity, and transmissivity must be
                0085 C     one, and transmissivity is zero in our case (long wave radiation
                0086 C     does not penetrate the ocean surface)
                0087 #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
86169a449d Jean*0088            ENDDO
                0089           ENDDO
                0090          ELSE
                0091           DO j = 1,sNy
                0092            DO i = 1,sNx
                0093             lwflux(i,j,bi,bj) =
ae468ace59 Mart*0094      &          ocean_emissivity*stefanBoltzmann*
c2c9eed210 Jean*0095      &          ((theta(i,j,ks,bi,bj)+cen2kel)**4)
86169a449d Jean*0096      &          - lwdown(i,j,bi,bj)
45e2e117da Mart*0097 #ifdef EXF_LWDOWN_WITH_EMISSIVITY
                0098      &           *ocean_emissivity
                0099 C     the lw exitance (= out-going long wave radiation) is
                0100 C     emissivity*stefanBoltzmann*T^4 + rho*lwdown, where the
                0101 C     reflectivity rho = 1-emissivity for conservation reasons:
                0102 C     the sum of emissivity, reflectivity, and transmissivity must be
                0103 C     one, and transmissivity is zero in our case (long wave radiation
                0104 C     does not penetrate the ocean surface)
                0105 #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
86169a449d Jean*0106            ENDDO
                0107           ENDDO
                0108          ENDIF
                0109 
                0110 C--   end bi,bj loops
                0111         ENDDO
                0112        ENDDO
                0113       ENDIF
                0114 
                0115 C-jmc: commented out: no need to compute Downward-LW (not used) from Net-LW
                0116 c     IF ( lwfluxfile .NE. ' ' .AND. lwdownfile .EQ. ' ' ) THEN
                0117 C     Loop over tiles.
                0118 c      DO bj = myByLo(myThid),myByHi(myThid)
                0119 c       DO bi = myBxLo(myThid),myBxHi(myThid)
                0120 c        DO j = 1,sNy
                0121 c         DO i = 1,sNx
                0122 c          lwdown(i,j,bi,bj) =
                0123 c    &          ocean_emissivity*stefanBoltzmann*
c2c9eed210 Jean*0124 c    &          ((theta(i,j,ks,bi,bj)+cen2kel)**4)
86169a449d Jean*0125 c    &          - lwflux(i,j,bi,bj)
                0126 c         ENDDO
                0127 c        ENDDO
                0128 c       ENDDO
                0129 c      ENDDO
                0130 c     ENDIF
                0131 #endif /* ALLOW_ATM_TEMP */
3752238fd8 Patr*0132 
ae468ace59 Mart*0133 #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
86169a449d Jean*0134       IF ( swfluxfile .EQ. ' ' .AND. swdownfile .NE. ' ' ) THEN
94390f4f16 Gael*0135 #ifdef ALLOW_ZENITHANGLE
d106b5e2d8 Gael*0136       IF ( useExfZenAlbedo .OR. useExfZenIncoming ) THEN
94390f4f16 Gael*0137        CALL EXF_ZENITHANGLE(myTime, myIter, myThid)
4e4ad91a39 Jean*0138 #ifdef ALLOW_AUTODIFF
a208a26389 Gael*0139       ELSE
                0140        DO bj = myByLo(myThid),myByHi(myThid)
                0141         DO bi = myBxLo(myThid),myBxHi(myThid)
                0142          DO j = 1,sNy
                0143           DO i = 1,sNx
                0144            zen_albedo (i,j,bi,bj) = 0. _d 0
                0145            zen_fsol_diurnal (i,j,bi,bj) = 0. _d 0
                0146            zen_fsol_daily (i,j,bi,bj) = 0. _d 0
                0147           ENDDO
                0148          ENDDO
                0149         ENDDO
                0150        ENDDO
                0151 #endif
94390f4f16 Gael*0152       ENDIF
423768d890 Jean*0153 #endif /* ALLOW_ZENITHANGLE */
86169a449d Jean*0154        DO bj = myByLo(myThid),myByHi(myThid)
                0155         DO bi = myBxLo(myThid),myBxHi(myThid)
94390f4f16 Gael*0156 #ifdef ALLOW_ZENITHANGLE
423768d890 Jean*0157          IF ( useExfZenAlbedo ) THEN
                0158           DO j = 1,sNy
                0159            DO i = 1,sNx
                0160             swflux(i,j,bi,bj) = - swdown(i,j,bi,bj)
                0161      &                        * (1.0-zen_albedo(i,j,bi,bj))
                0162            ENDDO
86169a449d Jean*0163           ENDDO
423768d890 Jean*0164          ELSE
                0165 #endif /* ALLOW_ZENITHANGLE */
                0166           DO j = 1,sNy
                0167            DO i = 1,sNx
                0168             swflux(i,j,bi,bj) = - swdown(i,j,bi,bj)
                0169      &                        * (1.0-exf_albedo)
                0170            ENDDO
                0171           ENDDO
                0172 #ifdef ALLOW_ZENITHANGLE
                0173          ENDIF
                0174 #endif
86169a449d Jean*0175         ENDDO
                0176        ENDDO
                0177       ENDIF
                0178 C-jmc: commented out: no need to compute Downward-SW (not used) from Net-SW
                0179 c     IF ( swfluxfile .NE. ' ' .AND. swdownfile .EQ. ' ' ) THEN
                0180 c      DO bj = myByLo(myThid),myByHi(myThid)
                0181 c       DO bi = myBxLo(myThid),myBxHi(myThid)
                0182 c        DO j = 1,sNy
                0183 c         DO i = 1,sNx
                0184 c          swdown(i,j,bi,bj) = -swflux(i,j,bi,bj) / (1.0-exf_albedo)
                0185 c         ENDDO
                0186 c        ENDDO
                0187 c       ENDDO
                0188 c      ENDDO
                0189 c     ENDIF
423768d890 Jean*0190 #endif /* ALLOW_ATM_TEMP or SHORTWAVE_HEATING */
ae468ace59 Mart*0191 
                0192 #endif /* ALLOW_DOWNWARD_RADIATION */
3752238fd8 Patr*0193 
86169a449d Jean*0194       RETURN
                0195       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!