File indexing completed on 2021-11-10 06:14:45 UTC
view on githubraw file Latest commit deacece5 on 2021-11-09 17:35:09 UTC
6d54cf9ca1 Ed H*0001 #include "PACKAGES_CONFIG.h"
fb3dc7d949 Alis*0002 #include "CPP_OPTIONS.h"
0003
9366854e02 Chri*0004
0005
0006
fb3dc7d949 Alis*0007 SUBROUTINE SWFRAC(
f0b70d7a94 Jean*0008 I imax, fact,
0009 U swdk,
0010 I myTime, myIter, myThid )
9366854e02 Chri*0011
0012
f0b70d7a94 Jean*0013
9366854e02 Chri*0014
0015
f0b70d7a94 Jean*0016
0017
0018
0019
0020
0021
0022
7fdac5d6c3 Dimi*0023
f0b70d7a94 Jean*0024
0025
0026
0027
0028
9366854e02 Chri*0029
0030
fb3dc7d949 Alis*0031
9366854e02 Chri*0032
fb3dc7d949 Alis*0033 IMPLICIT NONE
0034
9366854e02 Chri*0035
fb3dc7d949 Alis*0036
0037
9366854e02 Chri*0038
0039
f0b70d7a94 Jean*0040
0041
0042
336430d9f6 Alis*0043 INTEGER imax
e508fdf6c2 Patr*0044 _RL fact
f0b70d7a94 Jean*0045 _RL myTime
0046 INTEGER myIter
0047 INTEGER myThid
e508fdf6c2 Patr*0048
9366854e02 Chri*0049
0050
0051
e508fdf6c2 Patr*0052 _RL swdk(imax)
79f5b9efed Alis*0053
9366854e02 Chri*0054
fb3dc7d949 Alis*0055
f0b70d7a94 Jean*0056
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
0064
deacece587 Oliv*0065
55e9ea8a90 Jean*0066
0067
438648d0e1 Patr*0068 #endif /* ALLOW_CAL */
9366854e02 Chri*0069
0070
0d00a7ff2d Jean*0071
0072
0073
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
329dcc48c4 Mart*0080
f0b70d7a94 Jean*0081
329dcc48c4 Mart*0082
0083
0084
0085
0086
f0b70d7a94 Jean*0087
deacece587 Oliv*0088
f0b70d7a94 Jean*0089
329dcc48c4 Mart*0090
0091
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