/[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.8 by cnh, Sun Feb 4 14:38:48 2001 UTC revision 1.9 by cnh, Wed Sep 26 18:09:16 2001 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: SWFRAC
8    C     !INTERFACE:
9        SUBROUTINE SWFRAC(        SUBROUTINE SWFRAC(
10       I     imax, fact,       I     imax, fact,
11       I     mytime, mythid,       I     mytime, mythid,
12       U     swdk )       U     swdk )
13  C     /==========================================================\  C     !DESCRIPTION: \bv
14  C     | SUBROUTINE SWFRAC                                        |  C     *==========================================================*
15  C     | Compute fraction of solar short-wave flux penetrating to |  C     | SUBROUTINE SWFRAC                                        
16  C     | specified depth, swdk, due to exponential decay in       |  C     | o Compute solar short-wave flux penetration.
17  C     | Jerlov water type jwtype.                                |  C     *==========================================================*
18  C     | Reference : Two band solar absorption model of Paulson   |  C     | Compute fraction of solar short-wave flux penetrating to  
19  C     |             and Simpson (1977, JPO, 7, 952-956)          |  C     | specified depth, swdk, due to exponential decay in        
20  C     | Notes                                                    |  C     | Jerlov water type jwtype.                                
21  C     | =====                                                    |  C     | Reference : Two band solar absorption model of Paulson    
22  C     | Parameter jwtype is hardcoded to 3 for time being.       |  C     |             and Simpson (1977, JPO, 7, 952-956)          
23  C     | Below 200m the solar penetration gets set to zero,       |  C     | Notes                                                    
24  C     | otherwise the limit for the exponent (+/- 5678) needs to |  C     | =====                                                    
25  C     | be taken care of.                                        |  C     | Parameter jwtype is hardcoded to 3 for time being.        
26  C     | Written by   : Jan Morzel                                |  C     | Below 200m the solar penetration gets set to zero,        
27  C     | Date         : July 12, 1995                             |  C     | otherwise the limit for the exponent (+/- 5678) needs to  
28  C     \==========================================================/  C     | be taken care of.                                        
29    C     | Written by   : Jan Morzel                                
30    C     | Date         : July 12, 1995                              
31    C     *==========================================================*
32    C     \ev
33    
34    C     !USES:
35        IMPLICIT NONE        IMPLICIT NONE
36    
37    C     !INPUT/OUTPUT PARAMETERS:
38  C     === Routine arguments ===  C     === Routine arguments ===
   
39  C     input arguments  C     input arguments
40  C     imax    number of vertical grid points  C     imax    :: number of vertical grid points
41  C     fact    scale  factor to apply to depth array  C     fact    :: scale  factor to apply to depth array
42  C     myTime  current time in simulation  C     myTime  :: current time in simulation
43  C     myThid  thread number for this instance of the routine.  C     myThid  :: thread number for this instance of the routine.
   
44        INTEGER imax        INTEGER imax
45        _RL     fact        _RL     fact
46        _RL     mytime        _RL     mytime
47        integer mythid        integer mythid
   
48  C     input/output arguments  C     input/output arguments
49  C     swdk    on input: vertical depth for desired sw fraction  C     swdk    :: on input: vertical depth for desired sw fraction
50  C             (fact*swdk) is negative distance (m) from surface  C               (fact*swdk) is negative distance (m) from surface
51  C     swdk    on output: short wave (radiation) fractional decay  C     swdk    :: on output: short wave (radiation) fractional decay
52        _RL     swdk(imax)        _RL     swdk(imax)
53    
54    C     !LOCAL VARIABLES:
55  C     === Local variables ===  C     === Local variables ===
   
56  C     max number of different water types  C     max number of different water types
57        integer   nwtype  , jwtype        integer   nwtype  , jwtype
58        PARAMETER(nwtype=5)        PARAMETER(nwtype=5)
   
59        _RL facz        _RL facz
60        _RL rfac(nwtype),a1(nwtype),a2(nwtype)        _RL rfac(nwtype),a1(nwtype),a2(nwtype)
61        INTEGER i        INTEGER i
   
62  #ifdef ALLOW_CALENDAR  #ifdef ALLOW_CALENDAR
63        _RL     fac        _RL     fac
64        logical first, changed        logical first, changed
# Line 63  C     max number of different water type Line 67  C     max number of different water type
67        integer jerl(12)        integer jerl(12)
68        data jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /        data jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
69  #endif /* ALLOW_CALENDAR */  #endif /* ALLOW_CALENDAR */
   
70  C  C
71  C     Jerlov water type :  I       IA      IB      II      III  C     Jerlov water type :  I       IA      IB      II      III
72  C                jwtype    1       2       3       4       5  C                jwtype    1       2       3       4       5
# Line 71  C Line 74  C
74        DATA rfac         /  0.58 ,  0.62 ,  0.67 ,  0.77 ,  0.78 /        DATA rfac         /  0.58 ,  0.62 ,  0.67 ,  0.77 ,  0.78 /
75        DATA a1           /  0.35 ,  0.6  ,  1.0  ,  1.5  ,  1.4  /        DATA a1           /  0.35 ,  0.6  ,  1.0  ,  1.5  ,  1.4  /
76        DATA a2           / 23.0  , 20.0  , 17.0  , 14.0  ,  7.9  /        DATA a2           / 23.0  , 20.0  , 17.0  , 14.0  ,  7.9  /
77  C  CEOP
78    
79  #ifdef ALLOW_CALENDAR  #ifdef ALLOW_CALENDAR
80        myiter=0        myiter=0
81        call  cal_GetMonthsRec(        call  cal_GetMonthsRec(
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22