-
Notifications
You must be signed in to change notification settings - Fork 0
/
CALBUOY.for
143 lines (142 loc) · 4.26 KB
/
CALBUOY.for
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
SUBROUTINE CALBUOY
C
C CHANGE RECORD
C ** CALBUOY CALCULATES THE BUOYANCY USING MELLOR'S APPROXIMATION
C ** TO THE UNESCO EQUATION OF STATE (MELLOR, G.L., J. ATM AND OCEAN
C ** TECH, VOL 8, P 609)
C
USE GLOBAL
IMPLICIT NONE
INTEGER::NS,K,L
REAL::RHOO,SSTMP,TTMP,RHTMP,PRES,CCON,TMP,TEM0
C
IF(IBSC.EQ.1) GOTO 1000
ISPCOR=0
C
C ** DENSITY RHOO AT P=0, S=0, AND T=TEMO
C
TEM0 = ABS(TEMO)
RHOO=999.842594+6.793952E-2*TEM0-9.095290E-3*TEM0*TEM0
& +1.001685E-4*TEM0*TEM0*TEM0-1.120083E-6*TEM0*TEM0*TEM0*TEM0
& +6.536332E-9*TEM0*TEM0*TEM0*TEM0*TEM0
IF(ISTRAN(1).EQ.0.AND.ISTRAN(2).EQ.0)THEN
DO K=1,KC
DO L=2,LA
B(L,K)=RHOO
ENDDO
ENDDO
ENDIF
IF(ISTRAN(1).GE.1.AND.ISTRAN(2).EQ.0)THEN
DO K=1,KC
DO L=2,LA
SAL(L,K)=MAX(SAL(L,K),0.)
SSTMP=SAL(L,K)
TEM0=ABS(TEMO)
B(L,K)=RHOO+SSTMP*(0.824493-4.0899E-3*TEM0+7.6438E-5*TEM0*TEM0
& -8.2467E-7*TEM0*TEM0*TEM0+5.3875E-9*TEM0*TEM0*TEM0*TEM0)
& +SQRT(SSTMP)*SSTMP*(-5.72466E-3+1.0227E-4*TEM0
& -1.6546E-6*TEM0*TEM0)+4.8314E-4*SSTMP*SSTMP
ENDDO
ENDDO
ENDIF
IF(ISTRAN(1).EQ.0.AND.ISTRAN(2).GE.1)THEN
DO K=1,KC
DO L=2,LA
TTMP=TEM(L,K)
B(L,K)=999.842594+6.793952E-2*TTMP-9.095290E-3*TTMP*TTMP
& +1.001685E-4*TTMP*TTMP*TTMP-1.120083E-6*TTMP*TTMP*
& TTMP*TTMP+6.536332E-9*TTMP*TTMP*TTMP*TTMP*TTMP
ENDDO
ENDDO
ENDIF
IF(ISTRAN(1).GE.1.AND.ISTRAN(2).GE.1)THEN
DO K=1,KC
DO L=2,LA
SAL(L,K)=MAX(SAL(L,K),0.)
SSTMP=SAL(L,K)
TTMP=TEM(L,K)
RHTMP=999.842594+6.793952E-2*TTMP-9.095290E-3*TTMP*TTMP
& +1.001685E-4*TTMP*TTMP*TTMP-1.120083E-6*TTMP*TTMP*
& TTMP*TTMP+6.536332E-9*TTMP*TTMP*TTMP*TTMP*TTMP
B(L,K)=RHTMP+SSTMP*(0.824493-4.0899E-3*TTMP+7.6438E-5*
& TTMP*TTMP-8.2467E-7*TTMP*TTMP*TTMP+5.3875E-9*TTMP*TTMP*TTMP*TTMP)
& +SQRT(SSTMP)*SSTMP*(-5.72466E-3+1.0227E-4*TTMP
& -1.6546E-6*TTMP*TTMP)+4.8314E-4*SSTMP*SSTMP
ENDDO
ENDDO
ENDIF
C
C ** APPLY MELLOR'S PRESSURE CORRECTION
C
IF(ISPCOR.EQ.1)THEN
DO K=1,KC
DO L=2,LA
PRES=RHOO*G*HP(L)*(1.-ZZ(K))*1.E-6
CCON=1449.2+1.34*(SAL(L,K)-35.)+4.55*TEM(L,K)
& -0.045*TEM(L,K)*TEM(L,K)+0.00821*PRES+15.E-9*PRES*PRES
TMP=PRES/(CCON*CCON)
B(L,K)=B(L,K)+1.E+4*TMP*(1.-0.2*TMP)
ENDDO
ENDDO
ENDIF
C
C ** REPLACE DENSITY B(L,K) WITH BUOYANCY B(L,K)
C
DO K=1,KC
DO L=2,LA
B(L,K)=(B(L,K)/RHOO)-1.
ENDDO
ENDDO
C
C ** APPLY LOW SEDIMENT CONCENTRATION CORRECTION TO BUOYANCY
C
IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN
DO K=1,KC
DO L=2,LA
TVAR1S(L,K)=0.
TVAR1W(L,K)=0.
ENDDO
ENDDO
ENDIF
IF(ISTRAN(6).GE.1)THEN
DO NS=1,NSED
DO K=1,KC
DO L=2,LA
TVAR1S(L,K)=TVAR1S(L,K)+SDEN(NS)*SED(L,K,NS)
TVAR1W(L,K)=TVAR1W(L,K)+(SSG(NS)-1.)*SDEN(NS)*SED(L,K,NS)
ENDDO
ENDDO
ENDDO
ENDIF
IF(ISTRAN(7).GE.1)THEN
DO NN=1,NSND
NS=NN+NSED
DO K=1,KC
DO L=2,LA
TVAR1S(L,K)=TVAR1S(L,K)+SDEN(NS)*SND(L,K,NN)
TVAR1W(L,K)=TVAR1W(L,K)+(SSG(NS)-1.)*SDEN(NS)*SND(L,K,NN)
ENDDO
ENDDO
ENDDO
ENDIF
IF(ISTRAN(6).GE.1.OR.ISTRAN(7).GE.1)THEN
DO K=1,KC
DO L=2,LA
B(L,K)=B(L,K)*(1.-TVAR1S(L,K))+TVAR1W(L,K)
ENDDO
ENDDO
ENDIF
GOTO 2000
C
C DENSITY AS A LINEAR FUNCTION OF SALINITY ONLY. FOR DIAGNOSTIC
C PURPOSES ONLY
C
1000 CONTINUE
DO K=1,KC
DO L=2,LA
B(L,K)=0.00075*SAL(L,K)
ENDDO
ENDDO
2000 CONTINUE
RETURN
END