/[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.2 - (show annotations) (download)
Mon Apr 23 21:20:18 2007 UTC (18 years, 3 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +4 -2 lines
bring igsm atmos code up to date

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

  ViewVC Help
Powered by ViewVC 1.1.22