1 |
C $Header: /u/gcmpack/MITgcm/pkg/salt_plume/salt_plume_frac.F,v 1.9 2014/05/21 10:46:03 heimbach Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "SALT_PLUME_OPTIONS.h" |
5 |
|
6 |
CBOP |
7 |
C !ROUTINE: SALT_PLUME_FRAC |
8 |
C !INTERFACE: |
9 |
SUBROUTINE SALT_PLUME_FRAC( |
10 |
I imax, fact,SPDepth, |
11 |
#ifdef SALT_PLUME_SPLIT_BASIN |
12 |
I lon,lat, |
13 |
#endif |
14 |
U plumek, |
15 |
I myTime, myIter, myThid ) |
16 |
|
17 |
C !DESCRIPTION: \bv |
18 |
C *==========================================================* |
19 |
C | SUBROUTINE SALT_PLUME_FRAC |
20 |
C | o Compute saltplume penetration. |
21 |
C *==========================================================* |
22 |
C | Compute fraction of saltplume (flux) penetrating to |
23 |
C | specified depth, plumek, due to rejected salt |
24 |
C | during freezing. |
25 |
C | For example, if surface value is Saltplume0, |
26 |
C | and each level gets equal fraction 1/5 down to SPDepth=5, |
27 |
C | SALT_PLUME_FRAC will report plumek = 1/5,2/5,3/5,4/5,5/5 on |
28 |
C | output if input plumek = 1,2,3,4,5. Else, output plumek = 0. |
29 |
C | Reference : Duffy et al, (GRL 1999) |
30 |
C | |
31 |
C | ===== |
32 |
C | Written by : ATN (based on SWFRAC) |
33 |
C | Date : Sep 13, 2007 |
34 |
C | Modified : Mar 16, 2014 by atn to improve/clean up |
35 |
C | -> replace 1-[cummulative plumefrac] code which was based |
36 |
C | on swfrac with cleaner [cummulative plumefrac] on output |
37 |
C | in order to avoid 1-[1-[cummulative_plumefrac]] whenever |
38 |
C | SALT_PLUME_FRAC is called and used from outside. |
39 |
C *==========================================================* |
40 |
C \ev |
41 |
|
42 |
C !USES: |
43 |
IMPLICIT NONE |
44 |
#include "SIZE.h" |
45 |
#include "SALT_PLUME.h" |
46 |
|
47 |
C !INPUT/OUTPUT PARAMETERS: |
48 |
C input arguments |
49 |
C imax :: number of vertical grid points |
50 |
C fact :: scale factor to apply to depth array |
51 |
C SPDpeth :: corresponding SaltPlumeDepth(i,j) at this grid point |
52 |
C myTime :: Current time in simulation |
53 |
C myIter :: Current iteration number in simulation |
54 |
C myThid :: My Thread Id. number |
55 |
INTEGER imax |
56 |
_RL fact |
57 |
_RL myTime |
58 |
INTEGER myIter |
59 |
INTEGER myThid |
60 |
C input/output arguments |
61 |
C plumek :: on input: vertical depth for desired plume fraction |
62 |
C (fact*plumek) is negative distance (m) from surface |
63 |
C plumek :: on output: saltplume contribution fraction |
64 |
_RL plumek(imax), SPDepth(imax) |
65 |
#ifdef SALT_PLUME_SPLIT_BASIN |
66 |
_RL lon(imax), lat(imax) |
67 |
#endif |
68 |
CEOP |
69 |
|
70 |
#ifdef ALLOW_SALT_PLUME |
71 |
C !LOCAL VARIABLES: |
72 |
_RL facz, dd, dd20 |
73 |
INTEGER i, Npowerloc |
74 |
#ifndef TARGET_NEC_SX |
75 |
INTEGER kk |
76 |
#endif |
77 |
_RL one, two, three, S, So, zero |
78 |
parameter( one = 1. _d 0, two = 2. _d 0, three = 3. _d 0 ) |
79 |
parameter( zero = 0. _d 0 ) |
80 |
C This is an abbreviation of 1./(exp(1.)-1.) |
81 |
_RL recip_expOneM1 |
82 |
parameter( recip_expOneM1 = 0.581976706869326343 ) |
83 |
|
84 |
DO i = 1,imax |
85 |
facz = abs(fact*plumek(i)) |
86 |
#ifdef SALT_PLUME_SPLIT_BASIN |
87 |
IF(SaltPlumeSplitBasin) THEN |
88 |
Npowerloc = Npower(2) |
89 |
IF(lat(imax).LT. 85.0 .AND. lat(imax).GT. 71.0 |
90 |
& .AND. lon(imax) .LT. -90.0) Npowerloc = Npower(1) |
91 |
ELSE |
92 |
Npowerloc = Npower(1) |
93 |
ENDIF |
94 |
#else |
95 |
Npowerloc = Npower |
96 |
#endif |
97 |
|
98 |
IF (SPDepth(i).GE.facz .and. SPDepth(i) .GT. zero) THEN |
99 |
|
100 |
C Default: uniform distribution, PlumeMethod=1, Npower=0 |
101 |
IF (PlumeMethod .EQ. 1) THEN |
102 |
dd20 = (abs(SPDepth(i))) |
103 |
#ifdef TARGET_NEC_SX |
104 |
IF ( dd20 .GT. zero ) THEN |
105 |
S = (facz/dd20) |
106 |
C crazy attempt to make the code faster and raise S to (Npower+1) |
107 |
IF (Npowerloc .GT. 0) S = S*S**Npowerloc |
108 |
ELSE |
109 |
S = zero |
110 |
ENDIF |
111 |
plumek(i) = max(zero,S) |
112 |
#else |
113 |
S = one !input depth temp |
114 |
So = one |
115 |
DO kk=1,Npowerloc+1 |
116 |
S = facz*S !raise to the Npowerloc+1 |
117 |
So = dd20*So |
118 |
ENDDO |
119 |
plumek(i) = max(zero,S/So) |
120 |
#endif /* TARGET_NEC_SX */ |
121 |
|
122 |
ELSEIF (PlumeMethod .EQ. 2) THEN !exponential distribution |
123 |
dd = abs(SPDepth(i)) |
124 |
S = exp(facz/dd)-one |
125 |
So = recip_expOneM1 !So = exp(one)-one |
126 |
plumek(i) = max(zero,S*So) |
127 |
|
128 |
C PlumeMethod = 3, distribute salt LINEARLY between SPDepth and |
129 |
C SPDepth/SPovershoot |
130 |
C (1-SPovershoot)percent has already been taken into account in |
131 |
C SPDepth calculation, i.e., SPDepth = SPovershoot*SPDepth. |
132 |
ELSEIF (PlumeMethod .EQ. 3) THEN !overshoot 20% |
133 |
dd20 = (abs(SPDepth(i))) |
134 |
dd = dd20/SPovershoot |
135 |
So=dd20-dd |
136 |
S =facz-dd |
137 |
IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN |
138 |
plumek(i) = max(zero,S/So) |
139 |
ELSE |
140 |
plumek(i) = zero |
141 |
ENDIF |
142 |
|
143 |
C PlumeMethod = 5, dumping all salt at the top layer |
144 |
ELSEIF (PlumeMethod .EQ. 5) THEN |
145 |
dd = zero |
146 |
dd20 = one |
147 |
IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN |
148 |
plumek(i) = zero |
149 |
ELSE |
150 |
plumek(i) = one |
151 |
ENDIF |
152 |
ELSEIF (PlumeMethod .EQ. 6) THEN |
153 |
C PLumeMethod = 6, currently only works for Npower = 1 and 2. |
154 |
dd20 = (abs(SPDepth(i))) |
155 |
#ifdef TARGET_NEC_SX |
156 |
IF ( dd20 .GT. zero ) THEN |
157 |
S = (facz/dd20) |
158 |
C crazy attempt to make the code faster and raise S to (Npower+1) |
159 |
IF (Npowerloc .GT. 0) S = S*S**Npowerloc |
160 |
So = 1. _d 0/dd20 |
161 |
ELSE |
162 |
S = zero |
163 |
So = zero |
164 |
ENDIF |
165 |
IF(Npowerloc.EQ.1) THEN !Npower=1 |
166 |
plumek(i) = max(zero,two*So*facz-S) |
167 |
ELSE !Npower=2 |
168 |
plumek(i) = max(zero, |
169 |
& three*So*facz - three*So*So*facz*facz + S) |
170 |
ENDIF |
171 |
#else |
172 |
S = one !input depth temp |
173 |
So = one |
174 |
DO kk=1,Npowerloc+1 |
175 |
S = facz*S !raise to the Npower+1 |
176 |
So = dd20*So |
177 |
ENDDO |
178 |
IF(Npowerloc.EQ.1) THEN !Npower=1 |
179 |
plumek(i) = max(zero,two/dd20*facz-S/So) |
180 |
ELSE !Npower=2 |
181 |
plumek(i) = max(zero, |
182 |
& three/dd20*facz - three/(dd20*dd20)*facz*facz + S/So) |
183 |
ENDIF |
184 |
#endif /* TARGET_NEC_SX */ |
185 |
|
186 |
catn: 15.Mar.2014 |
187 |
catn: this is a new method by atn. After fixing adjoint compiling error, |
188 |
catn: will switch this on. Currently commenting out for purpose of |
189 |
catn: comparing old (1-abc) vs new (abc) way of coding |
190 |
c ELSEIF (PlumeMethod .EQ. 7) THEN |
191 |
cC PLumeMethod = 7, dump an offset parabolla with more salt at surface |
192 |
cC tapered to zero at depth SPDepth/2, then increased until SPDepth |
193 |
cC need input SPDepth, NPower = percentage of SPDepth |
194 |
cC Ex: if Npower = 10 -> (10/2)=5% of SPDepth |
195 |
cC NPower can be negative integer here. |
196 |
cC 0 -> parabola centered at SPDepth/2; |
197 |
cC + -> parabola offset, salt @ surface < @ SPDepth |
198 |
cC - -> parabola offset, salt @ surface > @ SPDepth |
199 |
cC S and So are dummy variables |
200 |
c dd = (abs(SPDepth(i))) |
201 |
c dd20 = dd*(one/two-Npower/200. _d 0) |
202 |
c So = (dd*dd*dd/three) |
203 |
c & -(dd*dd) *dd20 |
204 |
c & +(dd) *dd20*dd20 |
205 |
c S = (facz*facz *facz/three) |
206 |
c & - (facz*facz)*dd20 |
207 |
c & + (facz) *dd20*dd20 |
208 |
c plumek(i) = max(zero,(S/So)) |
209 |
c |
210 |
ELSE |
211 |
plumek(i) = one |
212 |
#ifndef TARGET_NEC_SX |
213 |
WRITE(*,*) 'salt_plume_frac: PLumeMethod =', PLumeMethod, |
214 |
& 'not implemented' |
215 |
STOP 'ABNORMAL in S/R SALT_PLUME_FRAC' |
216 |
#endif /* not TARGET_NEC_SX */ |
217 |
ENDIF |
218 |
ELSE |
219 |
plumek(i) = one |
220 |
ENDIF |
221 |
ENDDO |
222 |
|
223 |
#endif /* ALLOW_SALT_PLUME */ |
224 |
|
225 |
RETURN |
226 |
END |