/[MITgcm]/MITgcm/pkg/seaice/ostres.F
ViewVC logotype

Contents of /MITgcm/pkg/seaice/ostres.F

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


Revision 1.18 - (show annotations) (download)
Thu Mar 16 14:41:20 2006 UTC (18 years, 1 month ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint60, checkpoint61, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint58r_post, checkpoint58n_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint61f, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint61e, checkpoint58i_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.17: +7 -5 lines
fix turning angles to work on both hemispheres

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/ostres.F,v 1.17 2006/03/06 13:17:37 mlosch Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5
6 CStartOfInterface
7 SUBROUTINE ostres( COR_ICE, myThid )
8 C /==========================================================\
9 C | SUBROUTINE ostres |
10 C | o Calculate ocean surface stress |
11 C |==========================================================|
12 C \==========================================================/
13 IMPLICIT NONE
14
15 C === Global variables ===
16 #include "SIZE.h"
17 #include "EEPARAMS.h"
18 #include "PARAMS.h"
19 #include "FFIELDS.h"
20 #include "SEAICE.h"
21 #include "SEAICE_PARAMS.h"
22
23 C === Routine arguments ===
24 C myThid - Thread no. that called this routine.
25 _RL COR_ICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
26 INTEGER myThid
27 CEndOfInterface
28
29 #ifndef SEAICE_CGRID
30 C === Local variables ===
31 C i,j,bi,bj - Loop counters
32
33 INTEGER i, j, bi, bj
34 _RL SINWIN, COSWIN, SINWAT, COSWAT
35 #ifdef SEAICE_TEST_ICE_STRESS_1
36 _RL fuIce, fvIce
37 #endif
38
39 c introduce turning angle (default is zero)
40 SINWIN=SIN(SEAICE_airTurnAngle*deg2rad)
41 COSWIN=COS(SEAICE_airTurnAngle*deg2rad)
42 SINWAT=SIN(SEAICE_waterTurnAngle*deg2rad)
43 COSWAT=COS(SEAICE_waterTurnAngle*deg2rad)
44
45 #ifdef SEAICE_ORIGINAL_BAD_ICE_STRESS
46 C-- Following formulation is problematic and is no longer used.
47 #ifdef SEAICE_ALLOW_DYNAMICS
48 IF ( SEAICEuseDYNAMICS ) THEN
49 C-- Compute ice-affected wind stress
50 DO bj=myByLo(myThid),myByHi(myThid)
51 DO bi=myBxLo(myThid),myBxHi(myThid)
52 DO j=1,sNy
53 DO i=1,sNx
54 WINDX(I,J,bi,bj)=DWATN(I,J,bi,bj)
55 & *(COSWAT*(GWATX(I,J,bi,bj)-UICE(I,J,1,bi,bj))
56 & -SIGN(SINWAT,COR_ICE(I,J,bi,bj))
57 & *(GWATY(I,J,bi,bj)-VICEC(I,J,bi,bj)))
58 WINDY(I,J,bi,bj)=DWATN(I,J,bi,bj)
59 & *(SIGN(SINWAT,COR_ICE(I,J,bi,bj))
60 & *(GWATX(I,J,bi,bj)-UICEC(I,J,bi,bj))
61 & +COSWAT*(GWATY(I,J,bi,bj)-VICE(I,J,1,bi,bj)))
62 WINDX(I,J,bi,bj)=WINDX(I,J,bi,bj)-( COR_ICE(I,J,bi,bj)
63 & *GWATY(I,J,bi,bj)-COR_ICE(I,J,bi,bj)*VICEC(I,J,bi,bj))
64 WINDY(I,J,bi,bj)=WINDY(I,J,bi,bj)-(-COR_ICE(I,J,bi,bj)
65 & *GWATX(I,J,bi,bj)+COR_ICE(I,J,bi,bj)*UICEC(I,J,bi,bj))
66 WINDX(I,J,bi,bj)=WINDX(I,J,bi,bj)-(UICE(I,J,1,bi,bj)
67 & -UICE(I,J,3,bi,bj))*AMASS(I,J,bi,bj)/SEAICE_DT*TWO
68 WINDY(I,J,bi,bj)=WINDY(I,J,bi,bj)-(VICE(I,J,1,bi,bj)
69 & -VICE(I,J,3,bi,bj))*AMASS(I,J,bi,bj)/SEAICE_DT*TWO
70 ENDDO
71 ENDDO
72 ENDDO
73 ENDDO
74 DO bj=myByLo(myThid),myByHi(myThid)
75 DO bi=myBxLo(myThid),myBxHi(myThid)
76 DO j=1,sNy
77 DO i=1,sNx
78 WINDX(I,J,bi,bj)=-WINDX(I,J,bi,bj)
79 WINDY(I,J,bi,bj)=-WINDY(I,J,bi,bj)
80 ENDDO
81 ENDDO
82 ENDDO
83 ENDDO
84 ENDIF
85 #endif /* SEAICE_ALLOW_DYNAMICS */
86 #endif /* SEAICE_ORIGINAL_BAD_ICE_STRESS */
87
88 C-- Update overlap regions
89 CALL EXCH_UV_XY_RL(WINDX, WINDY, .TRUE., myThid)
90
91 #ifndef SEAICE_EXTERNAL_FLUXES
92 C-- Interpolate wind stress (N/m^2) from South-West B-grid
93 C to South-West C-grid for forcing ocean model.
94 DO bj=myByLo(myThid),myByHi(myThid)
95 DO bi=myBxLo(myThid),myBxHi(myThid)
96 DO j=1,sNy
97 DO i=1,sNx
98 fu(I,J,bi,bj)=HALF
99 & *(WINDX(I,J+1,bi,bj)+WINDX(I,J,bi,bj))
100 fv(I,J,bi,bj)=HALF
101 & *(WINDY(I+1,J,bi,bj)+WINDY(I,J,bi,bj))
102 ENDDO
103 ENDDO
104 ENDDO
105 ENDDO
106 CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
107 #endif /* ifndef SEAICE_EXTERNAL_FLUXES */
108
109 #ifdef SEAICE_TEST_ICE_STRESS_1
110 C-- Compute ice-affected wind stress
111 DO bj=myByLo(myThid),myByHi(myThid)
112 DO bi=myBxLo(myThid),myBxHi(myThid)
113 DO j=1,sNy
114 DO i=1,sNx
115 fuIce=QUART*( DWATN(I,J,bi,bj)+DWATN(I,J+1,bi,bj) )*(
116 & COSWAT *
117 & ( UICE(I,J, 1,bi,bj)-GWATX(I,J, bi,bj)
118 & + UICE(I,J+1,1,bi,bj)-GWATX(I,J+1,bi,bj) )
119 & -SIGN(SINWAT,COR_ICE(I,J,bi,bj)) *
120 & ( VICE(I, J,1,bi,bj)-GWATY(I, J,bi,bj)
121 & + VICE(I+1,J,1,bi,bj)-GWATY(I+1,J,bi,bj) )
122 & )
123 fvIce=QUART*( DWATN(I,J,bi,bj)+DWATN(I+1,J,bi,bj) )*(
124 & SIGN(SINWAT,COR_ICE(I,J,bi,bj)) *
125 & ( UICE(I,J, 1,bi,bj)-GWATX(I,J, bi,bj)
126 & + UICE(I,J+1,1,bi,bj)-GWATX(I,J+1,bi,bj) )
127 & + COSWAT *
128 & ( VICE(I, J,1,bi,bj)-GWATY(I, J,bi,bj)
129 & + VICE(I+1,J,1,bi,bj)-GWATY(I+1,J,bi,bj) )
130 & )
131 fu(I,J,bi,bj)=(ONE-AREA(I,J,1,bi,bj))*fu(I,J,bi,bj)+
132 & AREA(I,J,1,bi,bj)*fuIce
133 fv(I,J,bi,bj)=(ONE-AREA(I,J,1,bi,bj))*fv(I,J,bi,bj)+
134 & AREA(I,J,1,bi,bj)*fvIce
135 ENDDO
136 ENDDO
137 ENDDO
138 ENDDO
139 CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
140 #endif /* SEAICE_TEST_ICE_STRESS_1 */
141 #endif /* not SEAICE_CGRID */
142
143 RETURN
144 END

  ViewVC Help
Powered by ViewVC 1.1.22