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

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

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

Revision 1.12 - (show annotations) (download)
Fri Jan 27 17:22:55 2017 UTC (7 years, 3 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 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_radiation.F,v 1.11 2014/10/20 03:13:32 gforget Exp $
2 C $Name: $
3
4 #include "EXF_OPTIONS.h"
5 #ifdef ALLOW_AUTODIFF
6 # include "AUTODIFF_OPTIONS.h"
7 #endif
8
9 SUBROUTINE EXF_RADIATION( myTime, myIter, myThid )
10
11 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
21 IMPLICIT NONE
22
23 C == global variables ==
24
25 #include "EEPARAMS.h"
26 #include "SIZE.h"
27 #include "PARAMS.h"
28 #include "DYNVARS.h"
29 #include "GRID.h"
30
31 #include "EXF_PARAM.h"
32 #include "EXF_FIELDS.h"
33 #include "EXF_CONSTANTS.h"
34 #ifdef ALLOW_AUTODIFF_TAMC
35 # include "tamc.h"
36 #endif
37
38 C == routine arguments ==
39
40 _RL myTime
41 INTEGER myIter
42 INTEGER myThid
43
44 #ifdef ALLOW_DOWNWARD_RADIATION
45 C == local variables ==
46
47 INTEGER bi,bj
48 INTEGER i,j
49 #ifdef ALLOW_ATM_TEMP
50 INTEGER ks, kl
51 _RL Tsf, SSTtmp, TsfSq
52 #endif
53
54 C == end of interface ==
55
56 C-- Use atmospheric state to compute surface fluxes.
57
58 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
63 #ifdef ALLOW_ATM_TEMP
64 ks = 1
65 kl = 2
66
67 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 IF ( Nr.GE.2 .AND. sstExtrapol.GT.0. _d 0 ) THEN
73 DO j = 1,sNy
74 DO i = 1,sNx
75 Tsf = theta(i,j,ks,bi,bj) + cen2kel
76 SSTtmp = sstExtrapol
77 & *( theta(i,j,ks,bi,bj)-theta(i,j,kl,bi,bj) )
78 & * maskC(i,j,kl,bi,bj)
79 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 #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 ENDDO
94 ENDDO
95 ELSE
96 DO j = 1,sNy
97 DO i = 1,sNx
98 lwflux(i,j,bi,bj) =
99 & ocean_emissivity*stefanBoltzmann*
100 & ((theta(i,j,ks,bi,bj)+cen2kel)**4)
101 & - lwdown(i,j,bi,bj)
102 #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 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 c & ((theta(i,j,ks,bi,bj)+cen2kel)**4)
130 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
138 #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
139 IF ( swfluxfile .EQ. ' ' .AND. swdownfile .NE. ' ' ) THEN
140 #ifdef ALLOW_ZENITHANGLE
141 IF ( useExfZenAlbedo .OR. useExfZenIncoming ) THEN
142 CALL EXF_ZENITHANGLE(myTime, myIter, myThid)
143 #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 ENDIF
158 #endif /* ALLOW_ZENITHANGLE */
159 DO bj = myByLo(myThid),myByHi(myThid)
160 DO bi = myBxLo(myThid),myBxHi(myThid)
161 #ifdef ALLOW_ZENITHANGLE
162 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 #endif
180 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 #endif /* ALLOW_ATM_TEMP or SHORTWAVE_HEATING */
196
197 #endif /* ALLOW_DOWNWARD_RADIATION */
198
199 RETURN
200 END
  ViewVC Help
Powered by ViewVC 1.1.22