2 |
C$Name$ |
C$Name$ |
3 |
|
|
4 |
#include "CPP_OPTIONS.h" |
#include "CPP_OPTIONS.h" |
5 |
C |
|
6 |
C This file contains routines that compute quantities related to |
C-- File seawater.F: routines that compute quantities related to seawater. |
7 |
C seawater: |
C-- Contents |
8 |
C find_rho_scalar: in-situ density for individual points |
C-- o FIND_RHO_SCALAR: in-situ density for individual points |
9 |
C sw_ptmp: function to compute potential temperature |
C-- o SW_PTMP: function to compute potential temperature |
10 |
C sw_adtg: function to compute adiabatic tmperature gradient |
C-- o SW_TEMP: function to compute potential temperature |
11 |
C used by sw_ptmp |
C-- o SW_ADTG: function to compute adiabatic tmperature gradient |
12 |
C |
C-- used by sw_ptmp |
13 |
SUBROUTINE FIND_RHO_SCALAR( |
|
14 |
|
SUBROUTINE FIND_RHO_SCALAR( |
15 |
I tLoc, sLoc, pLoc, |
I tLoc, sLoc, pLoc, |
16 |
O rhoLoc, |
O rhoLoc, |
17 |
I myThid ) |
I myThid ) |
18 |
|
|
19 |
C !DESCRIPTION: \bv |
C !DESCRIPTION: \bv |
20 |
C *==========================================================* |
C *==========================================================* |
21 |
C | o SUBROUTINE FIND_RHO_SCALAR |
C | o SUBROUTINE FIND_RHO_SCALAR |
22 |
C | Calculates [rho(S,T,p)-rhoConst] |
C | Calculates [rho(S,T,p)-rhoConst] |
23 |
C *==========================================================* |
C *==========================================================* |
24 |
C \ev |
C \ev |
25 |
|
|
65 |
t2 = t1*t1 |
t2 = t1*t1 |
66 |
t3 = t2*t1 |
t3 = t2*t1 |
67 |
t4 = t3*t1 |
t4 = t3*t1 |
68 |
|
|
69 |
s1 = sLoc |
s1 = sLoc |
70 |
IF ( s1 .LT. 0. _d 0 ) THEN |
IF ( s1 .LT. 0. _d 0 ) THEN |
71 |
C issue a warning |
C issue a warning |
72 |
WRITE(msgBuf,'(A,E13.5)') |
WRITE(msgBuf,'(A,E13.5)') |
73 |
& ' FIND_RHO_SCALAR: WARNING, salinity = ', s1 |
& ' FIND_RHO_SCALAR: WARNING, salinity = ', s1 |
74 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
75 |
& SQUEEZE_RIGHT , myThid ) |
& SQUEEZE_RIGHT , myThid ) |
88 |
|
|
89 |
C this is not correct, there is a field eosSig0 which should be use here |
C this is not correct, there is a field eosSig0 which should be use here |
90 |
C but I DO not intent to include the reference level in this routine |
C but I DO not intent to include the reference level in this routine |
91 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
92 |
& ' FIND_RHO_SCALAR: for POLY3, the density is not' |
& ' FIND_RHO_SCALAR: for POLY3, the density is not' |
93 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
94 |
& SQUEEZE_RIGHT , myThid ) |
& SQUEEZE_RIGHT , myThid ) |
95 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
96 |
& ' computed correctly in this routine' |
& ' computed correctly in this routine' |
97 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
98 |
& SQUEEZE_RIGHT , myThid ) |
& SQUEEZE_RIGHT , myThid ) |
103 |
C nonlinear equation of state in pressure coordinates |
C nonlinear equation of state in pressure coordinates |
104 |
|
|
105 |
s3o2 = s1*SQRT(s1) |
s3o2 = s1*SQRT(s1) |
106 |
|
|
107 |
p1 = pLoc*SItoBar |
p1 = pLoc*SItoBar |
108 |
p2 = p1*p1 |
p2 = p1*p1 |
109 |
|
|
110 |
C density of freshwater at the surface |
C density of freshwater at the surface |
111 |
rfresh = |
rfresh = |
112 |
& eosJMDCFw(1) |
& eosJMDCFw(1) |
113 |
& + eosJMDCFw(2)*t1 |
& + eosJMDCFw(2)*t1 |
114 |
& + eosJMDCFw(3)*t2 |
& + eosJMDCFw(3)*t2 |
115 |
& + eosJMDCFw(4)*t3 |
& + eosJMDCFw(4)*t3 |
116 |
& + eosJMDCFw(5)*t4 |
& + eosJMDCFw(5)*t4 |
117 |
& + eosJMDCFw(6)*t4*t1 |
& + eosJMDCFw(6)*t4*t1 |
118 |
C density of sea water at the surface |
C density of sea water at the surface |
119 |
rsalt = |
rsalt = |
120 |
& s1*( |
& s1*( |
121 |
& eosJMDCSw(1) |
& eosJMDCSw(1) |
122 |
& + eosJMDCSw(2)*t1 |
& + eosJMDCSw(2)*t1 |
134 |
rhoP0 = rfresh + rsalt |
rhoP0 = rfresh + rsalt |
135 |
|
|
136 |
C secant bulk modulus of fresh water at the surface |
C secant bulk modulus of fresh water at the surface |
137 |
bMfresh = |
bMfresh = |
138 |
& eosJMDCKFw(1) |
& eosJMDCKFw(1) |
139 |
& + eosJMDCKFw(2)*t1 |
& + eosJMDCKFw(2)*t1 |
140 |
& + eosJMDCKFw(3)*t2 |
& + eosJMDCKFw(3)*t2 |
152 |
& + eosJMDCKSw(7)*t2 |
& + eosJMDCKSw(7)*t2 |
153 |
& ) |
& ) |
154 |
C secant bulk modulus of sea water at pressure p |
C secant bulk modulus of sea water at pressure p |
155 |
bMpres = |
bMpres = |
156 |
& p1*( eosJMDCKP(1) |
& p1*( eosJMDCKP(1) |
157 |
& + eosJMDCKP(2)*t1 |
& + eosJMDCKP(2)*t1 |
158 |
& + eosJMDCKP(3)*t2 |
& + eosJMDCKP(3)*t2 |
173 |
& ) |
& ) |
174 |
|
|
175 |
bulkMod = bMfresh + bMsalt + bMpres |
bulkMod = bMfresh + bMsalt + bMpres |
176 |
|
|
177 |
C density of sea water at pressure p |
C density of sea water at pressure p |
178 |
rhoLoc = rhoP0/(1. _d 0 - p1/bulkMod) - rhoConst |
rhoLoc = rhoP0/(1. _d 0 - p1/bulkMod) - rhoConst |
179 |
|
|
180 |
ELSEIF ( equationOfState.EQ.'MDJWF' ) THEN |
ELSEIF ( equationOfState.EQ.'MDJWF' ) THEN |
181 |
|
|
182 |
sp5 = SQRT(s1) |
sp5 = SQRT(s1) |
183 |
|
|
184 |
p1 = pLoc*SItodBar |
p1 = pLoc*SItodBar |
185 |
p1t1 = p1*t1 |
p1t1 = p1*t1 |
186 |
|
|
187 |
rhoNum = eosMDJWFnum(0) |
rhoNum = eosMDJWFnum(0) |
188 |
& + t1*(eosMDJWFnum(1) |
& + t1*(eosMDJWFnum(1) |
189 |
& + t1*(eosMDJWFnum(2) + eosMDJWFnum(3)*t1) ) |
& + t1*(eosMDJWFnum(2) + eosMDJWFnum(3)*t1) ) |
190 |
& + s1*(eosMDJWFnum(4) |
& + s1*(eosMDJWFnum(4) |
191 |
& + eosMDJWFnum(5)*t1 + eosMDJWFnum(6)*s1) |
& + eosMDJWFnum(5)*t1 + eosMDJWFnum(6)*s1) |
192 |
& + p1*(eosMDJWFnum(7) + eosMDJWFnum(8)*t2 |
& + p1*(eosMDJWFnum(7) + eosMDJWFnum(8)*t2 |
193 |
& + eosMDJWFnum(9)*s1 |
& + eosMDJWFnum(9)*s1 |
194 |
& + p1*(eosMDJWFnum(10) + eosMDJWFnum(11)*t2) ) |
& + p1*(eosMDJWFnum(10) + eosMDJWFnum(11)*t2) ) |
195 |
|
|
196 |
|
|
197 |
den = eosMDJWFden(0) |
den = eosMDJWFden(0) |
198 |
& + t1*(eosMDJWFden(1) |
& + t1*(eosMDJWFden(1) |
199 |
& + t1*(eosMDJWFden(2) |
& + t1*(eosMDJWFden(2) |
200 |
& + t1*(eosMDJWFden(3) + t1*eosMDJWFden(4) ) ) ) |
& + t1*(eosMDJWFden(3) + t1*eosMDJWFden(4) ) ) ) |
201 |
& + s1*(eosMDJWFden(5) |
& + s1*(eosMDJWFden(5) |
202 |
& + t1*(eosMDJWFden(6) |
& + t1*(eosMDJWFden(6) |
203 |
& + eosMDJWFden(7)*t2) |
& + eosMDJWFden(7)*t2) |
204 |
& + sp5*(eosMDJWFden(8) + eosMDJWFden(9)*t2) ) |
& + sp5*(eosMDJWFden(8) + eosMDJWFden(9)*t2) ) |
205 |
& + p1*(eosMDJWFden(10) |
& + p1*(eosMDJWFden(10) |
206 |
& + p1t1*(eosMDJWFden(11)*t2 + eosMDJWFden(12)*p1) ) |
& + p1t1*(eosMDJWFden(11)*t2 + eosMDJWFden(12)*p1) ) |
207 |
|
|
208 |
rhoDen = 1.0/(epsln+den) |
rhoDen = 1.0/(epsln+den) |
209 |
|
|
210 |
rhoLoc = rhoNum*rhoDen - rhoConst |
rhoLoc = rhoNum*rhoDen - rhoConst |
211 |
|
|
212 |
ELSEIF( equationOfState .EQ. 'IDEALG' ) THEN |
ELSEIF( equationOfState .EQ. 'IDEALG' ) THEN |
213 |
C |
C |
214 |
ELSE |
ELSE |
215 |
WRITE(msgBuf,'(3A)') |
WRITE(msgBuf,'(3A)') |
216 |
& ' FIND_RHO_SCALAR : equationOfState = "', |
& ' FIND_RHO_SCALAR : equationOfState = "', |
219 |
STOP 'ABNORMAL END: S/R FIND_RHO_SCALAR' |
STOP 'ABNORMAL END: S/R FIND_RHO_SCALAR' |
220 |
ENDIF |
ENDIF |
221 |
|
|
222 |
RETURN |
RETURN |
223 |
END |
END |
224 |
|
|
225 |
C================================================================= |
C================================================================= |
226 |
|
|
227 |
_RL function SW_PTMP (S,T,P,PR) |
_RL FUNCTION SW_PTMP (S,T,P,PR) |
228 |
|
|
229 |
c ================================================================== |
c ================================================================== |
230 |
c SUBROUTINE SW_PTMP |
c SUBROUTINE SW_PTMP |
288 |
C !DESCRIPTION: \bv |
C !DESCRIPTION: \bv |
289 |
C *=============================================================* |
C *=============================================================* |
290 |
C | S/R SW_TEMP |
C | S/R SW_TEMP |
291 |
C | o compute in-situ temperature from potential temperature |
C | o compute in-situ temperature from potential temperature |
292 |
C *=============================================================* |
C *=============================================================* |
293 |
C |
C |
294 |
C REFERENCES: |
C REFERENCES: |
296 |
C Unesco 1983. Algorithms for computation of fundamental properties of |
C Unesco 1983. Algorithms for computation of fundamental properties of |
297 |
C seawater, 1983. _Unesco Tech. Pap. in Mar. Sci._, No. 44, 53 pp. |
C seawater, 1983. _Unesco Tech. Pap. in Mar. Sci._, No. 44, 53 pp. |
298 |
C Eqn.(31) p.39 |
C Eqn.(31) p.39 |
299 |
C |
C |
300 |
C Bryden, H. 1973. |
C Bryden, H. 1973. |
301 |
C "New Polynomials for thermal expansion, adiabatic temperature gradient |
C "New Polynomials for thermal expansion, adiabatic temperature gradient |
302 |
C and potential temperature of sea water." |
C and potential temperature of sea water." |
314 |
CML#include "DYNVARS.h" |
CML#include "DYNVARS.h" |
315 |
CML#include "FFIELDS.h" |
CML#include "FFIELDS.h" |
316 |
CML#include "SHELFICE.h" |
CML#include "SHELFICE.h" |
317 |
|
|
318 |
C !INPUT/OUTPUT PARAMETERS: |
C !INPUT/OUTPUT PARAMETERS: |
319 |
C === Routine arguments === |
C === Routine arguments === |
320 |
C s :: salinity |
C s :: salinity |
330 |
INTEGER myThid |
INTEGER myThid |
331 |
CEOP |
CEOP |
332 |
|
|
333 |
C !LOCAL VARIABLES |
C !LOCAL VARIABLES |
334 |
C === Local variables === |
C === Local variables === |
335 |
_RL del_P ,del_th, th, q |
_RL del_P ,del_th, th, q |
336 |
_RL onehalf, two, three |
_RL onehalf, two, three |
366 |
|
|
367 |
C====================================================================== |
C====================================================================== |
368 |
|
|
369 |
_RL function SW_ADTG (S,T,P) |
_RL FUNCTION SW_ADTG (S,T,P) |
370 |
|
|
371 |
c ================================================================== |
c ================================================================== |
372 |
c SUBROUTINE SW_ADTG |
c SUBROUTINE SW_ADTG |
412 |
& + (b0 + b1*T)*(S-sref) |
& + (b0 + b1*T)*(S-sref) |
413 |
& + ( (c0 + (c1 + (c2 + c3*T)*T)*T) + (d0 + d1*T)*(S-sref) )*P |
& + ( (c0 + (c1 + (c2 + c3*T)*T)*T) + (d0 + d1*T)*(S-sref) )*P |
414 |
& + ( e0 + (e1 + e2*T)*T )*P*P |
& + ( e0 + (e1 + e2*T)*T )*P*P |
415 |
|
return |
416 |
end |
end |