source: LMDZ6/trunk/libf/phylmd/Dust/condsurfs_new.f90 @ 5277

Last change on this file since 5277 was 5271, checked in by abarral, 34 hours ago

Move dimensions.h into a module
Nb: doesn't compile yet
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 mod_grid_phy_lmdz
9  USE mod_phys_lmdz_para
10  USE dimphy
11  USE netcdf, ONLY: nf90_get_var, nf90_inq_varid, nf90_close, nf90_noerr, nf90_open, nf90_nowrite
12  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
13IMPLICIT none
14  !
15  ! Lire les conditions aux limites du modele pour la chimie.
16  ! --------------------------------------------------------
17  !
18
19  !
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
37  !
38  INTEGER :: jour, i
39  INTEGER :: ierr
40  INTEGER :: nid,nvarid
41  INTEGER :: debut(2),epais(2)
42  !
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
54  ! 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 = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
65  if (ierr.ne.nf90_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 = nf90_inq_varid(nid, "SO2FF_LOW", nvarid)
75  ierr = nf90_get_var(nid, nvarid,lmt_so2b_glo, debut, epais)
76  IF (ierr .NE. nf90_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 = nf90_inq_varid(nid, "SO2FF_HIGH", nvarid)
87  ierr = nf90_get_var(nid, nvarid,lmt_so2h_glo, debut, epais)
88  IF (ierr .NE. nf90_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 = nf90_inq_varid(nid, "SO2BBH", nvarid)
96  ierr = nf90_get_var(nid, nvarid, lmt_so2bb_h_glo, debut, &
97        epais)
98  IF (ierr .NE. nf90_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 = nf90_inq_varid(nid, "SO2BBL", nvarid)
106  ierr = nf90_get_var(nid, nvarid, lmt_so2bb_l_glo, debut, &
107        epais)
108  IF (ierr .NE. nf90_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 = nf90_inq_varid(nid, "SO2BA", nvarid)
116  ierr = nf90_get_var(nid, nvarid,lmt_so2ba_glo, debut,epais)
117  IF (ierr .NE. nf90_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 = nf90_inq_varid(nid, "SO2NFF", nvarid)
125  ierr = nf90_get_var(nid, nvarid, &
126        lmt_so2nff_glo, debut, epais)
127  IF (ierr .NE. nf90_noerr) THEN
128    PRINT*, 'Pb de lecture pour les sources so2 non FF'
129    CALL exit(1)
130  ENDIF
131  !
132  ierr = nf90_close(nid)
133  !
134  !=======================================================================
135                   ! READING NATURAL EMISSIONS
136  !=======================================================================
137  ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
138  if (ierr.ne.nf90_noerr) then
139    write(6,*)' Pb d''ouverture du fichier sulphur_emissions_nat'
140    write(6,*)' ierr = ', ierr
141    call exit(1)
142  endif
143  !
144  ! Biologenic source of DMS
145  !
146  ierr = nf90_inq_varid(nid, "DMSB", nvarid)
147  ierr = nf90_get_var(nid, nvarid,lmt_dmsbio_glo,debut,epais)
148  IF (ierr .NE. nf90_noerr) THEN
149     PRINT*, 'Pb de lecture pour les sources dms bio'
150     CALL exit(1)
151  ENDIF
152  !
153  ! Biologenic source of H2S
154  !
155  ierr = nf90_inq_varid(nid, "H2SB", nvarid)
156  ierr = nf90_get_var(nid, nvarid,lmt_h2sbio_glo,debut,epais)
157  IF (ierr .NE. nf90_noerr) THEN
158     PRINT*, 'Pb de lecture pour les sources h2s bio'
159     CALL exit(1)
160  ENDIF
161  !
162  ! Ocean surface concentration of dms (emissions are computed later)
163  !
164  IF (flag_dms.EQ.4) THEN
165  !
166  ierr = nf90_inq_varid(nid, "DMSC2", nvarid)
167  ierr = nf90_get_var(nid,nvarid,lmt_dmsconc_glo,debut,epais)
168  IF (ierr .NE. nf90_noerr) THEN
169     PRINT*, 'Pb de lecture pour les sources dms conc 2'
170     CALL exit(1)
171  ENDIF
172  !
173  DO i=1, klon
174      ! lmt_dms(i)=0.0
175     lmt_dms_glo(i)=0.0
176  ENDDO
177  !
178  ELSE
179  !
180     PRINT *,'choix non possible pour flag_dms'
181     STOP
182
183  ENDIF
184  !
185  ierr = nf90_close(nid)
186  !
187  !=======================================================================
188  !                  READING VOLCANIC EMISSIONS
189  !=======================================================================
190  print *,'   ***      READING VOLCANIC EMISSIONS   ***   '
191  print *,' Jour = ',jour
192  ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
193  if (ierr.ne.nf90_noerr) then
194    write(6,*)' Pb d''ouverture du fichier sulphur_emissions_volc'
195    write(6,*)' ierr = ', ierr
196    call exit(1)
197  endif
198  !
199  ! Continuous Volcanic emissions
200  !
201  !  ierr = nf90_inq_varid(nid, "VOLC", nvarid)
202  ierr = nf90_inq_varid(nid, "flx_volc_cont", nvarid)
203  ierr = nf90_get_var(nid, nvarid, &
204        lmt_so2volc_cont_glo, debut, epais)
205  IF (ierr .NE. nf90_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
212  !
213  ! Altitud of continuous volcanic emissions
214  !
215  !  ierr = nf90_inq_varid(nid, "ALTI", nvarid)
216  ierr = nf90_inq_varid(nid, "flx_volc_altcont", nvarid)
217  ierr = nf90_get_var(nid, nvarid, &
218        lmt_altvolc_cont_glo, debut, epais)
219  IF (ierr .NE. nf90_noerr) THEN
220     PRINT*, 'Pb de lecture pour les altitudes volcan (cont)'
221     CALL exit(1)
222  ENDIF
223  !
224  ! Explosive Volcanic emissions
225  !
226  ierr = nf90_inq_varid(nid, "flx_volc_expl", nvarid)
227  ierr = nf90_get_var(nid, nvarid, &
228        lmt_so2volc_expl_glo, debut, epais)
229  IF (ierr .NE. nf90_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)
236  !
237  ! Altitud of explosive volcanic emissions
238  !
239  ierr = nf90_inq_varid(nid, "flx_volc_altexpl", nvarid)
240  ierr = nf90_get_var(nid, nvarid, &
241        lmt_altvolc_expl_glo, debut, epais)
242  IF (ierr .NE. nf90_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 = nf90_close(nid)
249  !
250  PRINT*, 'Sources SOUFRE lues pour jour: ', jour
251  !
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
274END SUBROUTINE condsurfs_new
Note: See TracBrowser for help on using the repository browser.