model/src/swfrac.F

6d54cf9ca1 Ed H*0001 #include "PACKAGES_CONFIG.h"
fb3dc7d949 Alis*0002 #include "CPP_OPTIONS.h"
                0003
9366854e02 Chri*0004 CBOP
                0005 C     !ROUTINE: SWFRAC
                0006 C     !INTERFACE:
fb3dc7d949 Alis*0007       SUBROUTINE SWFRAC(
f0b70d7a94 Jean*0008      I                  imax, fact,
                0009      U                  swdk,
                0010      I                  myTime, myIter, myThid )
9366854e02 Chri*0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
f0b70d7a94 Jean*0013 C     | SUBROUTINE SWFRAC
9366854e02 Chri*0014 C     | o Compute solar short-wave flux penetration.
                0015 C     *==========================================================*
f0b70d7a94 Jean*0016 C     | Compute fraction of solar short-wave flux penetrating to
                0017 C     | specified depth, swdk, due to exponential decay in
                0018 C     | Jerlov water type jwtype.
                0019 C     | Reference : Two band solar absorption model of Paulson
                0020 C     |             and Simpson (1977, JPO, 7, 952-956)
                0021 C     | Notes
                0022 C     | =====
7fdac5d6c3 Dimi*0023 C     | Parameter jwtype is hardcoded to 2 for time being.
f0b70d7a94 Jean*0024 C     | Below 200m the solar penetration gets set to zero,
                0025 C     | otherwise the limit for the exponent (+/- 5678) needs to
                0026 C     | be taken care of.
                0027 C     | Written by   : Jan Morzel
                0028 C     | Date         : July 12, 1995
9366854e02 Chri*0029 C     *==========================================================*
                0030 C     \ev
fb3dc7d949 Alis*0031
9366854e02 Chri*0032 C     !USES:
fb3dc7d949 Alis*0033       IMPLICIT NONE
                0034
9366854e02 Chri*0035 C     !INPUT/OUTPUT PARAMETERS:
fb3dc7d949 Alis*0036 C     === Routine arguments ===
                0037 C     input arguments
9366854e02 Chri*0038 C     imax    :: number of vertical grid points
                0039 C     fact    :: scale  factor to apply to depth array
f0b70d7a94 Jean*0040 C     myTime  :: Current time in simulation
                0041 C     myIter  :: Current iteration number in simulation
                0042 C     myThid  :: My Thread Id. number
336430d9f6 Alis*0043       INTEGER imax
e508fdf6c2 Patr*0044       _RL     fact
f0b70d7a94 Jean*0045       _RL     myTime
                0046       INTEGER myIter
                0047       INTEGER myThid
e508fdf6c2 Patr*0048 C     input/output arguments
9366854e02 Chri*0049 C     swdk    :: on input: vertical depth for desired sw fraction
                0050 C               (fact*swdk) is negative distance (m) from surface
                0051 C     swdk    :: on output: short wave (radiation) fractional decay
e508fdf6c2 Patr*0052       _RL     swdk(imax)
79f5b9efed Alis*0053
9366854e02 Chri*0054 C     !LOCAL VARIABLES:
fb3dc7d949 Alis*0055 C     === Local variables ===
f0b70d7a94 Jean*0056 C     max number of different water types
                0057       INTEGER   nwtype  , jwtype
e508fdf6c2 Patr*0058       PARAMETER(nwtype=5)
                0059       _RL facz
336430d9f6 Alis*0060       _RL rfac(nwtype),a1(nwtype),a2(nwtype)
fb3dc7d949 Alis*0061       INTEGER i
438648d0e1 Patr*0062 #ifdef ALLOW_CAL
55e9ea8a90 Jean*0063 c     _RL     fac
                0064 c     LOGICAL first, changed
deacece587 Oliv*0065 c     INTEGER count0, count1, year0, year1
55e9ea8a90 Jean*0066 c     INTEGER jerl(12)
                0067 c     DATA jerl / 2 , 2 , 2 , 3 , 3 , 3 , 4 , 4 , 4 , 4 , 3 , 2 /
438648d0e1 Patr*0068 #endif /* ALLOW_CAL */
9366854e02 Chri*0069 CEOP
                0070
0d00a7ff2d Jean*0071 C     Jerlov water type :
                0072 C                  I          IA         IB         II         III
                0073 C     jwtype :     1          2          3          4          5
                0074       DATA rfac / 0.58 _d 0, 0.62 _d 0, 0.67 _d 0, 0.77 _d 0, 0.78 _d 0/
                0075       DATA a1   / 0.35 _d 0, 0.6  _d 0, 1.0  _d 0, 1.5  _d 0, 1.4  _d 0/
                0076       DATA a2   / 23.0 _d 0, 20.0 _d 0, 17.0 _d 0, 14.0 _d 0, 7.9  _d 0/
                0077
438648d0e1 Patr*0078 #ifdef ALLOW_CAL
6d54cf9ca1 Ed H*0079 ceh3 this should have an IF ( useCALENDAR ) THEN
329dcc48c4 Mart*0080 CML(
f0b70d7a94 Jean*0081 C     myIter = 0 makes cal_getMonthsRec always return  count0=12
329dcc48c4 Mart*0082 C     so that jerl(count0) = 2.
                0083 C     The following lines are meant to be an example of how to
                0084 C     include time dependent water types. However, it would probably
                0085 C     make more sense to first think about a regionally varying
                0086 C     water type before implementing a time dependence.
f0b70d7a94 Jean*0087 CML      CALL  cal_GetMonthsRec(
deacece587 Oliv*0088 CML     O     fac, first, changed, count0, count1, year0, year1,
f0b70d7a94 Jean*0089 CML     I     myTime, myIter, myThid )
329dcc48c4 Mart*0090 CML      jwtype=jerl(count0)
                0091 CML)
                0092       jwtype=2
438648d0e1 Patr*0093 #else /* ALLOW_CAL undef */
b48958e05b Patr*0094       jwtype=2
438648d0e1 Patr*0095 #endif /* ALLOW_CAL */
e508fdf6c2 Patr*0096
fb3dc7d949 Alis*0097       DO i = 1,imax
0d00a7ff2d Jean*0098         facz = fact*swdk(i)
                0099         IF ( facz .LT. -200. _d 0 ) THEN
                0100           swdk(i) = 0. _d 0
                0101         ELSE
                0102           swdk(i) =       rfac(jwtype)  * exp( facz/a1(jwtype) )
                0103      &       + (1. _d 0 - rfac(jwtype)) * exp( facz/a2(jwtype) )
                0104         ENDIF
fb3dc7d949 Alis*0105       ENDDO
                0106
                0107       RETURN
                0108       END