/[MITgcm]/MITgcm/model/src/seawater.F
ViewVC logotype

Diff of /MITgcm/model/src/seawater.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by mlosch, Wed Feb 27 19:42:02 2008 UTC revision 1.2 by jmc, Sat Aug 9 00:51:34 2008 UTC
# Line 2  C$Header$ Line 2  C$Header$
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    
# Line 64  CEOP Line 65  CEOP
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 )
# Line 87  c        rhoLoc = 0. _d  0 Line 88  c        rhoLoc = 0. _d  0
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 )
# Line 102  C     but I DO not intent to include the Line 103  C     but I DO not intent to include the
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
# Line 133  C     density of sea water at the surfac Line 134  C     density of sea water at the surfac
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
# Line 151  C     secant bulk modulus of sea water a Line 152  C     secant bulk modulus of sea water a
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
# Line 172  C     secant bulk modulus of sea water a Line 173  C     secant bulk modulus of sea water a
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 = "',
# Line 218  C Line 219  C
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
# Line 287  C     !INTERFACE: Line 288  C     !INTERFACE:
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:
# Line 295  C     Fofonoff, P. and Millard, R.C. Jr Line 296  C     Fofonoff, P. and Millard, R.C. Jr
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."
# Line 313  CML#include "GRID.h" Line 314  CML#include "GRID.h"
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
# Line 329  C     myThid :: thread number for this i Line 330  C     myThid :: thread number for this i
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
# Line 365  c theta4 Line 366  c theta4
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
# Line 411  c     ================================== Line 412  c     ==================================
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
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22