C**** C**** FUNTABLE.OCN Table functions of ocean parameters 10/09/91 C**** FUNCTION VOLGSP (G,S,P) C**** C**** VOLGSP returns a linearly interpolated specific volume from C**** an input table that depends on potential specific enthalpy, C**** salinity, and pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** P (Pa) = pressure above normal atmospheric pressure, C**** from 0 to 78.E6 C**** C**** Output: VOLGSP (m**3/kg) = specific volume of sea water C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S,P COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. PP = P*5d-7 ! /2.D6 IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 KP = PP IF(KP.LT. 0) KP = 0 IF(KP.GE.39) KP = 38 C**** VOLGSP = (KP-PP+1)*((JS-SS+1)*((IG-GG+1)*V(IG ,JS ,KP ) * + (GG-IG )*V(IG+1,JS ,KP )) * + (SS-JS )*((IG-GG+1)*V(IG ,JS+1,KP ) * + (GG-IG )*V(IG+1,JS+1,KP ))) * + (PP-KP )*((JS-SS+1)*((IG-GG+1)*V(IG ,JS ,KP+1) * + (GG-IG )*V(IG+1,JS ,KP+1)) * + (SS-JS )*((IG-GG+1)*V(IG ,JS+1,KP+1) * + (GG-IG )*V(IG+1,JS+1,KP+1))) RETURN END FUNCTION VOLGS (G,S) C**** C**** VOLGS returns a linearly interpolated specific volume from C**** an input table that depends on potential specific enthalpy C**** and salinity. Pressure is assumed to be the normal surface C**** ocean reference pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** C**** Output: VOLGS (m**3/kg) = specific volume of sea water C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 C**** VOLGS = (JS-SS+1)*((IG-GG+1)*V(IG ,JS ,0) * + (GG-IG )*V(IG+1,JS ,0)) * + (SS-JS )*((IG-GG+1)*V(IG ,JS+1,0) * + (GG-IG )*V(IG+1,JS+1,0)) RETURN END FUNCTION TEMGS (G,S) C**** C**** TEMGS returns a linearly interpolated temperature from an C**** input table that depends on potential specific enthalpy and C**** salinity. Pressure is assumed to be the normal surface C**** ocean reference pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** C**** Output: TEMGS (C) = temperature of sea water C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 C**** TEMGS = (JS-SS+1)*((IG-GG+1)*T(IG ,JS ,0) * + (GG-IG )*T(IG+1,JS ,0)) * + (SS-JS )*((IG-GG+1)*T(IG ,JS+1,0) * + (GG-IG )*T(IG+1,JS+1,0)) RETURN END FUNCTION SHCGS (G,S) C**** C**** SHCGS returns a linearly interpolated specific heat capacity C**** from an input table that depends on potential specific enthalpy C**** and salinity. Pressure is assumed to be the normal surface C**** ocean reference pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** C**** Output: SHCGS (J/kg*C) = specific heat capacity of sea water C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 C**** SHCGS = (JS-SS+1)*((IG-GG+1)*C(IG ,JS ) * + (GG-IG )*C(IG+1,JS )) * + (SS-JS )*((IG-GG+1)*C(IG ,JS+1) * + (GG-IG )*C(IG+1,JS+1)) RETURN END FUNCTION GFREZS (S) C**** C**** GFREZS returns a linearly interpolated frezzing point of C**** potential specific enthalpy that depends on salinity. Pressure C**** is assumed to be the normal surface ocean reference pressure. C**** C**** Input: S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** C**** Output: GFREZS (J/kg) = freezing point of potential specific C**** enthalpy C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) S REAL*8 F(0:40) DATA F / 0.000, * -232.482, -461.136, -688.288, -914.774, -1141.078, * -1367.530, -1594.374, -1821.798, -2049.957, -2278.978, * -2508.971, -2740.030, -2972.237, -3205.667, -3440.386, * -3676.454, -3913.926, -4152.851, -4393.287, -4635.259, * -4878.815, -5123.994, -5370.830, -5619.358, -5869.609, * -6121.615, -6375.402, -6631.001, -6888.436, -7147.733, * -7408.917, -7672.010, -7937.037, -8204.019, -8472.976, * -8743.931, -9016.917, -9291.927, -9568.992, -9848.131/ C**** SS = S*1000. JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 C**** GFREZS = (JS-SS+1)*F(JS) + (SS-JS)*F(JS+1) RETURN END FUNCTION TFREZS (SIN) C**** C**** TFREZS calculates the freezing temperature of sea water as a C**** function of salinity. C**** The reference for this function is: C**** N.P. Fofonoff and R.C. Millard Jr., 1983. Algorithms for C**** Computation of Fundamental Properties of Seawater. UNESCO C**** Technical Papers in Marine Science, volume 44. C**** C**** Input: SIN (1) = salinity (kg NaCl/kg sea water), from .004 to .04 C**** C**** Output: TFREZS (C) = freezing temperature of sea water C**** IMPLICIT REAL*8 (A-Z) INTENT(IN) SIN DATA A01/-.0575/, A02/-2.154996D-4/, A03/1.710523D-3/ S = SIN*1.D3 S32 = S*DSQRT(S) TFREZS = (A01 + A02*S)*S + A03*S32 RETURN END FUNCTION HETGSP (G,S,P) C**** C**** HETGSP returns a linearly interpolated specific enthalpy from C**** an input table that depends on potential specific enthalpy, C**** salinity, and pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** P (Pa) = pressure above normal atmospheric pressure, C**** from 0 to 78.E6 C**** C**** Output: HETGSP (J/kg) = specific enthalpy of sea water C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S,P COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. PP = P*5d-7 ! /2.D6 IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 KP = PP IF(KP.LT. 0) KP = 0 IF(KP.GE.39) KP = 38 C**** HETGSP = (KP-PP+1)*((JS-SS+1)*((IG-GG+1)*H(IG ,JS ,KP ) * + (GG-IG )*H(IG+1,JS ,KP )) * + (SS-JS )*((IG-GG+1)*H(IG ,JS+1,KP ) * + (GG-IG )*H(IG+1,JS+1,KP ))) * + (PP-KP )*((JS-SS+1)*((IG-GG+1)*H(IG ,JS ,KP+1) * + (GG-IG )*H(IG+1,JS ,KP+1)) * + (SS-JS )*((IG-GG+1)*H(IG ,JS+1,KP+1) * + (GG-IG )*H(IG+1,JS+1,KP+1))) RETURN END DOUBLE PRECISION FUNCTION ALPHAGSP (G,S,P) C**** C**** ALPHAGSP returns a linearly interpolated thermal expansion C**** coefficient from an input table that depends on potential C**** specific enthalpy, salinity, and pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** P (Pa) = pressure above normal atmospheric pressure, C**** from 0 to 78.E6 C**** C**** Output: ALPHAGSP (kg/m**3/C) = thermal expansion coefficient C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S,P COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. PP = P*5d-7 ! /2.D6 IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 KP = PP IF(KP.LT. 0) KP = 0 IF(KP.GE.39) KP = 38 C**** ALPHAGSP=(KP-PP+1)*((JS-SS+1)*((IG-GG+1)*A(IG ,JS ,KP ) * + (GG-IG )*A(IG+1,JS ,KP )) * + (SS-JS )*((IG-GG+1)*A(IG ,JS+1,KP ) * + (GG-IG )*A(IG+1,JS+1,KP ))) * + (PP-KP )*((JS-SS+1)*((IG-GG+1)*A(IG ,JS ,KP+1) * + (GG-IG )*A(IG+1,JS ,KP+1)) * + (SS-JS )*((IG-GG+1)*A(IG ,JS+1,KP+1) * + (GG-IG )*A(IG+1,JS+1,KP+1))) RETURN END DOUBLE PRECISION FUNCTION BETAGSP (G,S,P) C**** C**** BETAGSP returns a linearly interpolated saline expansion C**** coefficient from an input table that depends on potential C**** specific enthalpy, salinity, and pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** P (Pa) = pressure above normal atmospheric pressure, C**** from 0 to 78.E6 C**** C**** Output: BETAGSP (kg/m**3/PSU) = saline expansion coefficient C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S,P COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. PP = P*5d-7 ! /2.D6 IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 KP = PP IF(KP.LT. 0) KP = 0 IF(KP.GE.39) KP = 38 C**** BETAGSP =(KP-PP+1)*((JS-SS+1)*((IG-GG+1)*B(IG ,JS ,KP ) * + (GG-IG )*B(IG+1,JS ,KP )) * + (SS-JS )*((IG-GG+1)*B(IG ,JS+1,KP ) * + (GG-IG )*B(IG+1,JS+1,KP ))) * + (PP-KP )*((JS-SS+1)*((IG-GG+1)*B(IG ,JS ,KP+1) * + (GG-IG )*B(IG+1,JS ,KP+1)) * + (SS-JS )*((IG-GG+1)*B(IG ,JS+1,KP+1) * + (GG-IG )*B(IG+1,JS+1,KP+1))) RETURN END FUNCTION TEMGSP (G,S,P) C**** C**** TEMGSP returns a linearly interpolated in situ temperature C**** from an input table that depends on potential C**** specific enthalpy, salinity, and pressure. C**** C**** Input: G (J/kg) = potential specific enthalpy, C**** from -8000 to 160000 C**** S (1) = salinity (kg NaCl/kg sea water), from 0 to .04 C**** P (Pa) = pressure above normal atmospheric pressure, C**** from 0 to 78.E6 C**** C**** Output: TEMGSP (C) = in situ temperature C**** IMPLICIT REAL*8 (A-H,M,O-Z) INTENT(IN) G,S,P COMMON /OFUNCB/ V(-2:40,0:40,0:39),T(-2:40,0:40,0:39),C(-2:40,0:40 * ),H(-2:40,0:40,0:39),A(-2:40,0:40,0:39),B(-2:40,0:40,0:39) C**** GG = G*2.5d-4 ! /4000. SS = S*1000. PP = P*5d-7 ! /2.D6 IG = INT(GG+2.) - 2 IF(IG.LT.-2) IG = -2 IF(IG.GE.40) IG = 39 JS = SS C IF(JS.LT. 0) JS = 0 IF(JS.GE.40) JS = 39 KP = PP IF(KP.LT. 0) KP = 0 IF(KP.GE.39) KP = 38 C**** TEMGSP = (KP-PP+1)*((JS-SS+1)*((IG-GG+1)*T(IG ,JS ,KP ) * + (GG-IG )*T(IG+1,JS ,KP )) * + (SS-JS )*((IG-GG+1)*T(IG ,JS+1,KP ) * + (GG-IG )*T(IG+1,JS+1,KP ))) * + (PP-KP )*((JS-SS+1)*((IG-GG+1)*T(IG ,JS ,KP+1) * + (GG-IG )*T(IG+1,JS ,KP+1)) * + (SS-JS )*((IG-GG+1)*T(IG ,JS+1,KP+1) * + (GG-IG )*T(IG+1,JS+1,KP+1))) RETURN END