source: LMDZ6/trunk/libf/phylmd/Dust/condsurfs.F @ 5210

Last change on this file since 5210 was 5084, checked in by Laurent Fairhead, 12 months ago

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