/[MITgcm]/MITgcm_contrib/darwin2/pkg/monod/monod_radtrans.F
ViewVC logotype

Annotation of /MITgcm_contrib/darwin2/pkg/monod/monod_radtrans.F

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


Revision 1.1 - (hide annotations) (download)
Wed Apr 13 18:56:25 2011 UTC (14 years, 3 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt65w_20160512, ctrb_darwin2_ckpt65j_20150225, ctrb_darwin2_ckpt63l_20120405, ctrb_darwin2_ckpt66g_20170424, ctrb_darwin2_ckpt64h_20130528, ctrb_darwin2_ckpt66k_20171025, ctrb_darwin2_ckpt66n_20180118, ctrb_darwin2_ckpt62v_20110413, ctrb_darwin2_ckpt65v_20160409, ctrb_darwin2_ckpt65s_20160114, ctrb_darwin2_ckpt65_20140718, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt66d_20170214, ctrb_darwin2_ckpt64r_20131210, ctrb_darwin2_ckpt65m_20150615, ctrb_darwin2_ckpt65q_20151118, ctrb_darwin2_ckpt65o_20150914, ctrb_darwin2_ckpt64f_20130405, ctrb_darwin2_ckpt63f_20111201, ctrb_darwin2_ckpt64a_20121116, ctrb_darwin2_ckpt65p_20151023, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt65e_20140929, ctrb_darwin2_ckpt64o_20131024, ctrb_darwin2_ckpt64v_20140411, ctrb_darwin2_ckpt64z_20140711, ctrb_darwin2_ckpt65l_20150504, ctrb_darwin2_ckpt65z_20160929, ctrb_darwin2_ckpt65n_20150729, ctrb_darwin2_ckpt62y_20110526, ctrb_darwin2_ckpt64y_20140622, ctrb_darwin2_ckpt65d_20140915, ctrb_darwin2_ckpt64t_20140202, ctrb_darwin2_ckpt66h_20170602, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt62x_20110513, ctrb_darwin2_ckpt64s_20140105, ctrb_darwin2_ckpt62w_20110426, ctrb_darwin2_ckpt64x_20140524, ctrb_darwin2_ckpt63o_20120629, ctrb_darwin2_ckpt64e_20130305, ctrb_darwin2_ckpt65x_20160612, ctrb_darwin2_ckpt66f_20170407, ctrb_darwin2_ckpt63c_20111011, ctrb_darwin2_ckpt63i_20120124, ctrb_darwin2_ckpt65g_20141120, ctrb_darwin2_ckpt63m_20120506, ctrb_darwin2_ckpt63s_20120908, ctrb_darwin2_ckpt65k_20150402, ctrb_darwin2_ckpt63e_20111107, ctrb_darwin2_ckpt64w_20140502, ctrb_darwin2_ckpt63b_20110830, ctrb_darwin2_ckpt63j_20120217, ctrb_darwin2_ckpt66a_20161020, ctrb_darwin2_ckpt63r_20120817, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt63g_20111220, ctrb_darwin2_ckpt65f_20141014, ctrb_darwin2_ckpt64c_20130120, ctrb_darwin2_ckpt63a_20110804, ctrb_darwin2_ckpt66b_20161219, ctrb_darwin2_ckpt64u_20140308, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt65i_20150123, ctrb_darwin2_ckpt66j_20170815, ctrb_darwin2_ckpt65y_20160801, ctrb_darwin2_ckpt63h_20111230, ctrb_darwin2_ckpt63p_20120707, ctrb_darwin2_ckpt66c_20170121, ctrb_darwin2_ckpt65a_20140728, ctrb_darwin2_ckpt65b_20140812, ctrb_darwin2_ckpt65t_20160221, ctrb_darwin2_ckpt64p_20131118, ctrb_darwin2_ckpt63d_20111107, ctrb_darwin2_ckpt63q_20120731, ctrb_darwin2_ckpt63_20110728, ctrb_darwin2_ckpt64b_20121224, ctrb_darwin2_ckpt64d_20130219, ctrb_darwin2_ckpt66o_20180209, ctrb_darwin2_ckpt66e_20170314, ctrb_darwin2_ckpt64_20121012, ctrb_darwin2_ckpt64q_20131118, ctrb_darwin2_baseline, ctrb_darwin2_ckpt64p_20131024, ctrb_darwin2_ckpt65u_20160315, ctrb_darwin2_ckpt65r_20151221, ctrb_darwin2_ckpt66i_20170718, ctrb_darwin2_ckpt63n_20120604, ctrb_darwin2_ckpt63k_20120317, ctrb_darwin2_ckpt65c_20140830, ctrb_darwin2_ckpt62z_20110622, ctrb_darwin2_ckpt66l_20171025, ctrb_darwin2_ckpt65h_20141217, ctrb_darwin2_ckpt66m_20171213, HEAD
darwin2 initial checkin

1 jahn 1.1 C $Header$
2     C $Name$
3    
4     #include "DARWIN_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: MONOD_RADTRANS
8    
9     C !INTERFACE: ==========================================================
10     subroutine MONOD_RADTRANS(
11     I H,rmud,Ed,Es,a_k,bt_k,bb_k,
12     O Edz,Esz,Euz,Eutop,
13     O tirrq,tirrwq,
14     I myThid)
15    
16     C !DESCRIPTION:
17     c MODIFIED VERSION OF WG's edeu.F
18     c
19     c
20     c Model of irradiance in the water column. Accounts for three
21     c irradiance streams:
22     c
23     c Edz = direct downwelling irradiance in W/m2 per waveband
24     c Esz = diffuse downwelling irradiance in W/m2 per waveband
25     c Euz = diffuse upwelling irradiance in W/m2 per waveband
26     c
27     c Propagation is done in energy units, tests are done in quanta,
28     c final is quanta for phytoplankton growth.
29     c
30     C !USES: ===============================================================
31     IMPLICIT NONE
32     #include "SIZE.h" /* Nr */
33     C#include "EEPARAMS.h"
34     #include "MONOD_SIZE.h"
35     #include "SPECTRAL_SIZE.h" /* tlam */
36     #include "SPECTRAL.h" /* WtouEin */
37     #include "WAVEBANDS_PARAMS.h" /* darwin_PAR_ilamLo/Hi
38     darwin_radmodThresh
39     darwin_Dmax darwin_rmus darwin_rmuu */
40    
41     C !INPUT PARAMETERS: ===================================================
42     C H :: layer thickness (should include hFacC!)
43     C rmud :: inv.cosine of direct (underwater solar) zenith angle
44     C Ed :: direct downwelling irradiance below surface per waveband
45     C Es :: diffuse downwelling irradiance below surface per waveband
46     C a_k :: absorption coefficient per level and waveband (1/m)
47     C bt_k :: total scattering coefficient per level and waveband (1/m)
48     C = forward + back scattering coefficient
49     C bb_k :: backscattering coefficient per level and waveband (1/m)
50     _RL H(Nr)
51     _RL rmud
52     _RL Ed(tlam), Es(tlam)
53     _RL a_k(Nr,tlam), bt_k(Nr,tlam), bb_k(Nr,tlam)
54     INTEGER myThid
55    
56     C !OUTPUT PARAMETERS: ==================================================
57     C Edz :: direct downwelling irradiance at bottom of layer
58     C Esz :: diffuse downwelling irradiance at bottom of layer
59     C Euz :: diffuse upwelling irradiance at bottom of layer
60     C tirrq :: total scalar irradiance at cell center (uEin/m2/s)
61     C tirrwq :: total scalar irradiance at cell center per waveband
62     _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr),Eutop(tlam,Nr)
63     _RL tirrq(Nr)
64     _RL tirrwq(tlam,Nr)
65    
66     #ifdef DAR_RADTRANS
67    
68     C !LOCAL VARIABLES: ====================================================
69     INTEGER k, np, nl
70     C _RL Etop, Ebot
71     _RL Etopq,Ebotq
72     _RL Etopwq(tlam), Ebotwq(tlam)
73     _RL zd,zirrq
74     C _RL zirr
75     C _RL Etopql,Ebotql,Emidql
76     _RL Emidq,Emidwq
77     _RL Edtop(tlam),Estop(tlam)
78     CEOP
79    
80     C Ebot = 0.0
81     do nl = 1,tlam
82     C initialize state variables
83     Edtop(nl) = Ed(nl)
84     Estop(nl) = Es(nl)
85     C Ebot = Ebot + (Ed(nl)+Es(nl))
86     enddo
87     c Convert to quanta: divide by Avos # to get moles quanta; then mult by
88     c 1E6 to get uM or uEin
89     do nl = 1,tlam
90     C don't include upwelling at surface
91     Ebotwq(nl) = (Edtop(nl)+Estop(nl))*WtouEins(nl)
92     enddo
93     C sum PAR range
94     Ebotq = 0.0
95     do nl = darwin_PAR_ilamLo,darwin_PAR_ilamHi
96     Ebotq = Ebotq + Ebotwq(nl)
97     enddo
98     do k = 1,Nr
99     C Etop = Ebot
100     Etopq = Ebotq
101     zd = min(darwin_Dmax,H(k))
102     C zirr = 0.0
103     do nl = 1,tlam
104     Edz(nl,k) = 0.0
105     Esz(nl,k) = 0.0
106     Euz(nl,k) = 0.0
107     Eutop(nl,k) = 0.0
108     if (Edtop(nl) .ge. darwin_radmodThresh .or.
109     & Estop(nl) .ge. darwin_radmodThresh) then
110     c print*,'pre',zd,Edtop(nl),Estop(nl),
111     c & rmud,rmus,rmuu,a,bt,bb,Dmax
112     #ifdef DAR_RADTRANS_DECREASING
113     C truncation to decreasing modes a la Aas
114     call radtrans_radmod_decr(
115     I zd,Edtop(nl),Estop(nl),
116     I rmud,darwin_rmus,darwin_rmuu,
117     I a_k(k,nl),bt_k(k,nl),bb_k(k,nl),darwin_Dmax,
118     O Edz(nl,k),Esz(nl,k),Euz(nl,k),Eutop(nl,k))
119     #else
120     C Watson Gregg's original
121     call radtrans_radmod(
122     I zd,Edtop(nl),Estop(nl),
123     I rmud,darwin_rmus,darwin_rmuu,
124     I a_k(k,nl),bt_k(k,nl),bb_k(k,nl),darwin_Dmax,
125     O Edz(nl,k),Esz(nl,k),Euz(nl,k),Eutop(nl,k))
126     #endif
127     c print*,'radmod',Edz(nl,k),Esz(nl,k),Euz(nl,k)
128     endif
129     C cycle
130     Edtop(nl) = Edz(nl,k)
131     Estop(nl) = Esz(nl,k)
132     C zirr = zirr + (Edz(nl,k)+Esz(nl,k)+Euz(nl,k))
133     C- enddo nl
134     enddo
135     C Ebot = zirr
136     c ANNA SPEC retrieve and pass spectral irrq
137     do nl = 1,tlam
138     Etopwq(nl) = Ebotwq(nl)
139     C add vertical components, ...
140     Ebotwq(nl)=(Edz(nl,k)+Esz(nl,k)+Euz(nl,k))*WtouEins(nl)
141     C ... interpolate ...
142     Emidwq = sqrt(Etopwq(nl)*Ebotwq(nl))
143     C ... and convert using rmus !?
144     tirrwq(nl,k) = Emidwq*darwin_rmus
145     enddo
146     C sum PAR range
147     zirrq = 0.0
148     do nl = darwin_PAR_ilamLo,darwin_PAR_ilamHi
149     zirrq = zirrq + Ebotwq(nl)
150     enddo
151     Ebotq = zirrq
152     C interpolate nonspectral PAR separately !?
153     Emidq = sqrt(Etopq*Ebotq)
154     tirrq(k) = Emidq*darwin_rmus !scalar irradiance
155     C- enddo k
156     enddo
157     c
158     #endif /* DAR_RADTRANS */
159    
160     return
161     end
162    

  ViewVC Help
Powered by ViewVC 1.1.22