source: LMDZ6/trunk/libf/phylmd/Dust/condsurfs.f90 @ 5411

Last change on this file since 5411 was 5337, checked in by Laurent Fairhead, 6 weeks ago

Getting rid of dependance to dynamics
File size: 8.9 KB
Line 
1SUBROUTINE condsurfs(jour, edgar, flag_dms, &
2        lmt_so2h, lmt_so2b, lmt_so2bb, lmt_so2ba, &
3        lmt_so2volc, lmt_altvolc, &
4        lmt_dmsbio, lmt_h2sbio, lmt_dms, lmt_dmsconc)
5   USE dimphy
6   USE netcdf, ONLY: nf90_close, nf90_noerr, nf90_inq_varid, nf90_open, &
7          nf90_nowrite, nf90_get_var
8IMPLICIT none
9  !
10  ! Lire les conditions aux limites du modele pour la chimie.
11  ! --------------------------------------------------------
12  !
13
14  !
15  REAL :: lmt_so2h(klon), lmt_so2b(klon), lmt_so2bb(klon)
16  REAL :: lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon)
17  REAL :: lmt_so2volc(klon), lmt_altvolc(klon)
18  REAL :: lmt_dms(klon), lmt_dmsconc(klon)
19  LOGICAL :: edgar
20  INTEGER :: flag_dms
21  !
22  INTEGER :: jour, i
23  INTEGER :: ierr
24  INTEGER :: nid,nvarid
25  INTEGER :: debut(2),epais(2)
26  !
27  IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN
28     IF ((jour.GT.(360-1)) .AND. (jour.LE.367)) THEN
29       jour=360-1
30       print *,'JE: jour changed to jour= ',jour
31     ELSE
32       PRINT*,'Le jour demande n est pas correcte:', jour
33       CALL ABORT
34     ENDIF
35  ENDIF
36  !
37  ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid)
38  if (ierr.ne.nf90_noerr) then
39    write(6,*)' Pb d''ouverture du fichier limitsoufre.nc'
40    write(6,*)' ierr = ', ierr
41    call exit(1)
42  endif
43  !
44  ! Tranche a lire:
45  debut(1) = 1
46  debut(2) = jour+1
47  epais(1) = klon
48  epais(2) = 1
49  !
50  ierr = nf90_inq_varid(nid, "VOLC", nvarid)
51  !nhl #ifdef NC_DOUBLE
52  ierr = nf90_get_var(nid, nvarid, lmt_so2volc, debut, epais)
53  !nhl #else
54  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2volc, debut, epais)
55  !nhl #endif
56  IF (ierr .NE. nf90_noerr) THEN
57     PRINT*, 'Pb de lecture pour les sources so2 volcan'
58     CALL exit(1)
59  ENDIF
60  !
61  ierr = nf90_inq_varid(nid, "ALTI", nvarid)
62  !nhl #ifdef NC_DOUBLE
63  ierr = nf90_get_var(nid, nvarid, lmt_altvolc, debut, epais)
64  !nhl #else
65  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_altvolc, debut, epais)
66  !nhl #endif
67  IF (ierr .NE. nf90_noerr) THEN
68     PRINT*, 'Pb de lecture pour les altitudes volcan'
69     CALL exit(1)
70  ENDIF
71  !
72  IF (edgar) THEN   !--EDGAR w/o ship and biomass burning
73  !
74  ierr = nf90_inq_varid(nid, "SO2ED95L", nvarid)
75  !nhl #ifdef NC_DOUBLE
76  ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
77  !nhl #else
78  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
79  !nhl #endif
80  IF (ierr .NE. nf90_noerr) THEN
81     PRINT*, 'Pb de lecture pour les sources so2 edgar low'
82     CALL exit(1)
83  ENDIF
84  !
85  ierr = nf90_inq_varid(nid, "SO2ED95H", nvarid)
86  !nhl #ifdef NC_DOUBLE
87  ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
88  !nhl #else
89  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
90  !nhl #endif
91  IF (ierr .NE. nf90_noerr) THEN
92     PRINT*, 'Pb de lecture pour les sources so2 edgar high'
93     CALL exit(1)
94  ENDIF
95  !
96  ELSE  !--GEIA
97  !
98  ierr = nf90_inq_varid(nid, "SO2H", nvarid)
99  !nhl #ifdef NC_DOUBLE
100  ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
101  !nhl #else
102  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
103  !nhl #endif
104  IF (ierr .NE. nf90_noerr) THEN
105     PRINT*, 'Pb de lecture pour les sources so2 haut'
106     CALL exit(1)
107  ENDIF
108  !
109  ierr = nf90_inq_varid(nid, "SO2B", nvarid)
110  !nhl #ifdef NC_DOUBLE
111  ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
112  !nhl #else
113  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
114  !nhl #endif
115  IF (ierr .NE. nf90_noerr) THEN
116     PRINT*, 'Pb de lecture pour les sources so2 bas'
117     CALL exit(1)
118  ENDIF
119  !
120  ENDIF  !--edgar
121  !
122  ierr = nf90_inq_varid(nid, "SO2BB", nvarid)
123  !nhl #ifdef NC_DOUBLE
124  ierr = nf90_get_var(nid, nvarid, lmt_so2bb, debut, epais)
125  !nhl #else
126  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2bb, debut, epais)
127  !nhl #endif
128  IF (ierr .NE. nf90_noerr) THEN
129     PRINT*, 'Pb de lecture pour les sources so2 bb'
130     CALL exit(1)
131  ENDIF
132  !
133  ierr = nf90_inq_varid(nid, "SO2BA", nvarid)
134  !nhl #ifdef NC_DOUBLE
135  ierr = nf90_get_var(nid, nvarid, lmt_so2ba, debut, epais)
136  !nhl #else
137  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_so2ba, debut, epais)
138  !nhl #endif
139  IF (ierr .NE. nf90_noerr) THEN
140     PRINT*, 'Pb de lecture pour les sources so2 bateau'
141     CALL exit(1)
142  ENDIF
143  !
144  ierr = nf90_inq_varid(nid, "DMSB", nvarid)
145  !nhl #ifdef NC_DOUBLE
146  ierr = nf90_get_var(nid, nvarid, lmt_dmsbio, debut, epais)
147  !nhl #else
148  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsbio, debut, epais)
149  !nhl #endif
150  IF (ierr .NE. nf90_noerr) THEN
151     PRINT*, 'Pb de lecture pour les sources dms bio'
152     CALL exit(1)
153  ENDIF
154  !
155  ierr = nf90_inq_varid(nid, "H2SB", nvarid)
156  !nhl #ifdef NC_DOUBLE
157  ierr = nf90_get_var(nid, nvarid, lmt_h2sbio, debut, epais)
158  !nhl #else
159  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_h2sbio, debut, epais)
160  !nhl #endif
161  IF (ierr .NE. nf90_noerr) THEN
162     PRINT*, 'Pb de lecture pour les sources h2s bio'
163     CALL exit(1)
164  ENDIF
165  !
166  IF (flag_dms.EQ.1) THEN
167  !
168  ierr = nf90_inq_varid(nid, "DMSL", nvarid)
169  !nhl #ifdef NC_DOUBLE
170  ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
171  !nhl #else
172  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
173  !nhl #endif
174  IF (ierr .NE. nf90_noerr) THEN
175     PRINT*, 'Pb de lecture pour les sources dms liss'
176     CALL exit(1)
177  ENDIF
178  !
179  ELSEIF (flag_dms.EQ.2) THEN
180  !
181  ierr = nf90_inq_varid(nid, "DMSW", nvarid)
182  !nhl #ifdef NC_DOUBLE
183  ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
184  !nhl #else
185  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
186  !nhl #endif
187  IF (ierr .NE. nf90_noerr) THEN
188     PRINT*, 'Pb de lecture pour les sources dms wann'
189     CALL exit(1)
190  ENDIF
191  !
192  ELSEIF (flag_dms.EQ.3) THEN
193  !
194  ierr = nf90_inq_varid(nid, "DMSC1", nvarid)
195  !nhl #ifdef NC_DOUBLE
196  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
197  !nhl #else
198  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
199  !nhl #endif
200  IF (ierr .NE. nf90_noerr) THEN
201     PRINT*, 'Pb de lecture pour les sources dmsconc old'
202     CALL exit(1)
203  ENDIF
204  !
205  ELSEIF (flag_dms.EQ.4) THEN
206  !
207  ierr = nf90_inq_varid(nid, "DMSC2", nvarid)
208  !nhl #ifdef NC_DOUBLE
209  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
210  !nhl #else
211  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
212  !nhl #endif
213  IF (ierr .NE. nf90_noerr) THEN
214     PRINT*, 'Pb de lecture pour les sources dms conc 2'
215     CALL exit(1)
216  ENDIF
217  !
218  ELSEIF (flag_dms.EQ.5) THEN
219  !
220  ierr = nf90_inq_varid(nid, "DMSC3", nvarid)
221  !nhl #ifdef NC_DOUBLE
222  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
223  !nhl #else
224  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
225  !nhl #endif
226  IF (ierr .NE. nf90_noerr) THEN
227     PRINT*, 'Pb de lecture pour les sources dms conc 3'
228     CALL exit(1)
229  ENDIF
230  !
231  ELSEIF (flag_dms.EQ.6) THEN
232  !
233  ierr = nf90_inq_varid(nid, "DMSC4", nvarid)
234  !nhl #ifdef NC_DOUBLE
235  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
236  !nhl #else
237  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
238  !nhl #endif
239  IF (ierr .NE. nf90_noerr) THEN
240     PRINT*, 'Pb de lecture pour les sources dms conc 4'
241     CALL exit(1)
242  ENDIF
243  !
244  ELSEIF (flag_dms.EQ.7) THEN
245  !
246  ierr = nf90_inq_varid(nid, "DMSC5", nvarid)
247  !nhl #ifdef NC_DOUBLE
248  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
249  !nhl #else
250  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
251  !nhl #endif
252  IF (ierr .NE. nf90_noerr) THEN
253     PRINT*, 'Pb de lecture pour les sources dms conc 5'
254     CALL exit(1)
255  ENDIF
256  !
257  ELSEIF (flag_dms.EQ.8) THEN
258  !
259  ierr = nf90_inq_varid(nid, "DMSC6", nvarid)
260  !nhl #ifdef NC_DOUBLE
261  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
262  !nhl #else
263  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
264  !nhl #endif
265  IF (ierr .NE. nf90_noerr) THEN
266     PRINT*, 'Pb de lecture pour les sources dms conc 6'
267     CALL exit(1)
268  ENDIF
269  !
270  ELSEIF (flag_dms.EQ.9) THEN
271  !
272  ierr = nf90_inq_varid(nid, "DMSC7", nvarid)
273  !nhl #ifdef NC_DOUBLE
274  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
275  !nhl #else
276  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
277  !nhl #endif
278  IF (ierr .NE. nf90_noerr) THEN
279     PRINT*, 'Pb de lecture pour les sources dms conc 7'
280     CALL exit(1)
281  ENDIF
282  !
283  ELSEIF (flag_dms.EQ.10) THEN
284  !
285  ierr = nf90_inq_varid(nid, "DMSC8", nvarid)
286  !nhl #ifdef NC_DOUBLE
287  ierr = nf90_get_var(nid, nvarid,lmt_dmsconc, debut,epais)
288  !nhl #else
289  !nhl       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
290  !nhl #endif
291  IF (ierr .NE. nf90_noerr) THEN
292     PRINT*, 'Pb de lecture pour les sources dms conc 8'
293     CALL exit(1)
294  ENDIF
295  !
296  ELSE
297  !
298     PRINT *,'choix non possible pour flag_dms'
299     STOP
300  !
301  ENDIF
302  !
303  ierr = nf90_close(nid)
304  !
305  IF (flag_dms.LE.2) THEN
306  DO i=1, klon
307     lmt_dmsconc(i)=0.0
308  ENDDO
309  ELSE
310  DO i=1, klon
311     lmt_dms(i)=0.0
312  ENDDO
313  ENDIF
314  !
315  PRINT*, 'Sources SOUFRE lues pour jour: ', jour
316  !
317  RETURN
318END SUBROUTINE condsurfs
Note: See TracBrowser for help on using the repository browser.