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

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

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

revision 1.2 by adcroft, Wed Jul 28 16:23:08 1999 UTC revision 1.14 by jmc, Tue Sep 4 16:49:44 2007 UTC
# Line 1  Line 1 
1  C  /u/gcmpack/models/MITgcmUV/model/src/ini_forcing.F,v 1.15 1998/12/15 00:20:34 adcroft Exp  C $Header$
2    C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7  #ifdef ALLOW_KPP  CBOP
8  C I.Fukumori 8/24/98  C     !ROUTINE: SWFRAC
9  CStartOfInterface  C     !INTERFACE:
10        SUBROUTINE SWFRAC(        SUBROUTINE SWFRAC(
11       I     imax, fact, z, jwtype,       I                  imax, fact,
12       O     swdk )       U                  swdk,
13  C     /==========================================================\       I                  myTime, myIter, myThid )
14  C     | SUBROUTINE SWFRAC                                        |  C     !DESCRIPTION: \bv
15  C     | Compute fraction of solar short-wave flux penetrating to |  C     *==========================================================*
16  C     | specified depth, z, due to exponential decay in          |  C     | SUBROUTINE SWFRAC
17  C     | Jerlov water type jwtype.                                |  C     | o Compute solar short-wave flux penetration.
18  C     | Reference : Two band solar absorption model of Paulson   |  C     *==========================================================*
19  C     |             and Simpson (1977, JPO, 7, 952-956)          |  C     | Compute fraction of solar short-wave flux penetrating to
20  C     | Notes                                                    |  C     | specified depth, swdk, due to exponential decay in
21  C     | =====                                                    |  C     | Jerlov water type jwtype.
22  C     | Below 200m the solar penetration gets set to zero,       |  C     | Reference : Two band solar absorption model of Paulson
23  C     | otherwise the limit for the exponent (+/- 5678) needs to |  C     |             and Simpson (1977, JPO, 7, 952-956)
24  C     | be taken care of.                                        |  C     | Notes
25  C     | Written by   : Jan Morzel                                |  C     | =====
26  C     | Date         : July 12, 1995                             |  C     | Parameter jwtype is hardcoded to 3 for time being.
27  C     \==========================================================/  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    
35    C     !USES:
36        IMPLICIT NONE        IMPLICIT NONE
37    
38        integer nwtype  C     !INPUT/OUTPUT PARAMETERS:
       PARAMETER(nwtype=5)  ! max number of different water types  
   
39  C     === Routine arguments ===  C     === Routine arguments ===
   
40  C     input arguments  C     input arguments
41        INTEGER imax              ! number of vertical grid points  C     imax    :: number of vertical grid points
42        _RS fact                  ! scale  factor to apply to depth array  C     fact    :: scale  factor to apply to depth array
43        _RS z(imax)               ! vertical depth for desired sw fraction  C     myTime  :: Current time in simulation
44                                  ! (fact*z) is negative distance (m) from surface  C     myIter  :: Current iteration number in simulation
45        INTEGER jwtype            ! index for jerlov water type  C     myThid  :: My Thread Id. number
46          INTEGER imax
47  C     output arguments        _RL     fact
48        _RS swdk(imax)            ! short wave (radiation) fractional decay        _RL     myTime
49          INTEGER myIter
50          INTEGER myThid
51    C     input/output arguments
52    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          _RL     swdk(imax)
56    
57    C     !LOCAL VARIABLES:
58  C     === Local variables ===  C     === Local variables ===
59        _RS facz  C     max number of different water types
60        REAL  rfac(nwtype),a1(nwtype),a2(nwtype)        INTEGER   nwtype  , jwtype
61          PARAMETER(nwtype=5)
62          _RL facz
63          _RL rfac(nwtype),a1(nwtype),a2(nwtype)
64        INTEGER i        INTEGER i
65    #ifdef ALLOW_CAL
66    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    #endif /* ALLOW_CAL */
72  C  C
73  C     Jerlov water type :  I       IA      IB      II      III  C     Jerlov water type :  I       IA      IB      II      III
74  C                jwtype    1       2       3       4       5  C                jwtype    1       2       3       4       5
# Line 52  C Line 76  C
76        DATA rfac         /  0.58 ,  0.62 ,  0.67 ,  0.77 ,  0.78 /        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  /        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  /        DATA a2           / 23.0  , 20.0  , 17.0  , 14.0  ,  7.9  /
79  C  CEOP
80    
81    #ifdef ALLOW_CAL
82    ceh3 this should have an IF ( useCALENDAR ) THEN
83    CML(
84    C     myIter = 0 makes cal_getMonthsRec always return  count0=12
85    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    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    #else /* ALLOW_CAL undef */
97          jwtype=2
98    #endif /* ALLOW_CAL */
99    
100        DO i = 1,imax        DO i = 1,imax
101           facz = fact*z(i)           facz = fact*swdk(i)
102           IF (facz .LT. (-200.)) THEN           IF (facz .LT. (-200.)) THEN
103              swdk(i) = 0.              swdk(i) = 0.
104           ELSE           ELSE
# Line 65  C Line 109  C
109    
110        RETURN        RETURN
111        END        END
 #endif  

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.14

  ViewVC Help
Powered by ViewVC 1.1.22