/[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.9.20.1 by edhill, Thu Oct 2 18:10:45 2003 UTC revision 1.16 by dimitri, Fri Feb 7 15:10:38 2014 UTC
# Line 8  CBOP Line 8  CBOP
8  C     !ROUTINE: SWFRAC  C     !ROUTINE: SWFRAC
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE SWFRAC(        SUBROUTINE SWFRAC(
11       I     imax, fact,       I                  imax, fact,
12       I     mytime, mythid,       U                  swdk,
13       U     swdk )       I                  myTime, myIter, myThid )
14  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
15  C     *==========================================================*  C     *==========================================================*
16  C     | SUBROUTINE SWFRAC                                          C     | SUBROUTINE SWFRAC
17  C     | o Compute solar short-wave flux penetration.  C     | o Compute solar short-wave flux penetration.
18  C     *==========================================================*  C     *==========================================================*
19  C     | Compute fraction of solar short-wave flux penetrating to    C     | Compute fraction of solar short-wave flux penetrating to
20  C     | specified depth, swdk, due to exponential decay in          C     | specified depth, swdk, due to exponential decay in
21  C     | Jerlov water type jwtype.                                  C     | Jerlov water type jwtype.
22  C     | Reference : Two band solar absorption model of Paulson      C     | Reference : Two band solar absorption model of Paulson
23  C     |             and Simpson (1977, JPO, 7, 952-956)            C     |             and Simpson (1977, JPO, 7, 952-956)
24  C     | Notes                                                      C     | Notes
25  C     | =====                                                      C     | =====
26  C     | Parameter jwtype is hardcoded to 3 for time being.          C     | Parameter jwtype is hardcoded to 2 for time being.
27  C     | Below 200m the solar penetration gets set to zero,          C     | Below 200m the solar penetration gets set to zero,
28  C     | otherwise the limit for the exponent (+/- 5678) needs to    C     | otherwise the limit for the exponent (+/- 5678) needs to
29  C     | be taken care of.                                          C     | be taken care of.
30  C     | Written by   : Jan Morzel                                  C     | Written by   : Jan Morzel
31  C     | Date         : July 12, 1995                                C     | Date         : July 12, 1995
32  C     *==========================================================*  C     *==========================================================*
33  C     \ev  C     \ev
34    
# Line 40  C     === Routine arguments === Line 40  C     === Routine arguments ===
40  C     input arguments  C     input arguments
41  C     imax    :: number of vertical grid points  C     imax    :: number of vertical grid points
42  C     fact    :: scale  factor to apply to depth array  C     fact    :: scale  factor to apply to depth array
43  C     myTime  :: current time in simulation  C     myTime  :: Current time in simulation
44  C     myThid  :: thread number for this instance of the routine.  C     myIter  :: Current iteration number in simulation
45    C     myThid  :: My Thread Id. number
46        INTEGER imax        INTEGER imax
47        _RL     fact        _RL     fact
48        _RL     mytime        _RL     myTime
49        integer mythid        INTEGER myIter
50          INTEGER myThid
51  C     input/output arguments  C     input/output arguments
52  C     swdk    :: on input: vertical depth for desired sw fraction  C     swdk    :: on input: vertical depth for desired sw fraction
53  C               (fact*swdk) is negative distance (m) from surface  C               (fact*swdk) is negative distance (m) from surface
# Line 54  C     swdk    :: on output: short wave ( Line 56  C     swdk    :: on output: short wave (
56    
57  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
58  C     === Local variables ===  C     === Local variables ===
59  C     max number of different water types  C     max number of different water types
60        integer   nwtype  , jwtype        INTEGER   nwtype  , jwtype
61        PARAMETER(nwtype=5)        PARAMETER(nwtype=5)
62        _RL facz        _RL facz
63        _RL rfac(nwtype),a1(nwtype),a2(nwtype)        _RL rfac(nwtype),a1(nwtype),a2(nwtype)
64        INTEGER i        INTEGER i
65  #ifdef ALLOW_CALENDAR  #ifdef ALLOW_CAL
66        _RL     fac  c     _RL     fac
67        logical first, changed  c     LOGICAL first, changed
68        integer count0, count1  c     INTEGER count0, count1
69        integer myiter  c     INTEGER jerl(12)
70        integer jerl(12)  c     DATA jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
71        data jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /  #endif /* ALLOW_CAL */
 #endif /* ALLOW_CALENDAR */  
 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  /  
72  CEOP  CEOP
73    
74  #ifdef ALLOW_CALENDAR  C     Jerlov water type :
75    C                  I          IA         IB         II         III
76    C     jwtype :     1          2          3          4          5
77          DATA rfac / 0.58 _d 0, 0.62 _d 0, 0.67 _d 0, 0.77 _d 0, 0.78 _d 0/
78          DATA a1   / 0.35 _d 0, 0.6  _d 0, 1.0  _d 0, 1.5  _d 0, 1.4  _d 0/
79          DATA a2   / 23.0 _d 0, 20.0 _d 0, 17.0 _d 0, 14.0 _d 0, 7.9  _d 0/
80    
81    #ifdef ALLOW_CAL
82  ceh3 this should have an IF ( useCALENDAR ) THEN  ceh3 this should have an IF ( useCALENDAR ) THEN
83        myiter=0  CML(
84        call  cal_GetMonthsRec(  C     myIter = 0 makes cal_getMonthsRec always return  count0=12
85       O     fac, first, changed, count0, count1,  C     so that jerl(count0) = 2.
86       I     mytime, myiter, mythid )  C     The following lines are meant to be an example of how to
87        jwtype=jerl(count0)  C     include time dependent water types. However, it would probably
88  #else /* ALLOW_CALENDAR undef */  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        jwtype=2
98  #endif /* ALLOW_CALENDAR */  #endif /* ALLOW_CAL */
99    
100        DO i = 1,imax        DO i = 1,imax
101           facz = fact*swdk(i)          facz = fact*swdk(i)
102           IF (facz .LT. (-200.)) THEN          IF ( facz .LT. -200. _d 0 ) THEN
103              swdk(i) = 0.            swdk(i) = 0. _d 0
104           ELSE          ELSE
105              swdk(i) =       rfac(jwtype)  * exp(facz/a1(jwtype))            swdk(i) =       rfac(jwtype)  * exp( facz/a1(jwtype) )
106       $                + (1.-rfac(jwtype)) * exp(facz/a2(jwtype))       &       + (1. _d 0 - rfac(jwtype)) * exp( facz/a2(jwtype) )
107           ENDIF          ENDIF
108        ENDDO        ENDDO
109    
110        RETURN        RETURN
Legend:
Removed from v.1.9.20.1  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22