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

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

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


Revision 1.15 - (hide annotations) (download)
Tue Aug 4 21:51:53 2009 UTC (14 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint64, checkpoint62, checkpoint63, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint62b, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64t, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint61v, checkpoint61w, checkpoint61u, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.14: +15 -15 lines
add missing "_d 0" in water type coeff.

1 jmc 1.15 C $Header: /u/gcmpack/MITgcm/model/src/swfrac.F,v 1.14 2007/09/04 16:49:44 jmc Exp $
2 cnh 1.9 C $Name: $
3 adcroft 1.1
4 edhill 1.10 #include "PACKAGES_CONFIG.h"
5 adcroft 1.1 #include "CPP_OPTIONS.h"
6    
7 cnh 1.9 CBOP
8     C !ROUTINE: SWFRAC
9     C !INTERFACE:
10 adcroft 1.1 SUBROUTINE SWFRAC(
11 jmc 1.13 I imax, fact,
12     U swdk,
13     I myTime, myIter, myThid )
14 cnh 1.9 C !DESCRIPTION: \bv
15     C *==========================================================*
16 jmc 1.13 C | SUBROUTINE SWFRAC
17 cnh 1.9 C | o Compute solar short-wave flux penetration.
18     C *==========================================================*
19 jmc 1.13 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 cnh 1.9 C *==========================================================*
33     C \ev
34 adcroft 1.1
35 cnh 1.9 C !USES:
36 adcroft 1.1 IMPLICIT NONE
37    
38 cnh 1.9 C !INPUT/OUTPUT PARAMETERS:
39 adcroft 1.1 C === Routine arguments ===
40     C input arguments
41 cnh 1.9 C imax :: number of vertical grid points
42     C fact :: scale factor to apply to depth array
43 jmc 1.13 C myTime :: Current time in simulation
44     C myIter :: Current iteration number in simulation
45     C myThid :: My Thread Id. number
46 adcroft 1.5 INTEGER imax
47 heimbach 1.6 _RL fact
48 jmc 1.13 _RL myTime
49     INTEGER myIter
50     INTEGER myThid
51 heimbach 1.6 C input/output arguments
52 cnh 1.9 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 heimbach 1.6 _RL swdk(imax)
56 adcroft 1.5
57 cnh 1.9 C !LOCAL VARIABLES:
58 adcroft 1.5 C === Local variables ===
59 jmc 1.13 C max number of different water types
60     INTEGER nwtype , jwtype
61 heimbach 1.6 PARAMETER(nwtype=5)
62     _RL facz
63 adcroft 1.5 _RL rfac(nwtype),a1(nwtype),a2(nwtype)
64 adcroft 1.1 INTEGER i
65 heimbach 1.11 #ifdef ALLOW_CAL
66 jmc 1.14 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 heimbach 1.11 #endif /* ALLOW_CAL */
72 cnh 1.9 CEOP
73    
74 jmc 1.15 C Jerlov water type :
75     C I IA IB II III
76     C jwtype : 1 2 3 4 5
77     DATA rfac / 0.58 _d 0, 0.62 _d 0, 0.67 _d 0, 0.77 _d 0, 0.78 _d 0/
78     DATA a1 / 0.35 _d 0, 0.6 _d 0, 1.0 _d 0, 1.5 _d 0, 1.4 _d 0/
79     DATA a2 / 23.0 _d 0, 20.0 _d 0, 17.0 _d 0, 14.0 _d 0, 7.9 _d 0/
80    
81 heimbach 1.11 #ifdef ALLOW_CAL
82 edhill 1.10 ceh3 this should have an IF ( useCALENDAR ) THEN
83 mlosch 1.12 CML(
84 jmc 1.13 C myIter = 0 makes cal_getMonthsRec always return count0=12
85 mlosch 1.12 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 jmc 1.13 CML CALL cal_GetMonthsRec(
91 mlosch 1.12 CML O fac, first, changed, count0, count1,
92 jmc 1.13 CML I myTime, myIter, myThid )
93 mlosch 1.12 CML jwtype=jerl(count0)
94     CML)
95     jwtype=2
96 heimbach 1.11 #else /* ALLOW_CAL undef */
97 heimbach 1.7 jwtype=2
98 heimbach 1.11 #endif /* ALLOW_CAL */
99 heimbach 1.6
100 adcroft 1.1 DO i = 1,imax
101 jmc 1.15 facz = fact*swdk(i)
102     IF ( facz .LT. -200. _d 0 ) THEN
103     swdk(i) = 0. _d 0
104     ELSE
105     swdk(i) = rfac(jwtype) * exp( facz/a1(jwtype) )
106     & + (1. _d 0 - rfac(jwtype)) * exp( facz/a2(jwtype) )
107     ENDIF
108 adcroft 1.1 ENDDO
109 adcroft 1.4
110 adcroft 1.1 RETURN
111     END

  ViewVC Help
Powered by ViewVC 1.1.22