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