/[MITgcm]/MITgcm/pkg/thsice/thsice_main.F
ViewVC logotype

Contents of /MITgcm/pkg/thsice/thsice_main.F

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


Revision 1.4 - (show annotations) (download)
Mon Jan 31 19:37:06 2005 UTC (19 years, 3 months ago) by jmc
Branch: MAIN
Changes since 1.3: +2 -1 lines
store sea-ice albedo in a common block (for diagnostics).

1 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_main.F,v 1.3 2004/07/08 15:56:36 jmc Exp $
2 C $Name: $
3
4 #include "THSICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: THSICE_MAIN
8 C !INTERFACE:
9 SUBROUTINE THSICE_MAIN(
10 I myTime, myIter, myThid )
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | S/R THSICE_MAIN
14 C | o Therm_SeaIce main routine.
15 C | step forward Thermodynamic_SeaIce variables and modify
16 C | ocean surface forcing accordingly.
17 C *==========================================================*
18
19 C !USES:
20 IMPLICIT NONE
21
22 C === Global variables ===
23 #include "SIZE.h"
24 #include "EEPARAMS.h"
25 #include "PARAMS.h"
26 #include "GRID.h"
27 #include "SURFACE.h"
28 #include "DYNVARS.h"
29 #include "FFIELDS.h"
30 #include "THSICE_PARAMS.h"
31 #include "THSICE_VARS.h"
32 #ifdef ALLOW_BULK_FORCE
33 #include "BULKF.h"
34 #endif
35
36 C !INPUT/OUTPUT PARAMETERS:
37 C === Routine arguments ===
38 C myIter :: iteration counter for this thread
39 C myTime :: time counter for this thread
40 C myThid :: thread number for this instance of the routine.
41 _RL myTime
42 INTEGER myIter
43 INTEGER myThid
44 CEOP
45
46 #ifdef ALLOW_THSICE
47 C !LOCAL VARIABLES:
48 C === Local variables ===
49 INTEGER i,j
50 INTEGER bi,bj
51 INTEGER iMin, iMax
52 INTEGER jMin, jMax
53 _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54 _RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55 _RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56
57 _RL tauFac
58
59 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
60
61 IF ( stressReduction.GT. 0. _d 0 ) THEN
62 iMin = 1-Olx
63 iMax = sNx+Olx-1
64 jMin = 1-Oly
65 jMax = sNy+Oly-1
66 ELSE
67 iMin = 1
68 iMax = sNx
69 jMin = 1
70 jMax = sNy
71 ENDIF
72
73 DO bj=myByLo(myThid),myByHi(myThid)
74 DO bi=myBxLo(myThid),myBxHi(myThid)
75
76 C-- Mixed layer thickness: take the 1rst layer
77 #ifdef NONLIN_FRSURF
78 IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
79 IF ( select_rStar.GT.0 ) THEN
80 DO j = jMin, jMax
81 DO i = iMin, iMax
82 hOceMxL(i,j,bi,bj) = drF(1)*h0FacC(i,j,1,bi,bj)
83 & *rStarFacC(i,j,bi,bj)
84 ENDDO
85 ENDDO
86 ELSE
87 DO j = jMin, jMax
88 DO i = iMin, iMax
89 IF ( ksurfC(i,j,bi,bj).EQ.1 ) THEN
90 hOceMxL(i,j,bi,bj) = drF(1)*hFac_surfC(i,j,bi,bj)
91 ELSE
92 hOceMxL(i,j,bi,bj) = drF(1)*hfacC(i,j,1,bi,bj)
93 ENDIF
94 ENDDO
95 ENDDO
96 ENDIF
97 ELSE
98 #else /* ndef NONLIN_FRSURF */
99 IF (.TRUE.) THEN
100 #endif /* NONLIN_FRSURF */
101 DO j = jMin, jMax
102 DO i = iMin, iMax
103 hOceMxL(i,j,bi,bj) = drF(1)*hfacC(i,j,1,bi,bj)
104 ENDDO
105 ENDDO
106 ENDIF
107
108 DO j = jMin, jMax
109 DO i = iMin, iMax
110 tOceMxL(i,j,bi,bj) = theta(i,j,1,bi,bj)
111 sOceMxL(i,j,bi,bj) = salt (i,j,1,bi,bj)
112 v2ocMxL(i,j,bi,bj) =
113 & ( uvel(i,j,1,bi,bj)*uvel(i,j,1,bi,bj)
114 & + uvel(i+1,j,1,bi,bj)*uvel(i+1,j,1,bi,bj)
115 & + vvel(i,j+1,1,bi,bj)*vvel(i,j+1,1,bi,bj)
116 & + vvel(i,j,1,bi,bj)*vvel(i,j,1,bi,bj)
117 & )*0.5 _d 0
118 prcAtm(i,j) = 0.
119 evpAtm(i,j) = 0.
120 flxSW (i,j) = 0.
121 snowPrc(i,j,bi,bj) = 0. _d 0
122 siceAlb(i,j,bi,bj) = 0. _d 0
123 #ifdef ALLOW_BULK_FORCE
124 prcAtm(i,j) = ( rain(i,j,bi,bj)+runoff(i,j,bi,bj) )*rhofw
125 flxSW (i,j) = solar(i,j,bi,bj)
126 IF ( iceMask(i,j,bi,bj).GT.0. _d 0
127 & .AND. Tair(i,j,bi,bj).LE.Tf0kel ) THEN
128 snowPrc(i,j,bi,bj) = rain(i,j,bi,bj)*rhofw
129 ENDIF
130 #endif
131 ENDDO
132 ENDDO
133
134 CALL THSICE_STEP_FWD(
135 I bi, bj, iMin, iMax, jMin, jMax,
136 I prcAtm,
137 U evpAtm, flxSW,
138 I myTime, myIter, myThid )
139
140 CALL THSICE_AVE(
141 I evpAtm, flxSW,
142 I bi,bj, myTime, myIter, myThid )
143
144 c ENDDO
145 c ENDDO
146
147 c IF ( .FALSE. ) THEN
148 IF ( stressReduction.GT. 0. _d 0 ) THEN
149 DO j = jMin, jMax
150 DO i = iMin+1,iMax
151 tauFac = stressReduction
152 & *(iceMask(i-1,j,bi,bj)+iceMask(i,j,bi,bj))*0.5 _d 0
153 fu(i,j,bi,bj) = (1. _d 0 - tauFac)*fu(i,j,bi,bj)
154 ENDDO
155 ENDDO
156 DO j = jMin+1, jMax
157 DO i = iMin, iMax
158 tauFac = stressReduction
159 & *(iceMask(i,j-1,bi,bj)+iceMask(i,j,bi,bj))*0.5 _d 0
160 fv(i,j,bi,bj) = (1. _d 0 - tauFac)*fv(i,j,bi,bj)
161 ENDDO
162 ENDDO
163 ENDIF
164
165 C-- end bi,bj loop
166 ENDDO
167 ENDDO
168
169 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
170 #endif /*ALLOW_THSICE*/
171
172 RETURN
173 END

  ViewVC Help
Powered by ViewVC 1.1.22