source: LMDZ6/trunk/libf/phylmd/Dust/condsurfs_new.F @ 5134

Last change on this file since 5134 was 5084, checked in by Laurent Fairhead, 5 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.