/[MITgcm]/MITgcm/model/src/swfrac.F
ViewVC logotype

Contents of /MITgcm/model/src/swfrac.F

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


Revision 1.14 - (show annotations) (download)
Tue Sep 4 16:49:44 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59g, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint61f, checkpoint61n, checkpoint59j, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61t, checkpoint61r, checkpoint61s, checkpoint61p
Changes since 1.13: +6 -6 lines
reduce number of "warning: unused variable"

1 C $Header: /u/gcmpack/MITgcm/model/src/swfrac.F,v 1.13 2007/05/03 21:39:59 jmc Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: SWFRAC
9 C !INTERFACE:
10 SUBROUTINE SWFRAC(
11 I imax, fact,
12 U swdk,
13 I myTime, myIter, myThid )
14 C !DESCRIPTION: \bv
15 C *==========================================================*
16 C | SUBROUTINE SWFRAC
17 C | o Compute solar short-wave flux penetration.
18 C *==========================================================*
19 C | Compute fraction of solar short-wave flux penetrating to
20 C | specified depth, swdk, due to exponential decay in
21 C | Jerlov water type jwtype.
22 C | Reference : Two band solar absorption model of Paulson
23 C | and Simpson (1977, JPO, 7, 952-956)
24 C | Notes
25 C | =====
26 C | Parameter jwtype is hardcoded to 3 for time being.
27 C | Below 200m the solar penetration gets set to zero,
28 C | otherwise the limit for the exponent (+/- 5678) needs to
29 C | be taken care of.
30 C | Written by : Jan Morzel
31 C | Date : July 12, 1995
32 C *==========================================================*
33 C \ev
34
35 C !USES:
36 IMPLICIT NONE
37
38 C !INPUT/OUTPUT PARAMETERS:
39 C === Routine arguments ===
40 C input arguments
41 C imax :: number of vertical grid points
42 C fact :: scale factor to apply to depth array
43 C myTime :: Current time in simulation
44 C myIter :: Current iteration number in simulation
45 C myThid :: My Thread Id. number
46 INTEGER imax
47 _RL fact
48 _RL myTime
49 INTEGER myIter
50 INTEGER myThid
51 C input/output arguments
52 C swdk :: on input: vertical depth for desired sw fraction
53 C (fact*swdk) is negative distance (m) from surface
54 C swdk :: on output: short wave (radiation) fractional decay
55 _RL swdk(imax)
56
57 C !LOCAL VARIABLES:
58 C === Local variables ===
59 C max number of different water types
60 INTEGER nwtype , jwtype
61 PARAMETER(nwtype=5)
62 _RL facz
63 _RL rfac(nwtype),a1(nwtype),a2(nwtype)
64 INTEGER i
65 #ifdef ALLOW_CAL
66 c _RL fac
67 c LOGICAL first, changed
68 c INTEGER count0, count1
69 c INTEGER jerl(12)
70 c DATA jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
71 #endif /* ALLOW_CAL */
72 C
73 C Jerlov water type : I IA IB II III
74 C jwtype 1 2 3 4 5
75 C
76 DATA rfac / 0.58 , 0.62 , 0.67 , 0.77 , 0.78 /
77 DATA a1 / 0.35 , 0.6 , 1.0 , 1.5 , 1.4 /
78 DATA a2 / 23.0 , 20.0 , 17.0 , 14.0 , 7.9 /
79 CEOP
80
81 #ifdef ALLOW_CAL
82 ceh3 this should have an IF ( useCALENDAR ) THEN
83 CML(
84 C myIter = 0 makes cal_getMonthsRec always return count0=12
85 C so that jerl(count0) = 2.
86 C The following lines are meant to be an example of how to
87 C include time dependent water types. However, it would probably
88 C make more sense to first think about a regionally varying
89 C water type before implementing a time dependence.
90 CML CALL cal_GetMonthsRec(
91 CML O fac, first, changed, count0, count1,
92 CML I myTime, myIter, myThid )
93 CML jwtype=jerl(count0)
94 CML)
95 jwtype=2
96 #else /* ALLOW_CAL undef */
97 jwtype=2
98 #endif /* ALLOW_CAL */
99
100 DO i = 1,imax
101 facz = fact*swdk(i)
102 IF (facz .LT. (-200.)) THEN
103 swdk(i) = 0.
104 ELSE
105 swdk(i) = rfac(jwtype) * exp(facz/a1(jwtype))
106 $ + (1.-rfac(jwtype)) * exp(facz/a2(jwtype))
107 ENDIF
108 ENDDO
109
110 RETURN
111 END

  ViewVC Help
Powered by ViewVC 1.1.22