/[MITgcm]/MITgcm_contrib/jscott/pkg_atm2d/init_atm2d.F
ViewVC logotype

Annotation of /MITgcm_contrib/jscott/pkg_atm2d/init_atm2d.F

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


Revision 1.3 - (hide annotations) (download)
Tue Aug 21 16:06:21 2007 UTC (17 years, 11 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -0 lines
FILE REMOVED
remove old atm2d pkg repository

1 jscott 1.1 #include "ctrparam.h"
2     #include "ATM2D_OPTIONS.h"
3    
4     C !INTERFACE:
5     SUBROUTINE INIT_ATM2D(dtatm, dtocn, dtcouple, myThid )
6     C *==========================================================*
7     C | INIT_1DTO2D |
8     C | This initialization routine should be run after the |
9     c | the ocean grid/pickup have been read in. |
10     c | |
11     c | Note: grid variable indices bi,bj are hard-coded 1,1 |
12     c | This should work if coupler or atmos/coupler on one |
13     c | machine. |
14     c | |
15     C *==========================================================*
16     c
17     IMPLICIT NONE
18    
19     C === Global Atmosphere Variables ===
20     #include "ATMSIZE.h"
21 jscott 1.2 #include "AGRID.h"
22 jscott 1.1
23     C === Global Ocean Variables ===
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26     #include "PARAMS.h"
27     #include "GRID.h"
28    
29     C === Global SeaIce Parameters ===
30     #include "THSICE_PARAMS.h"
31    
32     C === Atmos/Ocean/Seaice Interface Variables ===
33     #include "ATM2D_VARS.h"
34    
35    
36     C !INPUT/OUTPUT PARAMETERS:
37     C === Routine arguments ===
38     C dtatm, dtocn, dtcouple - Timesteps from couple.nml (hours)
39     C myThid - Thread no. that called this routine.
40     INTEGER dtatm, dtocn, dtcouple
41     INTEGER myThid
42    
43     C LOCAL VARIABLES:
44     INTEGER i,j,jj
45     INTEGER ib, ibj1, ibj2
46     INTEGER j_atm, mn
47 jscott 1.2 INTEGER dUnit
48 jscott 1.1 _RL end1, end2
49 jscott 1.2 _RL totrun_b(sNy)
50 jscott 1.1 _RL a1,a2
51 jscott 1.2 _RS atm_dyG(jm0)
52 jscott 1.1 DATA atm_dyG/2.0,44*4.0,2.0/
53    
54     dtatmo = dtatm * 3600.
55     dtocno = dtocn * 3600.
56     dtcouplo= dtcouple * 3600.
57    
58     C override data.ice seaice time step parms
59     C these will need to change if coupling procedure changed
60     thSice_deltaT = dtcouplo
61     thsIce_dtTemp = dtatmo
62     ocean_deltaT = dtcouplo
63    
64     CJRS This next check - only kill it if not MPI?
65     IF (dtocno.NE.dTtracerLev(1)) THEN
66     PRINT *,'Ocean tracer timestep differs between coupler '
67     PRINT *,'and the ocean data file'
68     STOP
69     ENDIF
70    
71     c Assuming the atmospheric grid array not passed, do this:
72     atm_yG(1)=-90.0
73     DO j_atm=2,jm0
74     atm_yG(j_atm)=atm_yG(j_atm-1)+atm_dyG(j_atm-1)
75     atm_yC(j_atm-1)=(atm_yG(j_atm-1)+atm_yG(j_atm))/2.0
76     ENDDO
77     atm_yC(jm0)=atm_yG(jm0)+atm_dyG(jm0)/2.0
78    
79     c end atmos grid initialization
80    
81     atm_oc_ind(1)=2
82     atm_oc_wgt(1)=1. _d 0
83     atm_oc_ind(sNy)=jm0-1
84     atm_oc_wgt(sNy)=1. _d 0
85    
86     DO j=2, sNy-1
87    
88     DO jj=2,jm0-1
89     IF ((yG(1,j,1,1).ge.atm_yG(jj)).AND.
90     & (yG(1,j,1,1).lt.atm_yG(jj+1))) j_atm=jj
91     ENDDO
92    
93     atm_oc_ind(j)=j_atm
94     IF ( yG(1,j+1,1,1) .gt. atm_yG(j_atm+1) ) THEN
95     end1= sin(yG(1,j,1,1) *deg2rad)
96     end2= sin(yG(1,j+1,1,1) *deg2rad)
97     atm_oc_wgt(j)=(sin(atm_yG(j_atm+1) *deg2rad)-end1)/
98     & (end2-end1)
99     ELSE
100     atm_oc_wgt(j)=1. _d 0
101     ENDIF
102     ENDDO
103    
104     c
105     c find land fraction
106     c
107     DO j_atm=1,jm0
108     cflan(j_atm)=0. _d 0
109     ocnArea(j_atm)=0. _d 0
110     ENDDO
111    
112     DO j=1,sNy
113     DO i=1,sNx
114     IF (maskC(i,j,1,1,1).EQ.1.) THEN
115     ocnArea(atm_oc_ind(j))=ocnArea(atm_oc_ind(j)) +
116     & rA(i,j,1,1)*atm_oc_wgt(j)
117     IF (atm_oc_wgt(j).lt.1.d0) THEN
118     ocnArea(atm_oc_ind(j)+1)=ocnArea(atm_oc_ind(j)+1) +
119     & rA(i,j,1,1)*(1.d0-atm_oc_wgt(j))
120     ENDIF
121     ENDIF
122     ENDDO
123     ENDDO
124    
125     DO j_atm=3,jm0-2
126     cflan(j_atm)=1. _d 0 - ocnArea(j_atm) /
127     & (2. _d 0 * PI * 6.37 _d 6 * 6.37 _d 6 *
128     & (sin(atm_yG(j_atm+1)*deg2rad) - sin(atm_yG(j_atm)*deg2rad)))
129     if (cflan(j_atm).LT.1. _d -14) cflan(j_atm)=0. _d 0
130     ENDDO
131    
132     C deal with the combined atmos grid end cells...
133     cflan(2)= 1. _d 0 - ocnArea(2) /
134     & (2. _d 0*PI*6.37 _d 6*6.37 _d 6*
135     & (sin(atm_yG(3)*deg2rad)+1. _d 0))
136     IF (cflan(2).LT.1. _d -14) cflan(2)=0. _d 0
137     cflan(1)=cflan(2)
138     cflan(jm0-1)= 1.d0 - ocnArea(jm0-1) /
139     & (2. _d 0*PI*6.37 _d 6*6.37 _d 6*
140     & (1. _d 0-sin(atm_yG(jm0-1)*deg2rad)))
141     IF (cflan(jm0-1).LT.1. _d -14) cflan(jm0-1)=0. _d 0
142     cflan(jm0)=cflan(jm0-1)
143    
144     PRINT *,'Land fractions on atmospheric grid: '
145     PRINT *, cflan
146     PRINT *,'Lookup grid index, weights:'
147     PRINT *, atm_oc_ind,atm_oc_wgt
148    
149     c
150     c read in mean 1D atmos wind files -- store in memory
151     c
152     DO j_atm=1,jm0
153     DO mn=1,nForcingPer
154     atau(j_atm,mn)=0. _d 0
155     atav(j_atm,mn)=0. _d 0
156     awind(j_atm,mn)=0. _d 0
157     ENDDO
158     ENDDO
159    
160 jscott 1.2 CALL MDSFINDUNIT( dUnit, myThid )
161    
162 jscott 1.1 IF ( atmosTauuFile .NE. ' ' ) THEN
163 jscott 1.2 OPEN(dUnit, FILE=atmosTauuFile,STATUS='old',
164 jscott 1.1 & ACCESS='direct', RECL=8*jm0*nForcingPer,
165     & FORM='unformatted')
166 jscott 1.2 READ(dUnit,REC=1), atau
167     CLOSE(dUnit)
168 jscott 1.1 ENDIF
169    
170     IF ( atmosTauvFile .NE. ' ' ) THEN
171 jscott 1.2 OPEN(dUnit, FILE=atmosTauvFile, STATUS='old',
172 jscott 1.1 & ACCESS='direct', RECL=8*jm0*nForcingPer,
173     & FORM='unformatted')
174 jscott 1.2 READ(dUnit, REC=1), atav
175     CLOSE(dUnit)
176 jscott 1.1 ENDIF
177    
178     IF ( atmosWindFile .NE. ' ' ) THEN
179 jscott 1.2 OPEN(dUnit, FILE=atmosWindFile, STATUS='old',
180 jscott 1.1 & ACCESS='direct', RECL=8*jm0*nForcingPer,
181     & FORM='unformatted')
182 jscott 1.2 READ(dUnit, REC=1), awind
183     CLOSE(dUnit)
184 jscott 1.1 ENDIF
185    
186     C The polar data point values for winds are effectively N/A given the
187     C pole issue... although they are read in here, they are never used in
188     C any calculations, as the polar ocean points access the data at atmos
189     C 2 and jm0-1 points.
190    
191    
192     c read in runoff data
193     c to put runoff into specific grid cells
194     c
195     IF ( runoffMapFile .NE. ' ' ) THEN
196     CALL READ_FLD_XY_RL( runoffMapFile, ' ',
197     & runoffVal, 0, myThid )
198     ELSE
199     DO j=1,sNy
200     DO i=1,sNx
201     if ( (maskC(i,j,1,1,1).EQ.1.) .AND.
202     & ( (maskC(i-1,j,1,1,1).EQ.0.).OR.
203     & (maskC(i+1,j,1,1,1).EQ.0.).OR.
204     & (maskC(i,j-1,1,1,1).EQ.0.).OR.
205     & (maskC(i,j+1,1,1,1).EQ.0.).OR.
206     & (maskC(i+1,j+1,1,1,1).EQ.0.).OR.
207     & (maskC(i-1,j-1,1,1,1).EQ.0.).OR.
208     & (maskC(i+1,j-1,1,1,1).EQ.0.).OR.
209     & (maskC(i-1,j+1,1,1,1).EQ.0.) ) ) THEN
210     runoffVal(i,j)=1. _d 0
211     ENDIF
212     ENDDO
213     ENDDO
214     ENDIF
215    
216     DO ib=1,numBands
217     ibj1=1
218     if (ib.GT.1) ibj1= rband(ib-1)+1
219     ibj2=sNy
220     if (ib.LT.numBands) ibj2= rband(ib)
221     totrun_b(ib)=0.d0
222     DO j=ibj1,ibj2
223     DO i=1,sNx
224     totrun_b(ib)=totrun_b(ib)+runoffVal(i,j)*maskC(i,j,1,1,1)
225     ENDDO
226     ENDDO
227     DO j=ibj1,ibj2
228     runIndex(j)= ib ! for lookup of rband as fn. of latitude
229     DO i=1,sNx
230     runoffVal(i,j)=runoffVal(i,j)*maskC(i,j,1,1,1)/totrun_b(ib)
231     ENDDO
232     ENDDO
233     ENDDO
234    
235     CALL INIT_SUMVARS(myThid)
236    
237     C Initialize 1D diagnostic variables
238     DO j_atm=1,jm0
239     DO mn=1,nForcingPer
240     sum_tauu_ta(j_atm,mn)= 0. _d 0
241     sum_tauv_ta(j_atm,mn)= 0. _d 0
242     sum_wsocean_ta(j_atm,mn)= 0. _d 0
243     sum_ps4ocean_ta(j_atm,mn)= 0. _d 0
244     ENDDO
245     ENDDO
246    
247     C Initialize 2D diagnostic variables
248     DO i=1-OLx,sNx+OLx
249     DO j=1-OLy,sNy+OLy
250     DO mn=1,nForcingPer
251     qnet_atm_ta(i,j,mn)= 0. _d 0
252     evap_atm_ta(i,j,mn)= 0. _d 0
253     precip_atm_ta(i,j,mn)= 0. _d 0
254     runoff_atm_ta(i,j,mn)= 0. _d 0
255     sum_qrel_ta(i,j,mn)= 0. _d 0
256     sum_frel_ta(i,j,mn)= 0. _d 0
257 jscott 1.2 sum_iceMask_ta(i,j,mn)= 0. _d 0
258     sum_iceHeight_ta(i,j,mn)= 0. _d 0
259     sum_iceTime_ta(i,j,mn)= 0. _d 0
260     sum_oceMxLT_ta(i,j,mn)= 0. _d 0
261     sum_oceMxLS_ta(i,j,mn)= 0. _d 0
262 jscott 1.1 ENDDO
263     qnet_atm(i,j)= 0. _d 0
264     evap_atm(i,j)= 0. _d 0
265     precip_atm(i,j)= 0. _d 0
266     runoff_atm(i,j)= 0. _d 0
267     sum_qrel(i,j)= 0. _d 0
268     sum_frel(i,j)= 0. _d 0
269 jscott 1.2 sum_iceMask(i,j)= 0. _d 0
270     sum_iceHeight(i,j)= 0. _d 0
271     sum_iceTime(i,j)= 0. _d 0
272     sum_oceMxLT(i,j)= 0. _d 0
273     sum_oceMxLS(i,j)= 0. _d 0
274 jscott 1.1 ENDDO
275     ENDDO
276    
277     C Initialize following for safety and/or cold start
278     DO i=1-OLx,sNx+OLx
279     DO j=1-OLy,sNy+OLy
280     pass_runoff(i,j)= 0. _d 0
281     pass_qnet(i,j)= 0. _d 0
282     pass_evap(i,j)= 0. _d 0
283     pass_precip(i,j)= 0. _d 0
284     pass_fu(i,j)= 0. _d 0
285     pass_fv(i,j)= 0. _d 0
286     pass_wspeed(i,j)= 0. _d 0
287     pass_solarnet(i,j)= 0. _d 0
288     pass_slp(i,j)= 0. _d 0
289     pass_siceLoad(i,j)= 0. _d 0
290     pass_pCO2(i,j)= 0. _d 0
291     pass_prcAtm(i,j)= 0. _d 0
292     sFluxFromIce(i,j)= 0. _d 0
293     ENDDO
294     ENDDO
295    
296     RETURN
297     END
298    

  ViewVC Help
Powered by ViewVC 1.1.22