source: LMDZ6/trunk/libf/phylmd/Dust/condsurfs_new_mod.f90

Last change on this file was 5337, checked in by Laurent Fairhead, 4 weeks ago

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