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

Last change on this file since 4898 was 4593, checked in by yann meurdesoif, 17 months ago

Replace #include (c preprocessor) by INCLUDE (fortran keyword)

in phylmd (except rrtm and ecrad) filtrez, dy3dmem and dyn3dcommon

Other directories will follow
YM
File size: 9.5 KB
RevLine 
[2630]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
[4593]11      INCLUDE "dimensions.h"
12      INCLUDE "netcdf.inc"
[2630]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.