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

Last change on this file since 5267 was 5246, checked in by abarral, 4 days ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)
File size: 8.4 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  IMPLICIT none
12  !
13  ! Lire les conditions aux limites du modele pour la chimie.
14  ! --------------------------------------------------------
15  !
16  INCLUDE "dimensions.h"
17  INCLUDE "netcdf.inc"
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.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
53  ! 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
142  !
143  ! Biologenic source of DMS
144  !
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
151  !
152  ! Biologenic source of H2S
153  !
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
160  !
161  ! Ocean surface concentration of dms (emissions are computed later)
162  !
163  IF (flag_dms.EQ.4) THEN
164  !
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
171  !
172  DO i=1, klon
173      ! lmt_dms(i)=0.0
174     lmt_dms_glo(i)=0.0
175  ENDDO
176  !
177  ELSE
178  !
179     PRINT *,'choix non possible pour flag_dms'
180     STOP
181
182  ENDIF
183  !
184  ierr = NF_CLOSE(nid)
185  !
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
197  !
198  ! Continuous Volcanic emissions
199  !
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
211  !
212  ! Altitud of continuous volcanic emissions
213  !
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
222  !
223  ! Explosive Volcanic emissions
224  !
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)
235  !
236  ! Altitud of explosive volcanic emissions
237  !
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)
248  !
249  PRINT*, 'Sources SOUFRE lues pour jour: ', jour
250  !
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
273END SUBROUTINE condsurfs_new
Note: See TracBrowser for help on using the repository browser.