/[MITgcm]/MITgcm/verification/aim.5l_Equatorial_Channel/code/aim_surf_bc.F
ViewVC logotype

Annotation of /MITgcm/verification/aim.5l_Equatorial_Channel/code/aim_surf_bc.F

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


Revision 1.7 - (hide annotations) (download)
Sun May 17 19:41:29 2009 UTC (15 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62a, checkpoint61o, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.6: +3 -3 lines
fixed for multi-threaded run.

1 jmc 1.7 C $Header: /u/gcmpack/MITgcm/verification/aim.5l_Equatorial_Channel/code/aim_surf_bc.F,v 1.6 2009/01/27 15:38:07 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "AIM_OPTIONS.h"
5    
6 jmc 1.5 SUBROUTINE AIM_SURF_BC(
7     U tYear,
8     O aim_sWght0, aim_sWght1,
9     I bi, bj, myTime, myIter, myThid )
10 jmc 1.1 C *================================================================*
11     C | S/R AIM_SURF_BC
12 jmc 1.5 C | Set surface Boundary Conditions
13 jmc 1.1 C | for the atmospheric physics package
14     C *================================================================*
15     c | was part of S/R FORDATE in Franco Molteni SPEEDY code (ver23).
16     C | For now, surface BC are loaded from files (S/R AIM_FIELDS_LOAD)
17     C | and imposed (= surf. forcing).
18 jmc 1.5 C | In the future, will add
19 jmc 1.1 C | a land model and a coupling interface with an ocean GCM
20     C *================================================================*
21     IMPLICIT NONE
22    
23     C -------------- Global variables --------------
24     C-- size for MITgcm & Physics package :
25     #include "AIM_SIZE.h"
26    
27     C-- MITgcm
28     #include "EEPARAMS.h"
29     #include "PARAMS.h"
30     c #include "DYNVARS.h"
31     #include "GRID.h"
32     c #include "SURFACE.h"
33    
34     C-- Physics package
35     #include "AIM_PARAMS.h"
36     #include "AIM_FFIELDS.h"
37     c #include "AIM_GRID.h"
38     #include "com_forcon.h"
39     #include "com_forcing.h"
40     c #include "com_physvar.h"
41    
42     C-- Coupled to the Ocean :
43     #ifdef COMPONENT_MODULE
44     #include "CPL_PARAMS.h"
45     #include "ATMCPL.h"
46     #endif
47    
48     C == Routine arguments ==
49 jmc 1.5 C tYear :: Fraction into year
50     C aim_sWght0 :: weight for time interpolation of surface BC
51     C aim_sWght1 :: 0/1 = time period before/after the current time
52     C bi,bj :: Tile indices
53     C myTime :: Current time of simulation ( s )
54     C myIter :: Current iteration number in simulation
55     C myThid :: my Thread number Id.
56     _RL tYear
57     _RL aim_sWght0, aim_sWght1
58     INTEGER bi, bj
59     _RL myTime
60     INTEGER myIter, myThid
61 jmc 1.1
62     #ifdef ALLOW_AIM
63     C == Local variables ==
64 jmc 1.5 C i,j,k,I2,k :: Loop counters
65     INTEGER i,j,I2,k, nm0
66     _RL t0prd, tNcyc, tmprd, dTprd
67 jmc 1.1 _RL SDEP1, IDEP2, SDEP2, SWWIL2, RSW, soilw_0, soilw_1
68 jmc 1.4 _RL RSD, alb_land, oceTfreez
69 jmc 1.2 c _RL DALB, alb_sea
70 jmc 1.1
71     C_EqCh: start
72     CHARACTER*(MAX_LEN_MBUF) suff
73     _RL xBump, yBump, dxBump, dyBump
74 jmc 1.6 xBump = xgOrigin + delX(1)*64.
75     yBump = ygOrigin + delY(1)*11.5
76 jmc 1.1 dxBump= delX(1)*12.
77     dyBump= delY(1)*6.
78     C_EqCh: Fix solar insolation with Sun directly overhead on Equator
79     tYear = 0.25 _d 0 - 10. _d 0/365. _d 0
80     C_EqCh: end
81    
82 jmc 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83     C- Set Land-sea mask (in [0,1]) from aim_landFr to fMask1:
84     DO j=1,sNy
85     DO i=1,sNx
86     I2 = i+(j-1)*sNx
87     fMask1(I2,1,myThid) = aim_landFr(i,j,bi,bj)
88     ENDDO
89     ENDDO
90    
91 jmc 1.1 IF (aim_useFMsurfBC) THEN
92     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
93    
94 jmc 1.5 C aim_surfForc_TimePeriod :: Length of forcing time period (e.g. 1 month)
95     C aim_surfForc_NppCycle :: Number of time period per Cycle (e.g. 12)
96     C aim_surfForc_TransRatio ::
97     C- define how fast the (linear) transition is from one month to the next
98     C = 1 -> linear between 2 midle month
99     C > TimePeriod/deltaT -> jump from one month to the next one
100    
101     C-- Calculate weight for linear interpolation between 2 month centers
102     t0prd = myTime / aim_surfForc_TimePeriod
103     tNcyc = aim_surfForc_NppCycle
104     tmprd = t0prd - 0.5 _d 0 + tNcyc
105     tmprd = MOD(tmprd,tNcyc)
106     C- indices of previous month (nm0) and next month (nm1):
107     nm0 = 1 + INT(tmprd)
108     c nm1 = 1 + MOD(nm0,aim_surfForc_NppCycle)
109     C- interpolation weight:
110     dTprd = tmprd - (nm0 - 1)
111     aim_sWght1 = 0.5 _d 0+(dTprd-0.5 _d 0)*aim_surfForc_TransRatio
112     aim_sWght1 = MAX( 0. _d 0, MIN(1. _d 0, aim_sWght1) )
113     aim_sWght0 = 1. _d 0 - aim_sWght1
114    
115 jmc 1.1 C-- Compute surface forcing at present time (linear Interp in time)
116     C using F.Molteni surface BC form ; fields needed are:
117 jmc 1.4 C 1. Sea Surface temperatures (in situ Temp. [K])
118     C 2. Land Surface temperatures (in situ Temp. [K])
119     C 3. Soil moisture (between 0-1)
120     C 4. Snow depth, Sea Ice : used to compute albedo (=> local arrays)
121     C 5. Albedo (between 0-1)
122 jmc 1.1
123 jmc 1.5 C- Surface Temperature:
124 jmc 1.1 DO j=1,sNy
125     DO i=1,sNx
126     I2 = i+(j-1)*sNx
127 jmc 1.5 sst1(I2,myThid) = aim_sWght0*aim_sst0(i,j,bi,bj)
128 jmc 1.1 & + aim_sWght1*aim_sst1(i,j,bi,bj)
129     stl1(I2,myThid) = aim_sWght0*aim_lst0(i,j,bi,bj)
130     & + aim_sWght1*aim_lst1(i,j,bi,bj)
131     ENDDO
132     ENDDO
133    
134     C- Soil Water availability : (from F.M. INFORC S/R)
135     SDEP1 = 70. _d 0
136     IDEP2 = 3. _d 0
137     SDEP2 = IDEP2*SDEP1
138    
139     SWWIL2= SDEP2*SWWIL
140     RSW = 1. _d 0/(SDEP1*SWCAP+SDEP2*(SWCAP-SWWIL))
141 jmc 1.5
142 jmc 1.1 DO j=1,sNy
143     DO i=1,sNx
144     I2 = i+(j-1)*sNx
145 jmc 1.5 soilw_0 = ( aim_sw10(i,j,bi,bj)
146 jmc 1.1 & +aim_veget(i,j,bi,bj)*
147     & MAX(IDEP2*aim_sw20(i,j,bi,bj)-SWWIL2, 0. _d 0)
148 jmc 1.5 & )*RSW
149     soilw_1 = ( aim_sw11(i,j,bi,bj)
150 jmc 1.1 & +aim_veget(i,j,bi,bj)*
151     & MAX(IDEP2*aim_sw21(i,j,bi,bj)-SWWIL2, 0. _d 0)
152 jmc 1.5 & )*RSW
153     soilw1(I2,myThid) = aim_sWght0*soilw_0
154 jmc 1.1 & + aim_sWght1*soilw_1
155     soilw1(I2,myThid) = MIN(1. _d 0, soilw1(I2,myThid) )
156     ENDDO
157     ENDDO
158    
159     C- Set snow depth & sea-ice fraction :
160     DO j=1,sNy
161     DO i=1,sNx
162     I2 = i+(j-1)*sNx
163     snow1(I2) = aim_sWght0*aim_snw0(i,j,bi,bj)
164 jmc 1.5 & + aim_sWght1*aim_snw1(i,j,bi,bj)
165 jmc 1.1 oice1(I2) = aim_sWght0*aim_oic0(i,j,bi,bj)
166 jmc 1.5 & + aim_sWght1*aim_oic1(i,j,bi,bj)
167 jmc 1.1 ENDDO
168     ENDDO
169    
170 jmc 1.2 IF (aim_splitSIOsFx) THEN
171     C- Split Ocean and Sea-Ice surf. temp. ; remove ice-fraction < 1 %
172 jmc 1.4 c oceTfreez = tFreeze - 1.9 _d 0
173     oceTfreez = celsius2K - 1.9 _d 0
174 jmc 1.2 DO J=1,NGP
175 jmc 1.5 sti1(J,myThid) = sst1(J,myThid)
176 jmc 1.2 IF ( oice1(J) .GT. 1. _d -2 ) THEN
177 jmc 1.4 sst1(J,myThid) = MAX(sst1(J,myThid),oceTfreez)
178 jmc 1.5 sti1(J,myThid) = sst1(J,myThid)
179 jmc 1.2 & +(sti1(J,myThid)-sst1(J,myThid))/oice1(J)
180     ELSE
181     oice1(J) = 0. _d 0
182     ENDIF
183     ENDDO
184     ELSE
185     DO J=1,NGP
186 jmc 1.5 sti1(J,myThid) = sst1(J,myThid)
187 jmc 1.2 ENDDO
188     ENDIF
189    
190 jmc 1.1 C- Surface Albedo : (from F.M. FORDATE S/R)
191 jmc 1.2 c_FM DALB=ALBICE-ALBSEA
192 jmc 1.1 RSD=1. _d 0/SDALB
193     DO j=1,sNy
194     DO i=1,sNx
195     c_FM SNOWC=MIN(1.,RSD*SNOW1(I,J))
196     c_FM ALBL=ALB0(I,J)+MAX(ALBSN-ALB0(I,J),0.0)*SNOWC
197     c_FM ALBS=ALBSEA+DALB*OICE1(I,J)
198     c_FM ALB1(I,J)=FMASK1(I,J)*ALBL+FMASK0(I,J)*ALBS
199     I2 = i+(j-1)*sNx
200     alb_land = aim_albedo(i,j,bi,bj)
201     & + MAX( 0. _d 0, ALBSN-aim_albedo(i,j,bi,bj) )
202     & *MIN( 1. _d 0, RSD*snow1(I2))
203 jmc 1.2 c alb_sea = ALBSEA + DALB*oice1(I2)
204 jmc 1.5 c alb1(I2,0,myThid) = alb_sea
205 jmc 1.2 c & + (alb_land - alb_sea)*fMask1(I2,1,myThid)
206     alb1(I2,1,myThid) = alb_land
207     alb1(I2,2,myThid) = ALBSEA
208     alb1(I2,3,myThid) = ALBICE
209 jmc 1.1 ENDDO
210     ENDDO
211    
212     C-- else aim_useFMsurfBC
213     ELSE
214     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
215    
216 jmc 1.5 C- safer to initialise output argument aim_sWght0,1
217     C even if they are not used when aim_useFMsurfBC=F
218     aim_sWght1 = 0. _d 0
219     aim_sWght0 = 1. _d 0
220    
221 jmc 1.1 C- Set surface forcing fields needed by atmos. physics package
222     C 1. Albedo (between 0-1)
223     C 2. Sea Surface temperatures (in situ Temp. [K])
224     C 3. Land Surface temperatures (in situ Temp. [K])
225     C 4. Soil moisture (between 0-1)
226 jmc 1.5 C Snow depth, Sea Ice (<- no need for now)
227 jmc 1.1
228     C Set surface albedo data (in [0,1]) from aim_albedo to alb1 :
229     IF (aim_useMMsurfFc) THEN
230     DO j=1,sNy
231     DO i=1,sNx
232     I2 = i+(j-1)*sNx
233 jmc 1.2 alb1(I2,1,myThid) = aim_albedo(i,j,bi,bj)
234     alb1(I2,2,myThid) = aim_albedo(i,j,bi,bj)
235     alb1(I2,3,myThid) = aim_albedo(i,j,bi,bj)
236 jmc 1.1 ENDDO
237     ENDDO
238     ELSE
239     DO j=1,sNy
240     DO i=1,sNx
241     I2 = i+(j-1)*sNx
242 jmc 1.2 alb1(I2,1,myThid) = 0.
243     alb1(I2,2,myThid) = 0.
244     alb1(I2,3,myThid) = 0.
245 jmc 1.1 ENDDO
246     ENDDO
247     ENDIF
248     C Set surface temperature data from aim_S/LSurfTemp to sst1 & stl1 :
249     IF (aim_useMMsurfFc) THEN
250     DO j=1,sNy
251     DO i=1,sNx
252     I2 = i+(j-1)*sNx
253 jmc 1.5 sst1(I2,myThid) = aim_sst0(i,j,bi,bj)
254     stl1(I2,myThid) = aim_sst0(i,j,bi,bj)
255     sti1(I2,myThid) = aim_sst0(i,j,bi,bj)
256 jmc 1.1 ENDDO
257     ENDDO
258     ELSE
259     DO j=1,sNy
260     DO i=1,sNx
261     I2 = i+(j-1)*sNx
262     sst1(I2,myThid) = 300.
263     stl1(I2,myThid) = 300.
264 jmc 1.2 sti1(I2,myThid) = 300.
265 jmc 1.1 C_EqCh: start
266     sst1(I2,myThid) = 280.
267 jmc 1.2 & +20. _d 0 *exp( -((xC(i,j,bi,bj)-xBump)/dxBump)**2
268 jmc 1.1 & -((yC(i,j,bi,bj)-yBump)/dyBump)**2 )
269     stl1(I2,myThid) = sst1(I2,myThid)
270 jmc 1.2 sti1(I2,myThid) = sst1(I2,myThid)
271 jmc 1.1 C_EqCh: end
272     ENDDO
273     ENDDO
274     C_EqCh: start
275 jmc 1.2 IF (myIter.EQ.nIter0) THEN
276 jmc 1.1 WRITE(suff,'(I10.10)') myIter
277 jmc 1.7 CALL AIM_WRITE_PHYS( 'aim_SST.', suff, 1,sst1,
278     & 1, bi, bj, 1, myIter, myThid )
279 jmc 1.1 ENDIF
280     C_EqCh: end
281     ENDIF
282    
283 jmc 1.5 C- Set soil water availability (in [0,1]) from aim_sw10 to soilw1 :
284 jmc 1.1 IF (aim_useMMsurfFc) THEN
285     DO j=1,sNy
286     DO i=1,sNx
287     I2 = i+(j-1)*sNx
288 jmc 1.5 soilw1(I2,myThid) = aim_sw10(i,j,bi,bj)
289 jmc 1.1 ENDDO
290     ENDDO
291     ELSE
292     DO j=1,sNy
293     DO i=1,sNx
294     I2 = i+(j-1)*sNx
295     soilw1(I2,myThid) = 0.
296     ENDDO
297     ENDDO
298     ENDIF
299    
300 jmc 1.5 C- Set Snow depth and Sea Ice
301 jmc 1.1 C (not needed here since albedo is loaded from file)
302 jmc 1.2 DO j=1,sNy
303     DO i=1,sNx
304     I2 = i+(j-1)*sNx
305     oice1(I2) = 0.
306     snow1(I2) = 0.
307     ENDDO
308     ENDDO
309 jmc 1.1
310     C-- endif/else aim_useFMsurfBC
311     ENDIF
312    
313     #ifdef COMPONENT_MODULE
314     IF ( useCoupler ) THEN
315 jmc 1.5 C-- take surface data from the ocean component
316 jmc 1.4 C to replace MxL fields (if use sea-ice) or directly AIM SST
317     CALL ATM_APPLY_IMPORT(
318     I aim_landFr,
319 jmc 1.5 U sst1(1,myThid), oice1,
320     I myTime, myIter, bi, bj, myThid )
321 jmc 1.1 ENDIF
322     #endif /* COMPONENT_MODULE */
323    
324     #ifdef ALLOW_LAND
325     IF (useLand) THEN
326     C- Use land model output instead of prescribed Temp & moisture
327 jmc 1.5 CALL AIM_LAND2AIM(
328 jmc 1.2 I aim_landFr, aim_veget, aim_albedo, snow1,
329 jmc 1.5 U stl1(1,myThid), soilw1(1,myThid), alb1(1,1,myThid),
330     I myTime, myIter, bi, bj, myThid )
331 jmc 1.1 ENDIF
332     #endif /* ALLOW_LAND */
333 jmc 1.2
334 jmc 1.4 #ifdef ALLOW_THSICE
335     IF (useThSIce) THEN
336     C- Use thermo. sea-ice model output instead of prescribed Temp & albedo
337 jmc 1.5 CALL AIM_SICE2AIM(
338 jmc 1.4 I aim_landFr,
339 jmc 1.5 U sst1(1,myThid), oice1,
340     O sti1(1,myThid), alb1(1,3,myThid),
341     I myTime, myIter, bi, bj, myThid )
342 jmc 1.4 ENDIF
343     #endif /* ALLOW_THSICE */
344    
345 jmc 1.2 C-- set the sea-ice & open ocean fraction :
346     DO J=1,NGP
347     fMask1(J,3,myThid) =(1. _d 0 - fMask1(J,1,myThid))
348     & *oice1(J)
349 jmc 1.5 fMask1(J,2,myThid) = 1. _d 0 - fMask1(J,1,myThid)
350 jmc 1.2 & - fMask1(J,3,myThid)
351     ENDDO
352    
353     C-- set the mean albedo :
354     DO J=1,NGP
355     alb1(J,0,myThid) = fMask1(J,1,myThid)*alb1(J,1,myThid)
356     & + fMask1(J,2,myThid)*alb1(J,2,myThid)
357     & + fMask1(J,3,myThid)*alb1(J,3,myThid)
358     ENDDO
359    
360 jmc 1.4 C-- initialize surf. temp. change to zero:
361     DO k=1,3
362     DO J=1,NGP
363     dTsurf(J,k,myThid) = 0.
364     ENDDO
365     ENDDO
366    
367 jmc 1.2 IF (.NOT.aim_splitSIOsFx) THEN
368     DO J=1,NGP
369     fMask1(J,3,myThid) = 0. _d 0
370 jmc 1.5 fMask1(J,2,myThid) = 1. _d 0 - fMask1(J,1,myThid)
371 jmc 1.2 ENDDO
372     ENDIF
373 jmc 1.1
374     #endif /* ALLOW_AIM */
375    
376     RETURN
377     END

  ViewVC Help
Powered by ViewVC 1.1.22