/[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.12 - (hide annotations) (download)
Sun Apr 18 20:36:56 2004 UTC (20 years, 1 month ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint54d_post, checkpoint54e_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint59, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint54f_post, checkpoint58y_post, checkpoint58t_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint57t_post, checkpoint55c_post, checkpoint57v_post, checkpoint57f_post, checkpoint53d_post, checkpoint57a_post, checkpoint57h_pre, checkpoint54b_post, checkpoint58w_post, checkpoint57h_post, checkpoint52m_post, checkpoint57y_pre, checkpoint55g_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint55d_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint58n_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint59a, checkpoint55f_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint58v_post, checkpoint56a_post, checkpoint58l_post, checkpoint53f_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint58g_post, checkpoint58x_post, checkpoint52n_post, checkpoint53b_pre, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint57k_post, checkpoint53b_post, checkpoint57w_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint53d_pre, checkpoint58s_post, checkpoint55e_post, checkpoint54c_post
Changes since 1.11: +15 -6 lines 
o commented out call to cal_GetMonthsRec in swfrac.F and added some comments;
  this does not change any of the results, because myIter=0 in swfrac always
  lead to jwtype=2 (the default anyway), but the call makes little sense
  as a default
1 mlosch 1.12 C $Header: /u/gcmpack/MITgcm/model/src/swfrac.F,v 1.11 2003/11/06 22:01:43 heimbach 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 heimbach 1.6 I imax, fact,
12     I mytime, mythid,
13     U swdk )
14 cnh 1.9 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 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     C myTime :: current time in simulation
44     C myThid :: thread number for this instance of the routine.
45 adcroft 1.5 INTEGER imax
46 heimbach 1.6 _RL fact
47     _RL mytime
48     integer mythid
49     C input/output arguments
50 cnh 1.9 C swdk :: on input: vertical depth for desired sw fraction
51     C (fact*swdk) is negative distance (m) from surface
52     C swdk :: on output: short wave (radiation) fractional decay
53 heimbach 1.6 _RL swdk(imax)
54 adcroft 1.5
55 cnh 1.9 C !LOCAL VARIABLES:
56 adcroft 1.5 C === Local variables ===
57     C max number of different water types
58 heimbach 1.6 integer nwtype , jwtype
59     PARAMETER(nwtype=5)
60     _RL facz
61 adcroft 1.5 _RL rfac(nwtype),a1(nwtype),a2(nwtype)
62 adcroft 1.1 INTEGER i
63 heimbach 1.11 #ifdef ALLOW_CAL
64 heimbach 1.6 _RL fac
65     logical first, changed
66     integer count0, count1
67     integer myiter
68     integer jerl(12)
69     data jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
70 heimbach 1.11 #endif /* ALLOW_CAL */
71 adcroft 1.1 C
72     C Jerlov water type : I IA IB II III
73     C jwtype 1 2 3 4 5
74     C
75     DATA rfac / 0.58 , 0.62 , 0.67 , 0.77 , 0.78 /
76     DATA a1 / 0.35 , 0.6 , 1.0 , 1.5 , 1.4 /
77     DATA a2 / 23.0 , 20.0 , 17.0 , 14.0 , 7.9 /
78 cnh 1.9 CEOP
79    
80 heimbach 1.11 #ifdef ALLOW_CAL
81 edhill 1.10 ceh3 this should have an IF ( useCALENDAR ) THEN
82 mlosch 1.12 CML(
83     C myIter = 0 makes cal_getMonthsRec always return count0=12
84     C so that jerl(count0) = 2.
85     C The following lines are meant to be an example of how to
86     C include time dependent water types. However, it would probably
87     C make more sense to first think about a regionally varying
88     C water type before implementing a time dependence.
89     CML myiter=0
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 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 heimbach 1.6 facz = fact*swdk(i)
102 adcroft 1.1 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 adcroft 1.4
110 adcroft 1.1 RETURN
111     END
  ViewVC Help
Powered by ViewVC 1.1.22