/[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.8 by cnh, Sun Feb 4 14:38:48 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6        SUBROUTINE SWFRAC(        SUBROUTINE SWFRAC(
7       I     imax, fact, z,       I     imax, fact,
8       O     swdk )       I     mytime, mythid,
9         U     swdk )
10  C     /==========================================================\  C     /==========================================================\
11  C     | SUBROUTINE SWFRAC                                        |  C     | SUBROUTINE SWFRAC                                        |
12  C     | Compute fraction of solar short-wave flux penetrating to |  C     | Compute fraction of solar short-wave flux penetrating to |
13  C     | specified depth, z, due to exponential decay in          |  C     | specified depth, swdk, due to exponential decay in       |
14  C     | Jerlov water type jwtype.                                |  C     | Jerlov water type jwtype.                                |
15  C     | Reference : Two band solar absorption model of Paulson   |  C     | Reference : Two band solar absorption model of Paulson   |
16  C     |             and Simpson (1977, JPO, 7, 952-956)          |  C     |             and Simpson (1977, JPO, 7, 952-956)          |
17  C     | Notes                                                    |  C     | Notes                                                    |
18  C     | =====                                                    |  C     | =====                                                    |
19    C     | Parameter jwtype is hardcoded to 3 for time being.       |
20  C     | Below 200m the solar penetration gets set to zero,       |  C     | Below 200m the solar penetration gets set to zero,       |
21  C     | otherwise the limit for the exponent (+/- 5678) needs to |  C     | otherwise the limit for the exponent (+/- 5678) needs to |
22  C     | be taken care of.                                        |  C     | be taken care of.                                        |
# Line 28  C     === Routine arguments === Line 31  C     === Routine arguments ===
31  C     input arguments  C     input arguments
32  C     imax    number of vertical grid points  C     imax    number of vertical grid points
33  C     fact    scale  factor to apply to depth array  C     fact    scale  factor to apply to depth array
34  C     z       vertical depth for desired sw fraction  C     myTime  current time in simulation
35  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  
36    
37        INTEGER imax        INTEGER imax
38        _RS fact        _RL     fact
39        _RS z(imax)        _RL     mytime
40          integer mythid
41  C     output arguments  
42  C     swdk    short wave (radiation) fractional decay  C     input/output arguments
43        _RS     swdk(imax)  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 ===  C     === Local variables ===
49    
50  C     max number of different water types  C     max number of different water types
51        integer   nwtype        integer   nwtype  , jwtype
52        PARAMETER(nwtype = 5)        PARAMETER(nwtype=5)
53    
54        _RS facz        _RL facz
55        _RL rfac(nwtype),a1(nwtype),a2(nwtype)        _RL rfac(nwtype),a1(nwtype),a2(nwtype)
56        INTEGER i        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  C
68  C     Jerlov water type :  I       IA      IB      II      III  C     Jerlov water type :  I       IA      IB      II      III
69  C                jwtype    1       2       3       4       5  C                jwtype    1       2       3       4       5
# Line 56  C Line 71  C
71        DATA rfac         /  0.58 ,  0.62 ,  0.67 ,  0.77 ,  0.78 /        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  /        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  /        DATA a2           / 23.0  , 20.0  , 17.0  , 14.0  ,  7.9  /
       INTEGER jwtype  
74  C  C
75        jwtype=1  #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        DO i = 1,imax
86           facz = fact*z(i)           facz = fact*swdk(i)
87           IF (facz .LT. (-200.)) THEN           IF (facz .LT. (-200.)) THEN
88              swdk(i) = 0.              swdk(i) = 0.
89           ELSE           ELSE
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22