source: LMDZ6/trunk/libf/phylmd/Dust/condsurfs_new.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.1 KB
Line 
1      SUBROUTINE condsurfs_new(jour, edgar, flag_dms,
2     .                         lmt_so2b, lmt_so2h, lmt_so2nff,
3     .                         lmt_so2bb_l, lmt_so2bb_h, lmt_so2ba,
4     .                         lmt_so2volc_cont, lmt_altvolc_cont, 
5     .                         lmt_so2volc_expl, lmt_altvolc_expl, 
6     .                         lmt_dmsbio, lmt_h2sbio, lmt_dms,
7     .                                                      lmt_dmsconc)
8      USE mod_grid_phy_lmdz
9      USE mod_phys_lmdz_para
10      USE dimphy
11      IMPLICIT none
12c
13c Lire les conditions aux limites du modele pour la chimie.
14c --------------------------------------------------------
15c
16      INCLUDE "dimensions.h"
17      INCLUDE "netcdf.inc"
18c
19      REAL lmt_so2b(klon), lmt_so2h(klon), lmt_so2nff(klon)
20      REAL lmt_so2bb_l(klon), lmt_so2bb_h(klon)
21      REAL lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon)
22      REAL lmt_so2volc_cont(klon), lmt_altvolc_cont(klon)
23      REAL lmt_so2volc_expl(klon), lmt_altvolc_expl(klon)
24      REAL lmt_dms(klon), lmt_dmsconc(klon)
25
26      REAL lmt_so2b_glo(klon_glo), lmt_so2h_glo(klon_glo)
27      REAL lmt_so2nff_glo(klon_glo)
28      REAL lmt_so2bb_l_glo(klon_glo), lmt_so2bb_h_glo(klon_glo)
29      REAL lmt_dmsbio_glo(klon_glo), lmt_h2sbio_glo(klon_glo)
30      REAL lmt_so2ba_glo(klon_glo)
31      REAL lmt_so2volc_cont_glo(klon_glo),lmt_altvolc_cont_glo(klon_glo)
32      REAL lmt_so2volc_expl_glo(klon_glo),lmt_altvolc_expl_glo(klon_glo)
33      REAL lmt_dms_glo(klon_glo), lmt_dmsconc_glo(klon_glo)
34      LOGICAL edgar
35      INTEGER flag_dms
36c
37      INTEGER jour, i
38      INTEGER ierr
39      INTEGER nid,nvarid
40      INTEGER debut(2),epais(2)
41c
42      IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN
43         PRINT*,'Le jour demande n est pas correcte:', jour
44         print *,'JE: FORCED TO CONTINUE (emissions have
45     . to be longer than 1 year!!!! )'
46!         CALL ABORT
47      ENDIF
48!
49
50!$OMP MASTER
51      IF (is_mpi_root .AND. is_omp_root) THEN
52
53c Tranche a lire:
54      debut(1) = 1
55      debut(2) = jour
56!      epais(1) = klon
57      epais(1) = klon_glo
58      epais(2) = 1
59!=======================================================================
60!                 READING NEW EMISSIONS FROM RCP
61!=======================================================================
62!
63      ierr = NF_OPEN ("sulphur_emissions_antro.nc", NF_NOWRITE, nid)
64      if (ierr.ne.NF_NOERR) then
65        write(6,*)' Pb d''ouverture du fichier sulphur_emissions_antro'
66        write(6,*)' ierr = ', ierr
67        call exit(1)
68      endif
69
70!
71! SO2 Low level emissions
72!
73      ierr = NF_INQ_VARID (nid, "SO2FF_LOW", nvarid)
74      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,lmt_so2b_glo)
75      IF (ierr .NE. NF_NOERR) THEN
76        PRINT*, 'Pb de lecture pour les sources so2 low'
77        print *,'JE klon, jour, debut ,epais ',klon_glo,jour,debut,epais
78        CALL HANDLE_ERR(ierr)
79        print *,'error ierr= ',ierr
80        CALL exit(1)
81      ENDIF
82!
83! SO2 High level emissions
84!
85      ierr = NF_INQ_VARID (nid, "SO2FF_HIGH", nvarid)
86      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,lmt_so2h_glo)
87      IF (ierr .NE. NF_NOERR) THEN
88        PRINT*, 'Pb de lecture pour les sources so2 high'
89        CALL exit(1)
90      ENDIF
91!
92! SO2 Biomass burning High level emissions
93!
94      ierr = NF_INQ_VARID (nid, "SO2BBH", nvarid)
95      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,
96     . epais, lmt_so2bb_h_glo)
97      IF (ierr .NE. NF_NOERR) THEN
98        PRINT*, 'Pb de lecture pour les sources so2 BB high'
99        CALL exit(1)
100      ENDIF
101!
102! SO2 biomass burning low level emissions
103!
104      ierr = NF_INQ_VARID (nid, "SO2BBL", nvarid)
105      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,
106     . epais, lmt_so2bb_l_glo)
107      IF (ierr .NE. NF_NOERR) THEN
108        PRINT*, 'Pb de lecture pour les sources so2 BB low'
109        CALL exit(1)
110      ENDIF
111!
112! SO2 ship emissions
113!
114      ierr = NF_INQ_VARID (nid, "SO2BA", nvarid)
115      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_so2ba_glo)
116      IF (ierr .NE. NF_NOERR) THEN
117        PRINT*, 'Pb de lecture pour les sources so2 ship'
118        CALL exit(1)
119      ENDIF
120!
121! SO2 Non Fossil Fuel Emissions
122!
123      ierr = NF_INQ_VARID (nid, "SO2NFF", nvarid)
124      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
125     .  lmt_so2nff_glo)
126      IF (ierr .NE. NF_NOERR) THEN
127        PRINT*, 'Pb de lecture pour les sources so2 non FF'
128        CALL exit(1)
129      ENDIF
130!
131      ierr = NF_CLOSE(nid)
132!
133!=======================================================================
134!                      READING NATURAL EMISSIONS
135!=======================================================================
136      ierr = NF_OPEN ("sulphur_emissions_nat.nc", NF_NOWRITE, nid)
137      if (ierr.ne.NF_NOERR) then
138        write(6,*)' Pb d''ouverture du fichier sulphur_emissions_nat'
139        write(6,*)' ierr = ', ierr
140        call exit(1)
141      endif
142c
143c Biologenic source of DMS
144c
145      ierr = NF_INQ_VARID (nid, "DMSB", nvarid)
146      ierr = NF_GET_VARA_DOUBLE (nid, nvarid,debut,epais,lmt_dmsbio_glo)
147      IF (ierr .NE. NF_NOERR) THEN
148         PRINT*, 'Pb de lecture pour les sources dms bio'
149         CALL exit(1)
150      ENDIF
151c
152c Biologenic source of H2S
153c
154      ierr = NF_INQ_VARID (nid, "H2SB", nvarid)
155      ierr = NF_GET_VARA_DOUBLE (nid, nvarid,debut,epais,lmt_h2sbio_glo)
156      IF (ierr .NE. NF_NOERR) THEN
157         PRINT*, 'Pb de lecture pour les sources h2s bio'
158         CALL exit(1)
159      ENDIF
160c
161c Ocean surface concentration of dms (emissions are computed later)
162c
163      IF (flag_dms.EQ.4) THEN
164c
165      ierr = NF_INQ_VARID (nid, "DMSC2", nvarid)
166      ierr = NF_GET_VARA_DOUBLE (nid,nvarid,debut,epais,lmt_dmsconc_glo)
167      IF (ierr .NE. NF_NOERR) THEN
168         PRINT*, 'Pb de lecture pour les sources dms conc 2'
169         CALL exit(1)
170      ENDIF
171c
172      DO i=1, klon
173!         lmt_dms(i)=0.0
174         lmt_dms_glo(i)=0.0
175      ENDDO
176c
177      ELSE
178c
179         PRINT *,'choix non possible pour flag_dms'
180         STOP
181
182      ENDIF
183c
184      ierr = NF_CLOSE(nid)
185c
186!=======================================================================
187!                      READING VOLCANIC EMISSIONS
188!=======================================================================
189      print *,'   ***      READING VOLCANIC EMISSIONS   ***   '
190      print *,' Jour = ',jour
191      ierr = NF_OPEN ("sulphur_emissions_volc.nc", NF_NOWRITE, nid)
192      if (ierr.ne.NF_NOERR) then
193        write(6,*)' Pb d''ouverture du fichier sulphur_emissions_volc'
194        write(6,*)' ierr = ', ierr
195        call exit(1)
196      endif
197c
198c Continuous Volcanic emissions
199c
200!      ierr = NF_INQ_VARID (nid, "VOLC", nvarid)
201      ierr = NF_INQ_VARID (nid, "flx_volc_cont", nvarid)
202      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
203     .                           lmt_so2volc_cont_glo)
204      IF (ierr .NE. NF_NOERR) THEN
205         PRINT*, 'Pb de lecture pour les sources so2 volcan (cont)'
206         CALL exit(1)
207      ENDIF
208      print *,'SO2 volc cont (in read) = ',SUM(lmt_so2volc_cont_glo),
209     +      MINVAL(lmt_so2volc_cont_glo),MAXVAL(lmt_so2volc_cont_glo)
210!      lmt_so2volc(:)=0.0
211c
212c Altitud of continuous volcanic emissions
213c
214!      ierr = NF_INQ_VARID (nid, "ALTI", nvarid)
215      ierr = NF_INQ_VARID (nid, "flx_volc_altcont", nvarid)
216      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
217     .                           lmt_altvolc_cont_glo)
218      IF (ierr .NE. NF_NOERR) THEN
219         PRINT*, 'Pb de lecture pour les altitudes volcan (cont)'
220         CALL exit(1)
221      ENDIF
222c
223c Explosive Volcanic emissions
224c
225      ierr = NF_INQ_VARID (nid, "flx_volc_expl", nvarid)
226      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
227     .                           lmt_so2volc_expl_glo)
228      IF (ierr .NE. NF_NOERR) THEN
229         PRINT*, 'Pb de lecture pour les sources so2 volcan (expl)'
230         CALL exit(1)
231      ENDIF
232!      lmt_so2volc_expl(:)=0.0
233      print *,'SO2 volc expl (in read) = ',SUM(lmt_so2volc_expl_glo),
234     +      MINVAL(lmt_so2volc_expl_glo),MAXVAL(lmt_so2volc_expl_glo)
235c
236c Altitud of explosive volcanic emissions
237c
238      ierr = NF_INQ_VARID (nid, "flx_volc_altexpl", nvarid)
239      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
240     .                           lmt_altvolc_expl_glo)
241      IF (ierr .NE. NF_NOERR) THEN
242         PRINT*, 'Pb de lecture pour les altitudes volcan'
243         CALL exit(1)
244      ENDIF
245!      lmt_altvolc_expl(:)=0.0
246
247      ierr = NF_CLOSE(nid)
248c
249      PRINT*, 'Sources SOUFRE lues pour jour: ', jour
250c
251
252
253      ENDIF
254!$OMP END MASTER
255!$OMP BARRIER
256      call scatter( lmt_so2b_glo        , lmt_so2b )
257      call scatter(lmt_so2h_glo         , lmt_so2h ) 
258      call scatter(lmt_so2bb_h_glo      , lmt_so2bb_h )
259      call scatter(lmt_so2bb_l_glo      , lmt_so2bb_l)
260      call scatter(lmt_so2ba_glo        , lmt_so2ba)
261      call scatter(lmt_so2nff_glo       , lmt_so2nff)
262      call scatter(lmt_dmsbio_glo       , lmt_dmsbio)
263      call scatter(lmt_h2sbio_glo       , lmt_h2sbio)
264      call scatter(lmt_dmsconc_glo      , lmt_dmsconc)
265      call scatter(lmt_dms_glo          , lmt_dms)
266      call scatter(lmt_so2volc_cont_glo , lmt_so2volc_cont)
267      call scatter(lmt_altvolc_cont_glo , lmt_altvolc_cont)
268      call scatter(lmt_so2volc_expl_glo , lmt_so2volc_expl)
269      call scatter(lmt_altvolc_expl_glo , lmt_altvolc_expl)
270
271
272      RETURN
273      END
Note: See TracBrowser for help on using the repository browser.