model/src/swfrac.F

C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_forcing.F,v 1.15 1998/12/15 00:20:34 adcroft Exp

#include "CPP_OPTIONS.h"

#ifdef ALLOW_KPP
C I.Fukumori 8/24/98 
CStartOfInterface
      SUBROUTINE SWFRAC(
     I     imax, fact, z, jwtype,
     O     swdk )
C     /==========================================================\
C     | SUBROUTINE SWFRAC                                        |
C     | Compute fraction of solar short-wave flux penetrating to |
C     | specified depth, z, 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     | 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

      integer nwtype
      PARAMETER(nwtype=5)  ! max number of different water types 

C     === Routine arguments ===

C     input arguments
      INTEGER imax              ! number of vertical grid points
      _RS fact                  ! scale  factor to apply to depth array
      _RS z(imax)               ! vertical depth for desired sw fraction
                                ! (fact*z) is negative distance (m) from surface
      INTEGER jwtype            ! index for jerlov water type

C     output arguments
      _RS swdk(imax)            ! short wave (radiation) fractional decay

C     === Local variables ===
      _RS facz
      REAL  rfac(nwtype),a1(nwtype),a2(nwtype)
      INTEGER i
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
      DO i = 1,imax
         facz = fact*z(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
#endif
1	C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_forcing.F,v 1.15 1998/12/15 00:20:34 adcroft Exp
2
3	#include "CPP_OPTIONS.h"
4
5	#ifdef ALLOW_KPP
6	C I.Fukumori 8/24/98
7	CStartOfInterface
8	SUBROUTINE SWFRAC(
9	I imax, fact, z, jwtype,
10	O swdk )
11	C /==========================================================\
12	C \| SUBROUTINE SWFRAC \|
13	C \| Compute fraction of solar short-wave flux penetrating to \|
14	C \| specified depth, z, due to exponential decay in \|
15	C \| Jerlov water type jwtype. \|
16	C \| Reference : Two band solar absorption model of Paulson \|
17	C \| and Simpson (1977, JPO, 7, 952-956) \|
18	C \| Notes \|
19	C \| ===== \|
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	integer nwtype
30	PARAMETER(nwtype=5) ! max number of different water types
31
32	C === Routine arguments ===
33
34	C input arguments
35	INTEGER imax ! number of vertical grid points
36	_RS fact ! scale factor to apply to depth array
37	_RS z(imax) ! vertical depth for desired sw fraction
38	! (fact*z) is negative distance (m) from surface
39	INTEGER jwtype ! index for jerlov water type
40
41	C output arguments
42	_RS swdk(imax) ! short wave (radiation) fractional decay
43
44	C === Local variables ===
45	_RS facz
46	REAL rfac(nwtype),a1(nwtype),a2(nwtype)
47	INTEGER i
48	C
49	C Jerlov water type : I IA IB II III
50	C jwtype 1 2 3 4 5
51	C
52	DATA rfac / 0.58 , 0.62 , 0.67 , 0.77 , 0.78 /
53	DATA a1 / 0.35 , 0.6 , 1.0 , 1.5 , 1.4 /
54	DATA a2 / 23.0 , 20.0 , 17.0 , 14.0 , 7.9 /
55	C
56	DO i = 1,imax
57	facz = fact*z(i)
58	IF (facz .LT. (-200.)) THEN
59	swdk(i) = 0.
60	ELSE
61	swdk(i) = rfac(jwtype) * exp(facz/a1(jwtype))
62	$ + (1.-rfac(jwtype)) * exp(facz/a2(jwtype))
63	ENDIF
64	ENDDO
65
66	RETURN
67	END
68	#endif