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

Last change on this file since 5300 was 5271, checked in by abarral, 5 weeks ago

Move dimensions.h into a module
Nb: doesn't compile yet

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