| 1 |
jmc |
1.10 |
C $Header: /u/gcmpack/MITgcm/pkg/salt_plume/salt_plume_frac.F,v 1.9 2014/05/21 10:46:03 heimbach Exp $ |
| 2 |
dimitri |
1.1 |
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 |
heimbach |
1.9 |
#ifdef SALT_PLUME_SPLIT_BASIN |
| 12 |
|
|
I lon,lat, |
| 13 |
|
|
#endif |
| 14 |
dimitri |
1.1 |
U plumek, |
| 15 |
|
|
I myTime, myIter, myThid ) |
| 16 |
dimitri |
1.2 |
|
| 17 |
dimitri |
1.1 |
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 |
atn |
1.8 |
C | SALT_PLUME_FRAC will report plumek = 1/5,2/5,3/5,4/5,5/5 on |
| 28 |
jmc |
1.10 |
C | output if input plumek = 1,2,3,4,5. Else, output plumek = 0. |
| 29 |
dimitri |
1.1 |
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 |
atn |
1.8 |
C | Modified : Mar 16, 2014 by atn to improve/clean up |
| 35 |
jmc |
1.10 |
C | -> replace 1-[cummulative plumefrac] code which was based |
| 36 |
atn |
1.8 |
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 |
dimitri |
1.1 |
C *==========================================================* |
| 40 |
|
|
C \ev |
| 41 |
|
|
|
| 42 |
|
|
C !USES: |
| 43 |
|
|
IMPLICIT NONE |
| 44 |
dimitri |
1.3 |
#include "SIZE.h" |
| 45 |
|
|
#include "SALT_PLUME.h" |
| 46 |
dimitri |
1.1 |
|
| 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 |
heimbach |
1.9 |
#ifdef SALT_PLUME_SPLIT_BASIN |
| 66 |
|
|
_RL lon(imax), lat(imax) |
| 67 |
|
|
#endif |
| 68 |
dimitri |
1.2 |
CEOP |
| 69 |
|
|
|
| 70 |
|
|
#ifdef ALLOW_SALT_PLUME |
| 71 |
dimitri |
1.1 |
C !LOCAL VARIABLES: |
| 72 |
dimitri |
1.3 |
_RL facz, dd, dd20 |
| 73 |
heimbach |
1.9 |
INTEGER i, Npowerloc |
| 74 |
mlosch |
1.5 |
#ifndef TARGET_NEC_SX |
| 75 |
|
|
INTEGER kk |
| 76 |
|
|
#endif |
| 77 |
atn |
1.8 |
_RL one, two, three, S, So, zero |
| 78 |
atn |
1.4 |
parameter( one = 1. _d 0, two = 2. _d 0, three = 3. _d 0 ) |
| 79 |
atn |
1.8 |
parameter( zero = 0. _d 0 ) |
| 80 |
mlosch |
1.6 |
C This is an abbreviation of 1./(exp(1.)-1.) |
| 81 |
|
|
_RL recip_expOneM1 |
| 82 |
|
|
parameter( recip_expOneM1 = 0.581976706869326343 ) |
| 83 |
dimitri |
1.1 |
|
| 84 |
|
|
DO i = 1,imax |
| 85 |
mlosch |
1.5 |
facz = abs(fact*plumek(i)) |
| 86 |
heimbach |
1.9 |
#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 |
atn |
1.8 |
|
| 98 |
|
|
IF (SPDepth(i).GE.facz .and. SPDepth(i) .GT. zero) THEN |
| 99 |
dimitri |
1.3 |
|
| 100 |
atn |
1.4 |
C Default: uniform distribution, PlumeMethod=1, Npower=0 |
| 101 |
mlosch |
1.5 |
IF (PlumeMethod .EQ. 1) THEN |
| 102 |
|
|
dd20 = (abs(SPDepth(i))) |
| 103 |
|
|
#ifdef TARGET_NEC_SX |
| 104 |
atn |
1.8 |
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 |
heimbach |
1.9 |
IF (Npowerloc .GT. 0) S = S*S**Npowerloc |
| 108 |
mlosch |
1.5 |
ELSE |
| 109 |
atn |
1.8 |
S = zero |
| 110 |
mlosch |
1.5 |
ENDIF |
| 111 |
atn |
1.8 |
plumek(i) = max(zero,S) |
| 112 |
mlosch |
1.5 |
#else |
| 113 |
atn |
1.8 |
S = one !input depth temp |
| 114 |
|
|
So = one |
| 115 |
heimbach |
1.9 |
DO kk=1,Npowerloc+1 |
| 116 |
|
|
S = facz*S !raise to the Npowerloc+1 |
| 117 |
atn |
1.8 |
So = dd20*So |
| 118 |
mlosch |
1.5 |
ENDDO |
| 119 |
atn |
1.8 |
plumek(i) = max(zero,S/So) |
| 120 |
mlosch |
1.5 |
#endif /* TARGET_NEC_SX */ |
| 121 |
|
|
|
| 122 |
|
|
ELSEIF (PlumeMethod .EQ. 2) THEN !exponential distribution |
| 123 |
|
|
dd = abs(SPDepth(i)) |
| 124 |
atn |
1.8 |
S = exp(facz/dd)-one |
| 125 |
|
|
So = recip_expOneM1 !So = exp(one)-one |
| 126 |
|
|
plumek(i) = max(zero,S*So) |
| 127 |
mlosch |
1.5 |
|
| 128 |
jmc |
1.10 |
C PlumeMethod = 3, distribute salt LINEARLY between SPDepth and |
| 129 |
mlosch |
1.5 |
C SPDepth/SPovershoot |
| 130 |
atn |
1.8 |
C (1-SPovershoot)percent has already been taken into account in |
| 131 |
|
|
C SPDepth calculation, i.e., SPDepth = SPovershoot*SPDepth. |
| 132 |
mlosch |
1.5 |
ELSEIF (PlumeMethod .EQ. 3) THEN !overshoot 20% |
| 133 |
|
|
dd20 = (abs(SPDepth(i))) |
| 134 |
|
|
dd = dd20/SPovershoot |
| 135 |
atn |
1.8 |
So=dd20-dd |
| 136 |
|
|
S =facz-dd |
| 137 |
mlosch |
1.5 |
IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN |
| 138 |
atn |
1.8 |
plumek(i) = max(zero,S/So) |
| 139 |
mlosch |
1.5 |
ELSE |
| 140 |
atn |
1.8 |
plumek(i) = zero |
| 141 |
mlosch |
1.5 |
ENDIF |
| 142 |
atn |
1.8 |
|
| 143 |
atn |
1.4 |
C PlumeMethod = 5, dumping all salt at the top layer |
| 144 |
mlosch |
1.5 |
ELSEIF (PlumeMethod .EQ. 5) THEN |
| 145 |
atn |
1.8 |
dd = zero |
| 146 |
mlosch |
1.5 |
dd20 = one |
| 147 |
|
|
IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN |
| 148 |
jmc |
1.10 |
plumek(i) = zero |
| 149 |
mlosch |
1.5 |
ELSE |
| 150 |
atn |
1.8 |
plumek(i) = one |
| 151 |
mlosch |
1.5 |
ENDIF |
| 152 |
|
|
ELSEIF (PlumeMethod .EQ. 6) THEN |
| 153 |
atn |
1.4 |
C PLumeMethod = 6, currently only works for Npower = 1 and 2. |
| 154 |
mlosch |
1.5 |
dd20 = (abs(SPDepth(i))) |
| 155 |
|
|
#ifdef TARGET_NEC_SX |
| 156 |
atn |
1.8 |
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 |
heimbach |
1.9 |
IF (Npowerloc .GT. 0) S = S*S**Npowerloc |
| 160 |
atn |
1.8 |
So = 1. _d 0/dd20 |
| 161 |
dimitri |
1.1 |
ELSE |
| 162 |
atn |
1.8 |
S = zero |
| 163 |
|
|
So = zero |
| 164 |
mlosch |
1.5 |
ENDIF |
| 165 |
heimbach |
1.9 |
IF(Npowerloc.EQ.1) THEN !Npower=1 |
| 166 |
atn |
1.8 |
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 |
dimitri |
1.1 |
ENDIF |
| 171 |
mlosch |
1.5 |
#else |
| 172 |
atn |
1.8 |
S = one !input depth temp |
| 173 |
|
|
So = one |
| 174 |
heimbach |
1.9 |
DO kk=1,Npowerloc+1 |
| 175 |
atn |
1.8 |
S = facz*S !raise to the Npower+1 |
| 176 |
|
|
So = dd20*So |
| 177 |
mlosch |
1.5 |
ENDDO |
| 178 |
heimbach |
1.9 |
IF(Npowerloc.EQ.1) THEN !Npower=1 |
| 179 |
atn |
1.8 |
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 |
mlosch |
1.5 |
ENDIF |
| 184 |
|
|
#endif /* TARGET_NEC_SX */ |
| 185 |
jmc |
1.10 |
|
| 186 |
atn |
1.8 |
catn: 15.Mar.2014 |
| 187 |
|
|
catn: this is a new method by atn. After fixing adjoint compiling error, |
| 188 |
jmc |
1.10 |
catn: will switch this on. Currently commenting out for purpose of |
| 189 |
atn |
1.8 |
catn: comparing old (1-abc) vs new (abc) way of coding |
| 190 |
jmc |
1.10 |
c ELSEIF (PlumeMethod .EQ. 7) THEN |
| 191 |
atn |
1.8 |
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 |
jmc |
1.10 |
ELSE |
| 211 |
|
|
plumek(i) = one |
| 212 |
mlosch |
1.5 |
#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 |
atn |
1.8 |
plumek(i) = one |
| 220 |
mlosch |
1.5 |
ENDIF |
| 221 |
dimitri |
1.1 |
ENDDO |
| 222 |
jmc |
1.10 |
|
| 223 |
dimitri |
1.2 |
#endif /* ALLOW_SALT_PLUME */ |
| 224 |
|
|
|
| 225 |
dimitri |
1.1 |
RETURN |
| 226 |
|
|
END |
Parent Directory
| 
Revision Log
| 
Revision Graph