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

Contents of /MITgcm_contrib/jscott/igsm/src/daily_ocean.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:30 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
atm2d package

1
2 #include "ctrparam.h"
3
4 ! ==========================================================
5 !
6 ! MD2G04.F: Lots of utility functions.
7 !
8 ! ----------------------------------------------------------
9 !
10 ! Revision History:
11 !
12 ! When Who What
13 ! ---- ---------- -------
14 ! 073100 Chien Wang repack based on CliChem3 & M24x11,
15 ! and add cpp.
16 !
17 ! ==========================================================
18
19
20 SUBROUTINE DAILY_OCEAN 1001.
21 C**** 1002.
22 C**** THIS SUBROUTINE PERFORMS THOSE FUNCTIONS OF THE PROGRAM WHICH 1003.
23 C**** TAKE PLACE AT THE BEGINNING OF A NEW DAY. 1004.
24 C**** 1005.
25
26 #include "BD2G04.COM" 1006.
27
28 COMMON/SPEC2/KM,KINC,COEK,C3LAND(IO0,JM0),C3OICE(IO0,JM0) 1006.1
29 * ,C3LICE(IO0,JM0),WMGE(IO0,JM0),TSSFC(IM0,JM0,4) 1006.2
30 COMMON U,V,T,P,Q 1007.
31 COMMON/WORK2/Z1OOLD(IO0,JM0),XO(IO0,JM0,3),XZO(IO0,JM0) 1008.
32 COMMON/OLDZO/ZMLOLD(IO0,JM0)
33 DIMENSION AMONTH(12),JDOFM(13) 1009.
34 CHARACTER*4 AMONTH 1009.1
35 DIMENSION XA(1,JM0),XB(1,JM0),OI(IO0,JM0),XOI(IO0,JM0) 1009.5
36 dimension sst1(JM0,3),sst2(JM0,3),dsst(JM0,3),intem(3),
37 & sstmin(12,2)
38 & ,miceo(JM0)
39 common/qfl/QFLUX(JM0,0:13),ZOAV(JM0),QFLUXT(JM0)
40 common/TSUR/TSURFC(JM0,0:13),TSURFT(JM0),TSURFD(JM0),DTSURF(JM0)
41 common/fixcld/cldssm(JM0,LM0,0:13),cldmcm(JM0,LM0,0:13),
42 & CLDSST(JM0,LM0),
43 & CLDMCT(JM0,LM0)
44 common/surps/srps(JM0+3),nsrps
45 LOGICAL HPRNT
46 common/conprn/HPRNT,JPR,LPR
47 data ifirst /1/
48 data intem /1,4,5/
49 data sstmin /-1.56,-1.56,-0.75,6*0.0,2*-0.75,-1.56,
50 * 3*0.0,2*-0.75,3*-1.56,-0.75,3*0.0/
51 DATA AMONTH/'JAN','FEB','MAR','APR','MAY','JUNE','JULY','AUG', 1010.
52 * 'SEP','OCT','NOV','DEC'/ 1011.
53 DATA JDOFM/0,31,59,90,120,151,181,212,243,273,304,334,365/ 1012.
54 DATA JDPERY/365/,JMPERY/12/,EDPERY/365./,Z1I/.1/,RHOI/916.6/ 1013.
55 C**** ORBITAL PARAMETERS FOR EARTH FOR YEAR 2000 A.D. 1014.
56 DATA SOLS/173./,APHEL/186./,OBLIQ/23.44/,ECCN/.0167/ 1015.
57 c DATA SOLS/173./,APHEL/186./,OBLIQ/25.00/,ECCN/.0167/ 1015.
58 C**** 1016.
59 C**** CALCULATE THE DAILY CALENDAR 1035.
60 C**** 1036.
61 200 JYEAR=IYEAR+(IDAY-1)/JDPERY 1037.
62 JDAY=IDAY-(JYEAR-IYEAR)*JDPERY 1038.
63 DO 210 MONTH=1,JMPERY 1039.
64 IF(JDAY.LE.JDOFM(MONTH+1)) GO TO 220 1040.
65 210 CONTINUE 1041.
66 220 JDATE=JDAY-JDOFM(MONTH) 1042.
67 JMONTH=AMONTH(MONTH) 1043.
68 if(ifirst.eq.1.or.HPRNT)then
69 print *,' DAILY_OCEAN IDAY=',IDAY,' IYEAR=',IYEAR
70 print *,' JYEAR=',JYEAR,' JDAY=',JDAY
71 print *,' JDATE=',JDATE,' JMONTH=',JMONTH
72 if(KOCEAN.eq.1)ifirst=0
73 endif
74 c
75 IF(KOCEAN.EQ.1) GO TO 500 1048.1
76 C**** 1049.
77 C**** CALCULATE DAILY OCEAN DATA FROM CLIMATOLOGY 1050.
78 C**** 1051.
79 C**** ODATA 1 OCEAN TEMPERATURE (C) 1052.
80 C**** 2 RATIO OF OCEAN ICE COVERAGE TO WATER COVERAGE (1) 1053.
81 C**** 3 OCEAN ICE AMOUNT OF SECOND LAYER (KG/M**2) 1054.
82 C**** 1055.
83 C**** READ IN TWO MONTHS OF OCEAN DATA 1056.
84 do 385 j=1,JM
85 miceo(j)=ODATA(1,j,3)*ODATA(1,j,2)
86 385 continue
87 IF(JDAY.GE.16) GO TO 310 1057.
88 MD=JDATE+15 1058.
89 GO TO 320 1059.
90 310 IF(JDAY.LE.350) GO TO 340 1060.
91 MD=JDATE-16 1061.
92 320 READ (515) M,XO 1062.
93 MDMAX=31 1063.
94 DO 330 MX=1,10 1064.
95 330 READ (515) M 1065.
96 READ (515) M,(((ODATA(I,J,K),I=1,IO),J=1,JM),K=1,3) 1066.
97 GO TO 400 1067.
98 340 DO 350 MX=1,12 1068.
99 READ (515) M,(((ODATA(I,J,K),I=1,IO),J=1,JM),K=1,3) 1069.
100 IF(M.EQ.MONTH) GO TO 360 1070.
101 IF(M+1.EQ.MONTH.AND.JDATE.LT.16) GO TO 370 1071.
102 350 CONTINUE 1072.
103 STOP 2 1073.
104 360 IF(JDATE.EQ.16) GO TO 480 1074.
105 MDMAX=JDOFM(MONTH+1)-JDOFM(MONTH) 1075.
106 MD=JDATE-16 1076.
107 GO TO 380 1077.
108 370 MDMAX=JDOFM(MONTH)-JDOFM(MONTH-1) 1078.
109 MD=MDMAX+JDATE-16 1079.
110 380 READ (515) M,XO 1080.
111 C**** INTERPOLATE OCEAN DATA TO CURRENT DAY 1081.
112 400 X1=FLOAT(MDMAX-MD)/MDMAX 1082.
113 X2=1.-X1 1083.
114 DO 420 K=1,3 1084.
115 DO 420 J=1,JM 1085.
116 DO 420 I=1,IO 1086.
117 420 ODATA(I,J,K)=X1*ODATA(I,J,K)+X2*XO(I,J,K) 1087.
118 480 REWIND 515 1088.
119 DO 255 J=1,JM 1088.5
120 SUM1=0. 1088.51
121 SUM2=0. 1088.511
122 SUM3=0. 1088.512
123 CONT1=0. 1088.52
124 DO 256 I=1,IO 1088.53
125 PLAND=C3LAND(I,J) 1088.54
126 POICE= ODATA(I,J,2)*(1.-PLAND) 1088.55
127 C3OICE(I,J)=POICE 1088.56
128 PWATER=1.-PLAND 1088.57
129 IF(PWATER.LE.0.) GO TO 256 1088.58
130 CONT1=CONT1+PWATER 1088.59
131 SUM1=SUM1+PWATER*ODATA(I,J,1) 1088.6
132 SUM2=SUM2+PWATER*ODATA(I,J,4) 1088.601
133 SUM3=SUM3+PWATER*ODATA(I,J,5) 1088.602
134 256 CONTINUE 1088.61
135 IF(CONT1.EQ.0.) GO TO 255 1088.62
136 IF (J.EQ.1.OR.J.EQ.JM) GO TO 255 1088.63
137 SUM1=SUM1/CONT1 1088.64
138 SUM2=SUM2/CONT1 1088.642
139 SUM3=SUM3/CONT1 1088.643
140 DO 258 I=1,IO 1088.65
141 ODATA(I,J,4)=SUM2 1088.651
142 ODATA(I,J,5)=SUM3 1088.652
143 258 ODATA(I,J,1)=SUM1 1088.66
144 255 CONTINUE 1088.67
145 DO 257 J=2,JMM1 1088.68
146 SUM1=0. 1088.69
147 SUM2=0. 1088.7
148 CONT1=0. 1088.71
149 DO 254 I=1,IO 1088.72
150 POICE=ODATA(I,J,2)*(1.-C3LAND(I,J)) 1088.73
151 SUM1=SUM1+POICE 1088.74
152 SUM2=SUM2+POICE*ODATA(I,J,3) 1088.75
153 254 CONT1=CONT1+(1.-C3LAND(I,J)) 1088.76
154 IF(SUM1.LE.0.) GO TO 425 1088.77
155 SUM2=SUM2/SUM1 1088.78
156 DO 423 I=1,IO 1088.79
157 423 ODATA(I,J,3)=SUM2 1088.8
158 425 CONTINUE 1088.81
159 IF(CONT1.LE.0.) GO TO 257 1088.82
160 RATIO=SUM1/CONT1 1088.83
161 DO 253 I=1,IO 1088.84
162 253 ODATA(I,J,2)=RATIO 1088.85
163 257 CONTINUE 1088.86
164 go to 678
165 DO 251 J=1,2 1088.87
166 DO 251 I=1,IO 1088.88
167 ODATA(I,J,1)=ODATA(I,3,1) 1088.881
168 251 ODATA(I,J,2)=1. 1088.89
169 DO 428 J=1,2 1088.9
170 DO 428 I=1,IO 1088.91
171 ODATA(I,J,4)=ODATA(I,3,4) 1088.911
172 ODATA(I,J,5)=ODATA(I,3,5) 1088.912
173 428 ODATA(I,J,3)=ODATA(I,3,3) 1088.92
174 678 continue
175 c print *,'ICE FractionS'
176 c print *,(ODATA(1,J,2),j=1,jm)
177 C Skip adjustment
178 c go to 950
179 if(JDATE.eq.46)then
180 print *,' before'
181 do 567 M=1,5
182 print *,' '
183 print *,' ODATA ',M
184 print *,(ODATA(1,J,M),J=1,JM)
185 567 continue
186 endif
187 do 558 J=1,JM
188 do 559 ntem=1,3
189 ITEM=intem(ntem)
190 sst1(J,ntem)=ODATA(1,J,ITEM)
191 sst2(J,ntem)=ODATA(1,J,ITEM)
192 dsst(J,ntem)=0.
193 559 continue
194 if(ODATA(1,J,2).ge.0.2)then
195 dmice=ODATA(1,J,3)*ODATA(1,j,2)-miceo(J)
196 if(dmice.ge.0.0)then
197 do 561 ntem=1,3
198 if(sst1(J,ntem).gt.-1.56)then
199 sst2(J,ntem)=-1.56
200 dsst(J,ntem)=-1.56-sst1(J,ntem)
201 endif
202 561 continue
203 else
204 do 569 ntem=1,3
205 if(sst1(J,ntem).gt.0.0)then
206 sst2(J,ntem)=0.0
207 dsst(J,ntem)=-sst1(J,ntem)
208 endif
209 569 continue
210 endif
211 else
212 ODATA(1,J,2)=0.
213 ODATA(1,J,3)=0.
214 endif
215 558 continue
216 do 562 j=2,JM/2
217 jnr=JM-j+1
218 do 563 ntem=1,3
219 if(dsst(j+1,ntem).eq.0.0.and.dsst(j,ntem).eq.0.0
220 * .and.dsst(j-1,ntem).ne.0.0) then
221 sst2(j,ntem)=sst1(j,ntem)+0.5*dsst(j-1,ntem)
222 sst2(j+1,ntem)=sst1(j+1,ntem)+0.25*dsst(j-1,ntem)
223 endif
224 if(dsst(jnr-1,ntem).eq.0.0.and.dsst(jnr,ntem).eq.0.0
225 * .and.dsst(jnr+1,ntem).ne.0.0) then
226 sst2(jnr,ntem)=sst1(jnr,ntem)+0.5*dsst(jnr+1,ntem)
227 sst2(jnr-1,ntem)=sst1(jnr-1,ntem)+0.25*dsst(jnr+1,ntem)
228 endif
229 563 continue
230 562 continue
231 do 663 J=1,JM
232 do 664 ntem=1,3
233 ITEM=intem(ntem)
234 ODATA(1,J,ITEM)=sst2(J,ntem)
235 664 continue
236 663 continue
237 if(JDATE.eq.46)then
238 print *,' after'
239 do 557 M=1,5
240 print *,' '
241 print *,' ODATA ',M
242 print *,(ODATA(1,J,M),J=1,JM)
243 557 continue
244 endif
245 C
246 go to 955
247 950 continue
248 if(ifirst.eq.1)then
249 print *,' Adjustment of SST and sea ice is skiped'
250 print *,' Adjustment of SST and sea ice is skiped'
251 print *,' Adjustment of SST and sea ice is skiped'
252 ifirst=0
253 endif
254 955 continue
255 if(ifirst.eq.1)then
256 print *,' With adjustment of SST and sea ice '
257 print *,' With adjustment of SST and sea ice '
258 print *,' With adjustment of SST and sea ice '
259 ifirst=0
260 endif
261 c JDAY=JDSAVE 1088.93
262 c JDATE=JDATES 1088.94
263 c MONTH=MONSAV 1088.95
264 C**** WHEN TGO IS NOT DEFINED, MAKE IT A REASONALBE VALUE 1089.
265 DO 426 J=1,JM 1090.
266 DO 426 I=1,IO 1091.
267 IF(ODATA(I,J,1).LT.-10.) ODATA(I,J,1)=-10. 1092.
268 426 CONTINUE 1093.
269 C**** REDUCE THE RATIO OF OCEAN ICE TO WATER BY .1*RHOI/ACEOI 1094.
270 DO 490 J=1,JM 1095.
271 DO 490 I=1,IO 1096.
272 IF(ODATA(I,J,2).LE.0.) GO TO 490 1097.
273 BYZICE=RHOI/(Z1I*RHOI+ODATA(I,J,3)) 1097.1
274 ODATA(I,J,2)=ODATA(I,J,2)*(1.-.06*(BYZICE-1./5.)) 1098.
275 490 CONTINUE 1099.
276 C**** ZERO OUT SNOWOI, TG1OI, TG2OI AND ACE2OI IF THERE IS NO OCEAN ICE 1100.
277 DO 620 J=1,JM 1101.
278 DO 620 I=1,IO 1102.
279 IF(ODATA(I,J,2).GT.0.) GO TO 620 1103.
280 GDATA(I,J,1)=0. 1104.
281 GDATA(I,J,3)=0. 1105.
282 GDATA(I,J,7)=0. 1106.
283 620 CONTINUE 1107.
284 RETURN 1108.
285 C**** 1108.01
286 C**** CALCULATE DAILY OCEAN MIXED LAYER DEPTHS FROM CLIMATOLOGY 1108.02
287 C**** 1108.03
288 C**** SAVE PREVIOUS DAY'S MIXED LAYER DEPTH IN WORK2 1108.04
289 500 DO 510 J=1,JM 1108.05
290 DO 510 I=1,IO 1108.06
291 ZMLOLD(I,J)=Z1O(I,J)
292 510 Z1OOLD(I,J)=Z1O(I,J) 1108.07
293 C**** READ IN TWO MONTHS OF OCEAN DATA 1108.08
294 IF(JDAY.GE.16) GO TO 520 1108.09
295 MD=JDATE+15 1108.1
296 GO TO 530 1108.11
297 520 IF(JDAY.LE.350) GO TO 550 1108.12
298 MD=JDATE-16 1108.13
299 530 READ (515) M,XZO,XOI,XZO,XZO 1108.14
300 MDMAX=31 1108.15
301 DO 540 MX=1,10 1108.16
302 540 READ (515) M 1108.17
303 READ (515) M,Z1O,OI,Z1O,Z1O 1108.18
304 GO TO 600 1108.19
305 550 DO 560 MX=1,12 1108.2
306 READ (515) M,Z1O,OI,Z1O,Z1O 1108.21
307 IF(M.EQ.MONTH) GO TO 570 1108.22
308 IF(M+1.EQ.MONTH.AND.JDATE.LT.16) GO TO 580 1108.23
309 560 CONTINUE 1108.24
310 STOP 2 1108.25
311 570 IF(JDATE.EQ.16) GO TO 625 1108.26
312 MDMAX=JDOFM(MONTH+1)-JDOFM(MONTH) 1108.27
313 MD=JDATE-16 1108.28
314 GO TO 590 1108.29
315 580 MDMAX=JDOFM(MONTH)-JDOFM(MONTH-1) 1108.3
316 MD=MDMAX+JDATE-16 1108.31
317 590 READ (515) M,XZO,XOI,XZO,XZO 1108.32
318 C**** INTERPOLATE OCEAN DATA TO CURRENT DAY 1108.33
319 600 X1=FLOAT(MDMAX-MD)/MDMAX 1108.34
320 X2=1.-X1 1108.35
321 DO 610 J=1,JM 1108.36
322 DO 610 I=1,IO 1108.37
323 OI(I,J)=X1*OI(I,J)+X2*XOI(I,J) 1108.371
324 IF(OI(I,J).GT.0.) OI(I,J)=OI(I,J)* 1108.373
325 * (1.-.1*RHOI/(Z1I*RHOI+ODATA(I,J,3))) 1108.374
326 Z1O(I,J)=X1*Z1O(I,J)+X2*XZO(I,J) 1108.38
327 Z1OMIN=.09166+.001*(GDATA(I,J,1)+ODATA(I,J,3)) 1108.39
328 IF(Z1O(I,J).LT.Z1OMIN) Z1O(I,J)=Z1OMIN 1108.391
329 IF(Z1OMIN.GT.Z12O(I,J)-.1) WRITE(6,605)I,J,MONTH,Z1OMIN,XZO(I,J) 1108.4
330 605 FORMAT (' OCEAN ICE CLOSE TO MLD AT I,J,MONTH',3I3,2F10.3) 1108.41
331 IF(Z1OMIN.GT.Z12O(I,J)-.1) STOP 8148 1108.42
332 610 CONTINUE 1108.43
333 625 REWIND 515 1108.44
334 DO 628 J=1,JM 1108.441
335 SUM1=0. 1108.442
336 CONT1=0. 1108.444
337 DO 626 I=1,IO 1108.445
338 C3OICE(I,J)=OI(I,J)*(1.-C3LAND(I,J)) 1108.446
339 PWATER=1.-C3LAND(I,J) 1108.447
340 IF(PWATER.LE.0.) GO TO 626 1108.448
341 CONT1=CONT1+PWATER 1108.449
342 SUM1=SUM1+Z1O(I,J)*PWATER 1108.45
343 626 CONTINUE 1108.452
344 IF(CONT1.LE.0.) GO TO 628 1108.453
345 IF(J.EQ.1.OR.J.EQ.JM) GO TO 628 1108.454
346 SUM1=SUM1/CONT1 1108.455
347 DO 627 I=1,IO 1108.457
348 Z1O(I,J)=SUM1 1108.458
349 627 CONTINUE 1108.459
350 628 CONTINUE 1108.46
351 DO 629 J=1,2 1108.461
352 DO 629 I=1,IO 1108.462
353 Z1O(I,J)=Z1O(I,3) 1108.463
354 629 CONTINUE 1108.464
355 C**** PREVENT Z1O, THE MIXED LAYER DEPTH, FROM EXCEEDING Z12O 1108.491
356 DO 630 J=1,JM 1108.492
357 DO 630 I=1,IO 1108.493
358 CCC Z1O(I,J)=ZOAV(J)
359 IF(Z1O(I,J).GT.Z12O(I,J)-.01) Z1O(I,J)=Z12O(I,J) 1108.494
360 630 CONTINUE 1108.495
361 c print *,' DAILY JDATE=',JDATE,' MONTH=',MONTH
362 c print *,'TSURFD'
363 c print *,TSURFD
364 c print *,'TSURFT'
365 c print *,TSURFT
366 do 725 j=1,JM
367 DTSURF(j)=TSURFD(j)-TSURFT(j)
368 TSURFD(j)=0.
369 725 continue
370 if(JDATE.le.16)then
371 do 723 j=1,JM
372 QFLUXT(j)=((16-JDATE)*QFLUX(j,MONTH-1)+
373 * (JDATE+15)*QFLUX(j,MONTH))/31.
374 TSURFT(j)=((16-JDATE)*TSURFC(j,MONTH-1)+
375 * (JDATE+15)*TSURFC(j,MONTH))/31.
376 723 continue
377 else
378 do 724 j=1,JM
379 QFLUXT(j)=((JDATE-16)*QFLUX(j,MONTH+1)+
380 * (31-JDATE+16)*QFLUX(j,MONTH))/31.
381 TSURFT(j)=((JDATE-16)*TSURFC(j,MONTH+1)+
382 * (31-JDATE+16)*TSURFC(j,MONTH))/31.
383 724 continue
384 endif
385 c print *,' NEW TSURFT'
386 c print *,TSURFT
387 RETURN 1108.5
388 C**** 1109.
389 901 FORMAT ('0PRESSURE ADDED IN GMP IS',F10.6/) 1114.
390 902 FORMAT ('0MEAN SURFACE PRESSURE OF THE ATMOSPHERE IS',F10.4) 1115.
391 910 FORMAT('1',33A4/) 1116.
392 915 FORMAT (47X,'DAY',I5,', HR',I3,' (',I2,A5,I5,')',F8.1) 1117.
393 920 FORMAT('1') 1118.
394 END 1119.

  ViewVC Help
Powered by ViewVC 1.1.22