model/src/swfrac.F

C $Header: /u/gcmpack/models/MITgcmUV/model/src/swfrac.F,v 1.7 2000/11/14 03:43:37 heimbach Exp $
C $Name: $

#include "CPP_OPTIONS.h"

      SUBROUTINE SWFRAC(
     I     imax, fact,
     I     mytime, mythid,
     U     swdk )
C     /==========================================================\
C     | SUBROUTINE SWFRAC                                        |
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     \==========================================================/

      IMPLICIT NONE

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     myThid  thread number for this instance of the routine.

      INTEGER imax
      _RL     fact
      _RL     mytime
      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     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_CALENDAR
      _RL     fac
      logical first, changed
      integer count0, count1
      integer myiter
      integer jerl(12)
      data jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
#endif /* ALLOW_CALENDAR */

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  /
C
#ifdef ALLOW_CALENDAR
      myiter=0
      call  cal_GetMonthsRec(
     O     fac, first, changed, count0, count1,
     I     mytime, myiter, mythid )
      jwtype=jerl(count0)
#else /* ALLOW_CALENDAR undef */
      jwtype=2
#endif /* ALLOW_CALENDAR */

      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	C $Header: /u/gcmpack/models/MITgcmUV/model/src/swfrac.F,v 1.7 2000/11/14 03:43:37 heimbach Exp $
2	C $Name: $
3
4	#include "CPP_OPTIONS.h"
5
6	SUBROUTINE SWFRAC(
7	I imax, fact,
8	I mytime, mythid,
9	U swdk )
10	C /==========================================================\
11	C \| SUBROUTINE SWFRAC \|
12	C \| Compute fraction of solar short-wave flux penetrating to \|
13	C \| specified depth, swdk, due to exponential decay in \|
14	C \| Jerlov water type jwtype. \|
15	C \| Reference : Two band solar absorption model of Paulson \|
16	C \| and Simpson (1977, JPO, 7, 952-956) \|
17	C \| Notes \|
18	C \| ===== \|
19	C \| Parameter jwtype is hardcoded to 3 for time being. \|
20	C \| Below 200m the solar penetration gets set to zero, \|
21	C \| otherwise the limit for the exponent (+/- 5678) needs to \|
22	C \| be taken care of. \|
23	C \| Written by : Jan Morzel \|
24	C \| Date : July 12, 1995 \|
25	C \==========================================================/
26
27	IMPLICIT NONE
28
29	C === Routine arguments ===
30
31	C input arguments
32	C imax number of vertical grid points
33	C fact scale factor to apply to depth array
34	C myTime current time in simulation
35	C myThid thread number for this instance of the routine.
36
37	INTEGER imax
38	_RL fact
39	_RL mytime
40	integer mythid
41
42	C input/output arguments
43	C swdk on input: vertical depth for desired sw fraction
44	C (fact*swdk) is negative distance (m) from surface
45	C swdk on output: short wave (radiation) fractional decay
46	_RL swdk(imax)
47
48	C === Local variables ===
49
50	C max number of different water types
51	integer nwtype , jwtype
52	PARAMETER(nwtype=5)
53
54	_RL facz
55	_RL rfac(nwtype),a1(nwtype),a2(nwtype)
56	INTEGER i
57
58	#ifdef ALLOW_CALENDAR
59	_RL fac
60	logical first, changed
61	integer count0, count1
62	integer myiter
63	integer jerl(12)
64	data jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
65	#endif /* ALLOW_CALENDAR */
66
67	C
68	C Jerlov water type : I IA IB II III
69	C jwtype 1 2 3 4 5
70	C
71	DATA rfac / 0.58 , 0.62 , 0.67 , 0.77 , 0.78 /
72	DATA a1 / 0.35 , 0.6 , 1.0 , 1.5 , 1.4 /
73	DATA a2 / 23.0 , 20.0 , 17.0 , 14.0 , 7.9 /
74	C
75	#ifdef ALLOW_CALENDAR
76	myiter=0
77	call cal_GetMonthsRec(
78	O fac, first, changed, count0, count1,
79	I mytime, myiter, mythid )
80	jwtype=jerl(count0)
81	#else /* ALLOW_CALENDAR undef */
82	jwtype=2
83	#endif /* ALLOW_CALENDAR */
84
85	DO i = 1,imax
86	facz = fact*swdk(i)
87	IF (facz .LT. (-200.)) THEN
88	swdk(i) = 0.
89	ELSE
90	swdk(i) = rfac(jwtype) * exp(facz/a1(jwtype))
91	$ + (1.-rfac(jwtype)) * exp(facz/a2(jwtype))
92	ENDIF
93	ENDDO
94
95	RETURN
96	END