source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/condsurfs_new.F

Last change on this file was 2175, checked in by jescribano, 10 years ago

SPLA code included for first time

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