source: LMDZ6/trunk/libf/phylmd/Dust/condsurfc_new.F @ 5134

Last change on this file since 5134 was 5084, checked in by Laurent Fairhead, 5 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF
File size: 6.8 KB
RevLine 
[2630]1      SUBROUTINE condsurfc_new(jour,lmt_bcff, lmt_bcnff,
2     .                         lmt_bcbbl,lmt_bcbbh, lmt_bcba,
3     .                         lmt_omff,lmt_omnff,lmt_ombbl,lmt_ombbh,
4     .                                             lmt_omnat, lmt_omba)
5      USE mod_grid_phy_lmdz
6      USE mod_phys_lmdz_para
7      USE dimphy
8      IMPLICIT none
9c
10c Lire les conditions aux limites du modele pour la chimie.
11c --------------------------------------------------------
12c
[4593]13      INCLUDE "dimensions.h"
[5084]14      INCLUDE "netcdf.inc"
15     
[2630]16      REAL lmt_bcff(klon), lmt_bcnff(klon), lmt_bcba(klon)
17      REAL lmt_omff(klon), lmt_omnff(klon), lmt_ombb(klon)
18      REAL lmt_bcbbl(klon), lmt_bcbbh(klon)
19      REAL lmt_ombbl(klon), lmt_ombbh(klon)
20      REAL lmt_omnat(klon), lmt_omba(klon)
21      REAL lmt_terp(klon)
22c
23      REAL lmt_bcff_glo(klon_glo), lmt_bcnff_glo(klon_glo)
24      REAL lmt_bcba_glo(klon_glo)
25      REAL lmt_omff_glo(klon_glo), lmt_omnff_glo(klon_glo)
26      REAL lmt_ombb_glo(klon_glo)
27      REAL lmt_bcbbl_glo(klon_glo), lmt_bcbbh_glo(klon_glo)
28      REAL lmt_ombbl_glo(klon_glo), lmt_ombbh_glo(klon_glo)
29      REAL lmt_omnat_glo(klon_glo), lmt_omba_glo(klon_glo)
30      REAL lmt_terp_glo(klon_glo)
31!
32      INTEGER jour, i
33      INTEGER ierr
34      INTEGER nid1,nvarid
35      INTEGER debut(2),epais(2)
36c
37!      IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN
[5084]38      IF (jour.LT.0 .OR. jour.GT.366) THEN
[2630]39         PRINT*,'Le jour demande n est pas correcte:', jour
40         print *,'JE: FORCED TO CONTINUE (emissions have
41     . to be longer than 1 year!!!! )'
42!JE         CALL ABORT
43      ENDIF
44
45!$OMP MASTER
46      IF (is_mpi_root .AND. is_omp_root) THEN
47!
48! Tranche a lire:
49      debut(1) = 1
50      debut(2) = jour
51      epais(1) = klon_glo
52!      epais(1) = klon
53      epais(2) = 1
54!
55!=======================================================================
56!                        BC EMISSIONS
57!=======================================================================
58!
59      ierr = NF_OPEN ("carbon_emissions.nc", NF_NOWRITE, nid1)
[5084]60      if (ierr.ne.NF_NOERR) then
[2630]61        write(6,*)' Pb d''ouverture du fichier limitbc.nc'
62        write(6,*)' ierr = ', ierr
63        call exit(1)
64      endif
65!
66! BC emissions from fossil fuel combustion
67!
68      ierr = NF_INQ_VARID (nid1, "BCFF", nvarid)
[5084]69      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
70     .  lmt_bcff_glo)
71      IF (ierr .NE. NF_NOERR) THEN
[2630]72         PRINT*, 'Pb de lecture pour les sources BC'
73         CALL exit(1)
74      ENDIF
75      !print *,'lmt_bcff = ',lmt_bcff
76      !stop
77!
78! BC emissions from non fossil fuel combustion
79!
80      ierr = NF_INQ_VARID (nid1, "BCNFF", nvarid)
[5084]81      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
82     .    lmt_bcnff_glo)
83      IF (ierr .NE. NF_NOERR) THEN
[2630]84         PRINT*, 'Pb de lecture pour les sources BC'
85         CALL exit(1)
86      ENDIF
87!
88! Low BC emissions from biomass burning
89!
90      ierr = NF_INQ_VARID (nid1, "BCBBL", nvarid)
[5084]91      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
92     .  lmt_bcbbl_glo)
93      IF (ierr .NE. NF_NOERR) THEN
[2630]94         PRINT*, 'Pb de lecture pour les sources BC low'
95         CALL exit(1)
96      ENDIF
97!
98! High BC emissions from biomass burning
99!
100      ierr = NF_INQ_VARID (nid1, "BCBBH", nvarid)
[5084]101      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
102     .      lmt_bcbbh_glo)
103      IF (ierr .NE. NF_NOERR) THEN
[2630]104         PRINT*, 'Pb de lecture pour les sources BC high'
105         CALL exit(1)
106      ENDIF
107!
108! BC emissions from ship transport
109!
110      ierr = NF_INQ_VARID (nid1, "BCBA", nvarid)
[5084]111      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
112     .   lmt_bcba_glo)
113      IF (ierr .NE. NF_NOERR) THEN
[2630]114         PRINT*, 'Pb de lecture pour les sources BC'
115         CALL exit(1)
116      ENDIF
117!
118!=======================================================================
119!                        OM EMISSIONS
120!=======================================================================
121!
122
123!
124! OM emissions from fossil fuel combustion
125!
126      ierr = NF_INQ_VARID (nid1, "OMFF", nvarid)
[5084]127      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
128     .  lmt_omff_glo)
129      IF (ierr .NE. NF_NOERR) THEN
[2630]130         PRINT*, 'Pb de lecture pour les sources OM'
131         CALL exit(1)
132      ENDIF
133!
134! OM emissions from non fossil fuel combustion
135!
136      ierr = NF_INQ_VARID (nid1, "OMNFF", nvarid)
[5084]137      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
138     .   lmt_omnff_glo)
139      IF (ierr .NE. NF_NOERR) THEN
[2630]140         PRINT*, 'Pb de lecture pour les sources OM'
141         CALL exit(1)
142      ENDIF
143!
144! Low OM emissions from biomass burning - low
145!
146      ierr = NF_INQ_VARID (nid1, "OMBBL", nvarid)
[5084]147      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
148     .  lmt_ombbl_glo)
149      IF (ierr .NE. NF_NOERR) THEN
[2630]150         PRINT*, 'Pb de lecture pour les sources OM low'
151         CALL exit(1)
152      ENDIF
153!
154! High OM emissions from biomass burning - high
155!
156      ierr = NF_INQ_VARID (nid1, "OMBBH", nvarid)
[5084]157      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
158     .  lmt_ombbh_glo)
159      IF (ierr .NE. NF_NOERR) THEN
[2630]160         PRINT*, 'Pb de lecture pour les sources OM high'
161         CALL exit(1)
162      ENDIF
163!
164! High OM emissions from ship
165!
166      ierr = NF_INQ_VARID (nid1, "OMBA", nvarid)
[5084]167      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
168     .   lmt_omba_glo)
169      IF (ierr .NE. NF_NOERR) THEN
[2630]170         PRINT*, 'Pb de lecture pour les sources OM ship'
171         CALL exit(1)
172      ENDIF
173!
174! Natural Terpene emissions => Natural OM emissions
175!
176      ierr = NF_INQ_VARID (nid1, "TERP", nvarid)
[5084]177      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
178     .  lmt_terp_glo)
179      IF (ierr .NE. NF_NOERR) THEN
[2630]180         PRINT*, 'Pb de lecture pour les sources Terpene'
181         CALL exit(1)
182      ENDIF
183!
184      DO i=1,klon_glo
185        lmt_omnat_glo(i)  = lmt_terp_glo(i)*0.11*1.4 !-- 11% Terpene is OC
186      ENDDO
187
188      ierr = NF_CLOSE(nid1)
189!
190      PRINT*, 'Carbon sources lues pour jour: ', jour
191!      lmt_bcff(klon)=0.0
192!      lmt_bcnff(klon)=0.0
193!      lmt_omff(klon)=0.0
194!      lmt_omnff(klon)=0.0
195!      lmt_ombb(klon)=0.0
196!      lmt_bcbbl(klon)=0.0
197!      lmt_bcbbh(klon)=0.0
198!      lmt_ombbl(klon)=0.0
199!      lmt_ombbh(klon)=0.0
200!      lmt_omnat(klon)=0.0
201!      lmt_omba(klon)=0.0
202!      lmt_terp(klon)=0.0
203
204
205      ENDIF
206!$OMP END MASTER
207!$OMP BARRIER
208      call scatter( lmt_bcff_glo   , lmt_bcff )   
209      call scatter( lmt_bcnff_glo  , lmt_bcnff )
210      call scatter( lmt_bcbbl_glo  , lmt_bcbbl )
211      call scatter( lmt_bcbbh_glo  , lmt_bcbbh )
212      call scatter( lmt_bcba_glo   , lmt_bcba )
213      call scatter( lmt_omff_glo   , lmt_omff )
214      call scatter( lmt_omnff_glo  , lmt_omnff )
215      call scatter( lmt_ombbl_glo  , lmt_ombbl )
216      call scatter( lmt_ombbh_glo  , lmt_ombbh )
217      call scatter( lmt_omba_glo   , lmt_omba )
218      call scatter( lmt_terp_glo   , lmt_terp )
219      call scatter( lmt_omnat_glo  , lmt_omnat )
220
221
222
223
224
225      RETURN
226      END
Note: See TracBrowser for help on using the repository browser.