/[MITgcm]/MITgcm/pkg/exf/exf_radiation.F
ViewVC logotype

Annotation of /MITgcm/pkg/exf/exf_radiation.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.12 - (hide annotations) (download)
Fri Jan 27 17:22:55 2017 UTC (7 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.11: +21 -18 lines 
simplify pkg/exf main options:
 1) move small piece of code (case ALLOW_ATM_TEMP undef) out of
    exf_bulkformulae.F into exf_winf.F so that exf_bulkformulae.F is
    compiled only when both ALLOW_ATM_TEMP & ALLOW_BULKFORMULAE are defined;
 2) make call to EXF_RADIATION and to EXF_WIND independent of CPP option
    ALLOW_BULKFORMULAE which now only applies to S/R EXF_BULKFORMULAE
 3) improve options documentation in EXF_OPTIONS.h
1 jmc 1.12 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_radiation.F,v 1.11 2014/10/20 03:13:32 gforget Exp $
2 jmc 1.3 C $Name: $
3 heimbach 1.1
4     #include "EXF_OPTIONS.h"
5 gforget 1.11 #ifdef ALLOW_AUTODIFF
6     # include "AUTODIFF_OPTIONS.h"
7     #endif
8 heimbach 1.1
9 jmc 1.12 SUBROUTINE EXF_RADIATION( myTime, myIter, myThid )
10 heimbach 1.1
11 jmc 1.5 C ==================================================================
12     C SUBROUTINE exf_radiation
13     C ==================================================================
14     C
15     C o Set radiative fluxes at the surface.
16     C
17     C ==================================================================
18     C SUBROUTINE exf_radiation
19     C ==================================================================
20 heimbach 1.1
21 jmc 1.5 IMPLICIT NONE
22 heimbach 1.1
23 jmc 1.5 C == global variables ==
24 heimbach 1.1
25     #include "EEPARAMS.h"
26     #include "SIZE.h"
27     #include "PARAMS.h"
28     #include "DYNVARS.h"
29     #include "GRID.h"
30    
31 jmc 1.3 #include "EXF_PARAM.h"
32     #include "EXF_FIELDS.h"
33     #include "EXF_CONSTANTS.h"
34 gforget 1.9 #ifdef ALLOW_AUTODIFF_TAMC
35     # include "tamc.h"
36 jmc 1.10 #endif
37 heimbach 1.1
38 jmc 1.5 C == routine arguments ==
39 heimbach 1.1
40 jmc 1.5 _RL myTime
41     INTEGER myIter
42     INTEGER myThid
43 heimbach 1.1
44 jmc 1.5 #ifdef ALLOW_DOWNWARD_RADIATION
45     C == local variables ==
46 heimbach 1.1
47 jmc 1.5 INTEGER bi,bj
48     INTEGER i,j
49     #ifdef ALLOW_ATM_TEMP
50 jmc 1.10 INTEGER ks, kl
51 jmc 1.5 _RL Tsf, SSTtmp, TsfSq
52     #endif
53 heimbach 1.1
54 jmc 1.5 C == end of interface ==
55 heimbach 1.1
56 jmc 1.5 C-- Use atmospheric state to compute surface fluxes.
57 heimbach 1.1
58 jmc 1.5 C-- Compute net from downward and downward from net longwave and
59     C shortwave radiation, IF needed.
60     C lwflux = Stefan-Boltzmann constant * emissivity * SST - lwdown
61     C swflux = - ( 1 - albedo ) * swdown
62 heimbach 1.1
63 jmc 1.5 #ifdef ALLOW_ATM_TEMP
64 jmc 1.10 ks = 1
65     kl = 2
66 heimbach 1.1
67 jmc 1.5 IF ( lwfluxfile .EQ. ' ' .AND. lwdownfile .NE. ' ' ) THEN
68     C Loop over tiles.
69     DO bj = myByLo(myThid),myByHi(myThid)
70     DO bi = myBxLo(myThid),myBxHi(myThid)
71    
72 jmc 1.10 IF ( Nr.GE.2 .AND. sstExtrapol.GT.0. _d 0 ) THEN
73 jmc 1.5 DO j = 1,sNy
74     DO i = 1,sNx
75 jmc 1.10 Tsf = theta(i,j,ks,bi,bj) + cen2kel
76 jmc 1.5 SSTtmp = sstExtrapol
77 jmc 1.10 & *( theta(i,j,ks,bi,bj)-theta(i,j,kl,bi,bj) )
78     & * maskC(i,j,kl,bi,bj)
79 jmc 1.5 Tsf = Tsf + MAX( SSTtmp, 0. _d 0 )
80     TsfSq = Tsf*Tsf
81     lwflux(i,j,bi,bj) =
82     & ocean_emissivity*stefanBoltzmann*TsfSq*TsfSq
83     & - lwdown(i,j,bi,bj)
84 mlosch 1.8 #ifdef EXF_LWDOWN_WITH_EMISSIVITY
85     & *ocean_emissivity
86     C the lw exitance (= out-going long wave radiation) is
87     C emissivity*stefanBoltzmann*T^4 + rho*lwdown, where the
88     C reflectivity rho = 1-emissivity for conservation reasons:
89     C the sum of emissivity, reflectivity, and transmissivity must be
90     C one, and transmissivity is zero in our case (long wave radiation
91     C does not penetrate the ocean surface)
92     #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
93 jmc 1.5 ENDDO
94     ENDDO
95     ELSE
96     DO j = 1,sNy
97     DO i = 1,sNx
98     lwflux(i,j,bi,bj) =
99 mlosch 1.4 & ocean_emissivity*stefanBoltzmann*
100 jmc 1.10 & ((theta(i,j,ks,bi,bj)+cen2kel)**4)
101 mlosch 1.4 & - lwdown(i,j,bi,bj)
102 mlosch 1.8 #ifdef EXF_LWDOWN_WITH_EMISSIVITY
103     & *ocean_emissivity
104     C the lw exitance (= out-going long wave radiation) is
105     C emissivity*stefanBoltzmann*T^4 + rho*lwdown, where the
106     C reflectivity rho = 1-emissivity for conservation reasons:
107     C the sum of emissivity, reflectivity, and transmissivity must be
108     C one, and transmissivity is zero in our case (long wave radiation
109     C does not penetrate the ocean surface)
110     #endif /* EXF_LWDOWN_WITH_EMISSIVITY */
111 jmc 1.5 ENDDO
112     ENDDO
113     ENDIF
114    
115     C-- end bi,bj loops
116     ENDDO
117     ENDDO
118     ENDIF
119    
120     C-jmc: commented out: no need to compute Downward-LW (not used) from Net-LW
121     c IF ( lwfluxfile .NE. ' ' .AND. lwdownfile .EQ. ' ' ) THEN
122     C Loop over tiles.
123     c DO bj = myByLo(myThid),myByHi(myThid)
124     c DO bi = myBxLo(myThid),myBxHi(myThid)
125     c DO j = 1,sNy
126     c DO i = 1,sNx
127     c lwdown(i,j,bi,bj) =
128     c & ocean_emissivity*stefanBoltzmann*
129 jmc 1.10 c & ((theta(i,j,ks,bi,bj)+cen2kel)**4)
130 jmc 1.5 c & - lwflux(i,j,bi,bj)
131     c ENDDO
132     c ENDDO
133     c ENDDO
134     c ENDDO
135     c ENDIF
136     #endif /* ALLOW_ATM_TEMP */
137 heimbach 1.1
138     #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
139 jmc 1.5 IF ( swfluxfile .EQ. ' ' .AND. swdownfile .NE. ' ' ) THEN
140 gforget 1.6 #ifdef ALLOW_ZENITHANGLE
141 gforget 1.7 IF ( useExfZenAlbedo .OR. useExfZenIncoming ) THEN
142 gforget 1.6 CALL EXF_ZENITHANGLE(myTime, myIter, myThid)
143 gforget 1.9 #ifdef ALLOW_AUTODIFF_TAMC
144     ELSE
145     DO bj = myByLo(myThid),myByHi(myThid)
146     DO bi = myBxLo(myThid),myBxHi(myThid)
147     DO j = 1,sNy
148     DO i = 1,sNx
149     zen_albedo (i,j,bi,bj) = 0. _d 0
150     zen_fsol_diurnal (i,j,bi,bj) = 0. _d 0
151     zen_fsol_daily (i,j,bi,bj) = 0. _d 0
152     ENDDO
153     ENDDO
154     ENDDO
155     ENDDO
156     #endif
157 gforget 1.6 ENDIF
158 jmc 1.12 #endif /* ALLOW_ZENITHANGLE */
159 jmc 1.5 DO bj = myByLo(myThid),myByHi(myThid)
160     DO bi = myBxLo(myThid),myBxHi(myThid)
161 gforget 1.6 #ifdef ALLOW_ZENITHANGLE
162 jmc 1.12 IF ( useExfZenAlbedo ) THEN
163     DO j = 1,sNy
164     DO i = 1,sNx
165     swflux(i,j,bi,bj) = - swdown(i,j,bi,bj)
166     & * (1.0-zen_albedo(i,j,bi,bj))
167     ENDDO
168     ENDDO
169     ELSE
170     #endif /* ALLOW_ZENITHANGLE */
171     DO j = 1,sNy
172     DO i = 1,sNx
173     swflux(i,j,bi,bj) = - swdown(i,j,bi,bj)
174     & * (1.0-exf_albedo)
175     ENDDO
176     ENDDO
177     #ifdef ALLOW_ZENITHANGLE
178     ENDIF
179 gforget 1.6 #endif
180 jmc 1.5 ENDDO
181     ENDDO
182     ENDIF
183     C-jmc: commented out: no need to compute Downward-SW (not used) from Net-SW
184     c IF ( swfluxfile .NE. ' ' .AND. swdownfile .EQ. ' ' ) THEN
185     c DO bj = myByLo(myThid),myByHi(myThid)
186     c DO bi = myBxLo(myThid),myBxHi(myThid)
187     c DO j = 1,sNy
188     c DO i = 1,sNx
189     c swdown(i,j,bi,bj) = -swflux(i,j,bi,bj) / (1.0-exf_albedo)
190     c ENDDO
191     c ENDDO
192     c ENDDO
193     c ENDDO
194     c ENDIF
195 jmc 1.12 #endif /* ALLOW_ATM_TEMP or SHORTWAVE_HEATING */
196 heimbach 1.1
197     #endif /* ALLOW_DOWNWARD_RADIATION */
198    
199 jmc 1.5 RETURN
200     END
  ViewVC Help
Powered by ViewVC 1.1.22