model/src/swfrac.F

C $Header: /u/gcmpack/MITgcm/model/src/swfrac.F,v 1.13 2007/05/03 21:39:59 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: SWFRAC
C     !INTERFACE:
      SUBROUTINE SWFRAC(
     I                  imax, fact,
     U                  swdk,
     I                  myTime, myIter, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE SWFRAC
C     | o Compute solar short-wave flux penetration.
C     *==========================================================*
C     | Compute fraction of solar short-wave flux penetrating to
C     | specified depth, swdk, due to exponential decay in
C     | Jerlov water type jwtype.
C     | Reference : Two band solar absorption model of Paulson
C     |             and Simpson (1977, JPO, 7, 952-956)
C     | Notes
C     | =====
C     | Parameter jwtype is hardcoded to 3 for time being.
C     | Below 200m the solar penetration gets set to zero,
C     | otherwise the limit for the exponent (+/- 5678) needs to
C     | be taken care of.
C     | Written by   : Jan Morzel
C     | Date         : July 12, 1995
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     input arguments
C     imax    :: number of vertical grid points
C     fact    :: scale  factor to apply to depth array
C     myTime  :: Current time in simulation
C     myIter  :: Current iteration number in simulation
C     myThid  :: My Thread Id. number
      INTEGER imax
      _RL     fact
      _RL     myTime
      INTEGER myIter
      INTEGER myThid
C     input/output arguments
C     swdk    :: on input: vertical depth for desired sw fraction
C               (fact*swdk) is negative distance (m) from surface
C     swdk    :: on output: short wave (radiation) fractional decay
      _RL     swdk(imax)

C     !LOCAL VARIABLES:
C     === Local variables ===
C     max number of different water types
      INTEGER   nwtype  , jwtype
      PARAMETER(nwtype=5)
      _RL facz
      _RL rfac(nwtype),a1(nwtype),a2(nwtype)
      INTEGER i
#ifdef ALLOW_CAL
c     _RL     fac
c     LOGICAL first, changed
c     INTEGER count0, count1
c     INTEGER jerl(12)
c     DATA jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
#endif /* ALLOW_CAL */
C
C     Jerlov water type :  I       IA      IB      II      III
C                jwtype    1       2       3       4       5
C
      DATA rfac         /  0.58 ,  0.62 ,  0.67 ,  0.77 ,  0.78 /
      DATA a1           /  0.35 ,  0.6  ,  1.0  ,  1.5  ,  1.4  /
      DATA a2           / 23.0  , 20.0  , 17.0  , 14.0  ,  7.9  /
CEOP

#ifdef ALLOW_CAL
ceh3 this should have an IF ( useCALENDAR ) THEN
CML(
C     myIter = 0 makes cal_getMonthsRec always return  count0=12
C     so that jerl(count0) = 2.
C     The following lines are meant to be an example of how to
C     include time dependent water types. However, it would probably
C     make more sense to first think about a regionally varying
C     water type before implementing a time dependence.
CML      CALL  cal_GetMonthsRec(
CML     O     fac, first, changed, count0, count1,
CML     I     myTime, myIter, myThid )
CML      jwtype=jerl(count0)
CML)
      jwtype=2
#else /* ALLOW_CAL undef */
      jwtype=2
#endif /* ALLOW_CAL */

      DO i = 1,imax
         facz = fact*swdk(i)
         IF (facz .LT. (-200.)) THEN
            swdk(i) = 0.
         ELSE
            swdk(i) =       rfac(jwtype)  * exp(facz/a1(jwtype))
     $                + (1.-rfac(jwtype)) * exp(facz/a2(jwtype))
         ENDIF
      ENDDO

      RETURN
      END
1	jmc	1.14	C $Header: /u/gcmpack/MITgcm/model/src/swfrac.F,v 1.13 2007/05/03 21:39:59 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	adcroft	1.1	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	cnh	1.9	CEOP
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	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