/[MITgcm]/MITgcm_contrib/jscott/igsm/src/sdrag.F
ViewVC logotype

Contents of /MITgcm_contrib/jscott/igsm/src/sdrag.F

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


Revision 1.1 - (show annotations) (download)
Fri Aug 11 19:35:32 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
atm2d package

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.

  ViewVC Help
Powered by ViewVC 1.1.22