File indexing completed on 2019-05-01 05:10:52 UTC
view on githubraw file Latest commit f2a88c9f on 2019-04-30 15:14:20 UTC
e4775240e5 Dimi*0001 #include "SALT_PLUME_OPTIONS.h"
6172345053 Dimi*0002
0003
e4775240e5 Dimi*0004
6172345053 Dimi*0005
e4775240e5 Dimi*0006 SUBROUTINE SALT_PLUME_FRAC(
6172345053 Dimi*0007 I imax, fact,SPDepth,
1f89baba18 Patr*0008 #ifdef SALT_PLUME_SPLIT_BASIN
0009 I lon,lat,
0010 #endif
6172345053 Dimi*0011 U plumek,
0012 I myTime, myIter, myThid )
762bde3a3e Dimi*0013
6172345053 Dimi*0014
0015
e4775240e5 Dimi*0016
6172345053 Dimi*0017
0018
0019
0020
0021
0022
0023
364f5b7e62 An T*0024
50209c7a98 Jean*0025
6172345053 Dimi*0026
0027
0028
0029
0030
364f5b7e62 An T*0031
50209c7a98 Jean*0032
364f5b7e62 An T*0033
0034
0035
6172345053 Dimi*0036
0037
0038
0039
0040 IMPLICIT NONE
824966555a Dimi*0041 #include "SIZE.h"
0042 #include "SALT_PLUME.h"
6172345053 Dimi*0043
0044
0045
0046
0047
0048
0049
0050
0051
0052 INTEGER imax
0053 _RL fact
0054 _RL myTime
0055 INTEGER myIter
0056 INTEGER myThid
0057
0058
0059
0060
0061 _RL plumek(imax), SPDepth(imax)
1f89baba18 Patr*0062 #ifdef SALT_PLUME_SPLIT_BASIN
0063 _RL lon(imax), lat(imax)
0064 #endif
762bde3a3e Dimi*0065
0066
0067 #ifdef ALLOW_SALT_PLUME
6172345053 Dimi*0068
824966555a Dimi*0069 _RL facz, dd, dd20
1f89baba18 Patr*0070 INTEGER i, Npowerloc
f2a88c9ff8 jm-c 0071
364f5b7e62 An T*0072 _RL one, two, three, S, So, zero
5968a91b01 An T*0073 parameter( one = 1. _d 0, two = 2. _d 0, three = 3. _d 0 )
364f5b7e62 An T*0074 parameter( zero = 0. _d 0 )
6d26a6f379 Mart*0075
0076 _RL recip_expOneM1
0077 parameter( recip_expOneM1 = 0.581976706869326343 )
6172345053 Dimi*0078
0079 DO i = 1,imax
54ce47f4c7 Mart*0080 facz = abs(fact*plumek(i))
1f89baba18 Patr*0081 #ifdef SALT_PLUME_SPLIT_BASIN
0082 IF(SaltPlumeSplitBasin) THEN
0083 Npowerloc = Npower(2)
0084 IF(lat(imax).LT. 85.0 .AND. lat(imax).GT. 71.0
0085 & .AND. lon(imax) .LT. -90.0) Npowerloc = Npower(1)
0086 ELSE
0087 Npowerloc = Npower(1)
0088 ENDIF
0089 #else
0090 Npowerloc = Npower
0091 #endif
364f5b7e62 An T*0092
0093 IF (SPDepth(i).GE.facz .and. SPDepth(i) .GT. zero) THEN
824966555a Dimi*0094
5968a91b01 An T*0095
54ce47f4c7 Mart*0096 IF (PlumeMethod .EQ. 1) THEN
0097 dd20 = (abs(SPDepth(i)))
f2a88c9ff8 jm-c 0098
0099
364f5b7e62 An T*0100 IF ( dd20 .GT. zero ) THEN
0101 S = (facz/dd20)
0102
1f89baba18 Patr*0103 IF (Npowerloc .GT. 0) S = S*S**Npowerloc
54ce47f4c7 Mart*0104 ELSE
364f5b7e62 An T*0105 S = zero
54ce47f4c7 Mart*0106 ENDIF
364f5b7e62 An T*0107 plumek(i) = max(zero,S)
f2a88c9ff8 jm-c 0108
0109
0110
0111
0112
0113
0114
0115
0116
5968a91b01 An T*0117
54ce47f4c7 Mart*0118 ELSEIF (PlumeMethod .EQ. 2) THEN
0119 dd = abs(SPDepth(i))
364f5b7e62 An T*0120 S = exp(facz/dd)-one
0121 So = recip_expOneM1
0122 plumek(i) = max(zero,S*So)
5968a91b01 An T*0123
50209c7a98 Jean*0124
54ce47f4c7 Mart*0125
364f5b7e62 An T*0126
0127
54ce47f4c7 Mart*0128 ELSEIF (PlumeMethod .EQ. 3) THEN
0129 dd20 = (abs(SPDepth(i)))
0130 dd = dd20/SPovershoot
364f5b7e62 An T*0131 So=dd20-dd
0132 S =facz-dd
54ce47f4c7 Mart*0133 IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN
364f5b7e62 An T*0134 plumek(i) = max(zero,S/So)
54ce47f4c7 Mart*0135 ELSE
364f5b7e62 An T*0136 plumek(i) = zero
54ce47f4c7 Mart*0137 ENDIF
364f5b7e62 An T*0138
5968a91b01 An T*0139
54ce47f4c7 Mart*0140 ELSEIF (PlumeMethod .EQ. 5) THEN
364f5b7e62 An T*0141 dd = zero
54ce47f4c7 Mart*0142 dd20 = one
0143 IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN
50209c7a98 Jean*0144 plumek(i) = zero
54ce47f4c7 Mart*0145 ELSE
364f5b7e62 An T*0146 plumek(i) = one
54ce47f4c7 Mart*0147 ENDIF
0148 ELSEIF (PlumeMethod .EQ. 6) THEN
5968a91b01 An T*0149
54ce47f4c7 Mart*0150 dd20 = (abs(SPDepth(i)))
f2a88c9ff8 jm-c 0151
0152
364f5b7e62 An T*0153 IF ( dd20 .GT. zero ) THEN
0154 S = (facz/dd20)
0155
1f89baba18 Patr*0156 IF (Npowerloc .GT. 0) S = S*S**Npowerloc
364f5b7e62 An T*0157 So = 1. _d 0/dd20
6172345053 Dimi*0158 ELSE
364f5b7e62 An T*0159 S = zero
0160 So = zero
54ce47f4c7 Mart*0161 ENDIF
1f89baba18 Patr*0162 IF(Npowerloc.EQ.1) THEN
364f5b7e62 An T*0163 plumek(i) = max(zero,two*So*facz-S)
0164 ELSE
0165 plumek(i) = max(zero,
0166 & three*So*facz - three*So*So*facz*facz + S)
6172345053 Dimi*0167 ENDIF
f2a88c9ff8 jm-c 0168
0169
0170
0171
0172
0173
0174
0175
0176
0177
0178
0179
0180
0181
50209c7a98 Jean*0182
364f5b7e62 An T*0183
0184
50209c7a98 Jean*0185
364f5b7e62 An T*0186
50209c7a98 Jean*0187
364f5b7e62 An T*0188
0189
0190
0191
0192
0193
0194
0195
0196
0197
0198
0199
0200
0201
0202
0203
0204
0205
0206
54ce47f4c7 Mart*0207 ELSE
50209c7a98 Jean*0208 plumek(i) = one
0209 #ifndef TARGET_NEC_SX
54ce47f4c7 Mart*0210 WRITE(*,*) 'salt_plume_frac: PLumeMethod =', PLumeMethod,
0211 & 'not implemented'
0212 STOP 'ABNORMAL in S/R SALT_PLUME_FRAC'
0213 #endif /* not TARGET_NEC_SX */
0214 ENDIF
0215 ELSE
364f5b7e62 An T*0216 plumek(i) = one
54ce47f4c7 Mart*0217 ENDIF
6172345053 Dimi*0218 ENDDO
50209c7a98 Jean*0219
762bde3a3e Dimi*0220 #endif /* ALLOW_SALT_PLUME */
0221
6172345053 Dimi*0222 RETURN
0223 END