source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90 @ 5116

Last change on this file since 5116 was 5116, checked in by abarral, 4 months ago

rename modules properly lmdz_*
move ismin, ismax, minmax into new lmdz_libmath.f90
(lint) uppercase fortran keywords
File size: 8.5 KB
Line 
1SUBROUTINE 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 lmdz_grid_phy
9  USE lmdz_phys_para
10  USE dimphy
11  USE netcdf, ONLY: nf90_get_var, nf90_inq_varid, nf90_close, nf90_noerr, nf90_open, nf90_nowrite
12  IMPLICIT none
13
14  ! Lire les conditions aux limites du modele pour la chimie.
15  ! --------------------------------------------------------
16
17  INCLUDE "dimensions.h"
18
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
36
37  INTEGER :: jour, i
38  INTEGER :: ierr
39  INTEGER :: nid, nvarid
40  INTEGER :: debut(2), epais(2)
41
42  IF (jour<0 .OR. jour>(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  !$OMP MASTER
50  IF (is_mpi_root .AND. is_omp_root) THEN
51
52    ! Tranche a lire:
53    debut(1) = 1
54    debut(2) = jour
55    ! epais(1) = klon
56    epais(1) = klon_glo
57    epais(2) = 1
58    !=======================================================================
59    ! READING NEW EMISSIONS FROM RCP
60    !=======================================================================
61
62    ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
63    if (ierr/=nf90_noerr) THEN
64      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'
65      WRITE(6, *)' ierr = ', ierr
66      CALL exit(1)
67    endif
68
69    ! SO2 Low level emissions
70
71    ierr = nf90_inq_varid (nid, "SO2FF_LOW", nvarid)
72    ierr = nf90_get_var(nid, nvarid, lmt_so2b_glo, debut, epais)
73    IF (ierr /= nf90_noerr) THEN
74      PRINT*, 'Pb de lecture pour les sources so2 low'
75      print *, 'JE klon, jour, debut ,epais ', klon_glo, jour, debut, epais
76      CALL HANDLE_ERR(ierr)
77      print *, 'error ierr= ', ierr
78      CALL exit(1)
79    ENDIF
80
81    ! SO2 High level emissions
82
83    ierr = nf90_inq_varid (nid, "SO2FF_HIGH", nvarid)
84    ierr = nf90_get_var(nid, nvarid, lmt_so2h_glo, debut, epais)
85    IF (ierr /= nf90_noerr) THEN
86      PRINT*, 'Pb de lecture pour les sources so2 high'
87      CALL exit(1)
88    ENDIF
89
90    ! SO2 Biomass burning High level emissions
91
92    ierr = nf90_inq_varid (nid, "SO2BBH", nvarid)
93    ierr = nf90_get_var(nid, nvarid, lmt_so2bb_h_glo, debut, epais)
94    IF (ierr /= nf90_noerr) THEN
95      PRINT*, 'Pb de lecture pour les sources so2 BB high'
96      CALL exit(1)
97    ENDIF
98
99    ! SO2 biomass burning low level emissions
100
101    ierr = nf90_inq_varid (nid, "SO2BBL", nvarid)
102    ierr = nf90_get_var(nid, nvarid, lmt_so2bb_l_glo, debut, epais)
103    IF (ierr /= nf90_noerr) THEN
104      PRINT*, 'Pb de lecture pour les sources so2 BB low'
105      CALL exit(1)
106    ENDIF
107
108    ! SO2 ship emissions
109
110    ierr = nf90_inq_varid (nid, "SO2BA", nvarid)
111    ierr = nf90_get_var(nid, nvarid, lmt_so2ba_glo, debut, epais)
112    IF (ierr /= nf90_noerr) THEN
113      PRINT*, 'Pb de lecture pour les sources so2 ship'
114      CALL exit(1)
115    ENDIF
116
117    ! SO2 Non Fossil Fuel Emissions
118
119    ierr = nf90_inq_varid (nid, "SO2NFF", nvarid)
120    ierr = nf90_get_var(nid, nvarid, lmt_so2nff_glo, debut, epais)
121    IF (ierr /= nf90_noerr) THEN
122      PRINT*, 'Pb de lecture pour les sources so2 non FF'
123      CALL exit(1)
124    ENDIF
125
126    ierr = nf90_close(nid)
127
128    !=======================================================================
129    ! READING NATURAL EMISSIONS
130    !=======================================================================
131    ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
132    if (ierr/=nf90_noerr) THEN
133      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'
134      WRITE(6, *)' ierr = ', ierr
135      CALL exit(1)
136    endif
137
138    ! Biologenic source of DMS
139
140    ierr = nf90_inq_varid (nid, "DMSB", nvarid)
141    ierr = nf90_get_var(nid, nvarid, lmt_dmsbio_glo, debut, epais)
142    IF (ierr /= nf90_noerr) THEN
143      PRINT*, 'Pb de lecture pour les sources dms bio'
144      CALL exit(1)
145    ENDIF
146
147    ! Biologenic source of H2S
148
149    ierr = nf90_inq_varid (nid, "H2SB", nvarid)
150    ierr = nf90_get_var(nid, nvarid, lmt_h2sbio_glo, debut, epais)
151    IF (ierr /= nf90_noerr) THEN
152      PRINT*, 'Pb de lecture pour les sources h2s bio'
153      CALL exit(1)
154    ENDIF
155
156    ! Ocean surface concentration of dms (emissions are computed later)
157
158    IF (flag_dms==4) THEN
159
160      ierr = nf90_inq_varid (nid, "DMSC2", nvarid)
161      ierr = nf90_get_var(nid, nvarid, lmt_dmsconc_glo, debut, epais)
162      IF (ierr /= nf90_noerr) THEN
163        PRINT*, 'Pb de lecture pour les sources dms conc 2'
164        CALL exit(1)
165      ENDIF
166
167      DO i = 1, klon
168        ! lmt_dms(i)=0.0
169        lmt_dms_glo(i) = 0.0
170      ENDDO
171
172    ELSE
173
174      PRINT *, 'choix non possible pour flag_dms'
175      STOP
176
177    ENDIF
178
179    ierr = nf90_close(nid)
180
181    !=======================================================================
182    !                  READING VOLCANIC EMISSIONS
183    !=======================================================================
184    print *, '   ***      READING VOLCANIC EMISSIONS   ***   '
185    print *, ' Jour = ', jour
186    ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
187    if (ierr/=nf90_noerr) THEN
188      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'
189      WRITE(6, *)' ierr = ', ierr
190      CALL exit(1)
191    endif
192
193    ! Continuous Volcanic emissions
194
195    !  ierr = nf90_inq_varid (nid, "VOLC", nvarid)
196    ierr = nf90_inq_varid (nid, "flx_volc_cont", nvarid)
197    ierr = nf90_get_var(nid, nvarid, lmt_so2volc_cont_glo, debut, epais)
198    IF (ierr /= nf90_noerr) THEN
199      PRINT*, 'Pb de lecture pour les sources so2 volcan (cont)'
200      CALL exit(1)
201    ENDIF
202    print *, 'SO2 volc cont (in read) = ', SUM(lmt_so2volc_cont_glo), &
203            MINVAL(lmt_so2volc_cont_glo), MAXVAL(lmt_so2volc_cont_glo)
204    ! lmt_so2volc(:)=0.0
205
206    ! Altitud of continuous volcanic emissions
207
208    !  ierr = nf90_inq_varid (nid, "ALTI", nvarid)
209    ierr = nf90_inq_varid (nid, "flx_volc_altcont", nvarid)
210    ierr = nf90_get_var(nid, nvarid, lmt_altvolc_cont_glo, debut, epais)
211    IF (ierr /= nf90_noerr) THEN
212      PRINT*, 'Pb de lecture pour les altitudes volcan (cont)'
213      CALL exit(1)
214    ENDIF
215
216    ! Explosive Volcanic emissions
217
218    ierr = nf90_inq_varid (nid, "flx_volc_expl", nvarid)
219    ierr = nf90_get_var(nid, nvarid, lmt_so2volc_expl_glo, debut, epais)
220    IF (ierr /= nf90_noerr) THEN
221      PRINT*, 'Pb de lecture pour les sources so2 volcan (expl)'
222      CALL exit(1)
223    ENDIF
224    ! lmt_so2volc_expl(:)=0.0
225    print *, 'SO2 volc expl (in read) = ', SUM(lmt_so2volc_expl_glo), &
226            MINVAL(lmt_so2volc_expl_glo), MAXVAL(lmt_so2volc_expl_glo)
227
228    ! Altitud of explosive volcanic emissions
229
230    ierr = nf90_inq_varid (nid, "flx_volc_altexpl", nvarid)
231    ierr = nf90_get_var(nid, nvarid, lmt_altvolc_expl_glo, debut, epais)
232    IF (ierr /= nf90_noerr) THEN
233      PRINT*, 'Pb de lecture pour les altitudes volcan'
234      CALL exit(1)
235    ENDIF
236    ! lmt_altvolc_expl(:)=0.0
237
238    ierr = nf90_close(nid)
239
240    PRINT*, 'Sources SOUFRE lues pour jour: ', jour
241
242  ENDIF
243  !$OMP END MASTER
244  !$OMP BARRIER
245  CALL scatter(lmt_so2b_glo, lmt_so2b)
246  CALL scatter(lmt_so2h_glo, lmt_so2h)
247  CALL scatter(lmt_so2bb_h_glo, lmt_so2bb_h)
248  CALL scatter(lmt_so2bb_l_glo, lmt_so2bb_l)
249  CALL scatter(lmt_so2ba_glo, lmt_so2ba)
250  CALL scatter(lmt_so2nff_glo, lmt_so2nff)
251  CALL scatter(lmt_dmsbio_glo, lmt_dmsbio)
252  CALL scatter(lmt_h2sbio_glo, lmt_h2sbio)
253  CALL scatter(lmt_dmsconc_glo, lmt_dmsconc)
254  CALL scatter(lmt_dms_glo, lmt_dms)
255  CALL scatter(lmt_so2volc_cont_glo, lmt_so2volc_cont)
256  CALL scatter(lmt_altvolc_cont_glo, lmt_altvolc_cont)
257  CALL scatter(lmt_so2volc_expl_glo, lmt_so2volc_expl)
258  CALL scatter(lmt_altvolc_expl_glo, lmt_altvolc_expl)
259
260
261END SUBROUTINE condsurfs_new
Note: See TracBrowser for help on using the repository browser.