1 |
jscott |
1.1 |
|
2 |
|
|
#include "ctrparam.h" |
3 |
|
|
|
4 |
|
|
SUBROUTINE SDRAG(WLMMAX,JWLMMAX) 7801. |
5 |
|
|
C**** 7802. |
6 |
|
|
C**** THIS SUBROUTINE PUTS A DRAG ON THE WINDS ON THE TOP LAYER OF 7803. |
7 |
|
|
C**** THE ATMOSPHERE 7804. |
8 |
|
|
C**** 7805. |
9 |
|
|
#include "BD2G04.COM" 7806. |
10 |
|
|
|
11 |
|
|
COMMON U,V,T,P,Q 7807. |
12 |
|
|
COMMON/WORK1/CONV(IM0,JM0,LM0),PK(IM0,JM0,LM0) 7808. |
13 |
|
|
real TAUJ(JM0+1) |
14 |
|
|
DO 100 J=2,JM 7809. |
15 |
|
|
I=IM 7810. |
16 |
|
|
DO 100 IP1=1,IM 7811. |
17 |
|
|
SP=.25*(P(I,J-1)+P(IP1,J-1)+P(I,J)+P(IP1,J)) 7812. |
18 |
|
|
WLM=SQRT(U(I,J,LM)*U(I,J,LM)+V(I,J,LM)*V(I,J,LM)) 7813. |
19 |
|
|
if(WLM.gt.WLMMAX)then |
20 |
|
|
WLMMAX=WLM |
21 |
|
|
JWLMMAX=J |
22 |
|
|
endif |
23 |
|
|
RHO=PTOP/(RGAS*T(I,J,LM)*PK(I,J,LM)) 7814. |
24 |
|
|
CDN=DUMMY1(1)+DUMMY1(2)*WLM 7815. |
25 |
|
|
TAUJ(J)=CDN*100.*RHO*WLM*U(I,J,LM) |
26 |
|
|
X=NDYN*DT*RHO*CDN*WLM*GRAV/(SP*DSIG(LM)) 7816. |
27 |
|
|
U(I,J,LM)=U(I,J,LM)*(1.-X) 7817. |
28 |
|
|
V(I,J,LM)=V(I,J,LM)*(1.-X) 7818. |
29 |
|
|
100 I=IP1 7819. |
30 |
|
|
C**** 5973. |
31 |
|
|
TAUJ(1)=TAUJ(2) |
32 |
|
|
TAUJ(JM+1)=TAUJ(JM) |
33 |
|
|
do J=1,JM |
34 |
|
|
PLAND=FDATA(I,J,2) 5974. |
35 |
|
|
PWATER=1.-PLAND 5975. |
36 |
|
|
PLICE=FDATA(I,J,3)*PLAND 5976. |
37 |
|
|
PEARTH=PLAND-PLICE 5977. |
38 |
|
|
POICE=ODATA(I,J,2)*PWATER 5978. |
39 |
|
|
POCEAN=PWATER-POICE 5979. |
40 |
|
|
if(POCEAN.LE.1.E-5)then |
41 |
|
|
POCEAN=0. |
42 |
|
|
POICE=PWATER |
43 |
|
|
endif |
44 |
|
|
TTOFR=PEARTH+PLICE+POICE+POCEAN |
45 |
|
|
if(abs(TTOFR-1.).gt.1.e-3)then |
46 |
|
|
print *,'From sdrag TTOFR=',TTOFR |
47 |
|
|
print *,' J=',J,' PLAND=',PLAND,' POCEAN=',POCEAN |
48 |
|
|
print *,' I=',I,' PWATER=',PWATER,' POICE=',POICE |
49 |
|
|
print *, 'ODATA(I,J,2)=',ODATA(I,J,2) |
50 |
|
|
stop |
51 |
|
|
end if |
52 |
|
|
C Fric |
53 |
|
|
AJ(J,38)=AJ(J,38)+(TAUJ(j)+TAUJ(j+1))*POCEAN |
54 |
|
|
BJ(J,38)=BJ(J,38)+(TAUJ(j)+TAUJ(j+1))*PLAND |
55 |
|
|
CJ(J,38)=CJ(J,38)+(TAUJ(j)+TAUJ(j+1))*POICE |
56 |
|
|
enddo |
57 |
|
|
C Fric |
58 |
|
|
RETURN 7820. |
59 |
|
|
END 7821. |