source: LMDZ6/trunk/libf/phylmd/Dust/condsurfc.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: 4.2 KB
Line 
1SUBROUTINE condsurfc(jour,lmt_bcff,lmt_bcbb, &
2        lmt_bcbbl,lmt_bcbbh,lmt_bc_penner, &
3        lmt_omff,lmt_ombb,lmt_ombbl,lmt_ombbh, &
4        lmt_omnat)
5  USE dimphy
6  IMPLICIT none
7  !
8  ! Lire les conditions aux limites du modele pour la chimie.
9  ! --------------------------------------------------------
10  !
11  INCLUDE "dimensions.h"
12  INCLUDE "netcdf.inc"
13
14  REAL :: lmt_bcff(klon), lmt_bcbb(klon),lmt_bc_penner(klon)
15  REAL :: lmt_omff(klon), lmt_ombb(klon)
16  REAL :: lmt_bcbbl(klon), lmt_bcbbh(klon)
17  REAL :: lmt_ombbl(klon), lmt_ombbh(klon)
18  REAL :: lmt_omnat(klon)
19  REAL :: lmt_terp(klon)
20  !
21  INTEGER :: jour, i
22  INTEGER :: ierr
23  INTEGER :: nid1,nvarid
24  INTEGER :: debut(2),epais(2)
25  !
26  IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN
27     IF (jour.GT.(360-1).AND.jour.LE.367) THEN
28       jour=360-1
29       print *,'JE: jour changed to jour= ',jour
30     ELSE
31       PRINT*,'Le jour demande n est pas correcte:', jour
32       CALL ABORT
33     ENDIF
34  ENDIF
35  !
36  ierr = NF_OPEN ("limitcarbon.nc", NF_NOWRITE, nid1)
37  if (ierr.ne.NF_NOERR) then
38    write(6,*)' Pb d''ouverture du fichier limitbc.nc'
39    write(6,*)' ierr = ', ierr
40    call exit(1)
41  endif
42  !
43  ! Tranche a lire:
44  debut(1) = 1
45  debut(2) = jour+1
46  epais(1) = klon
47  epais(2) = 1
48  !
49  !
50  ierr = NF_INQ_VARID (nid1, "BCFF", nvarid)
51  !nhl #ifdef NC_DOUBLE
52  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcff)
53   ! print *,'IERR = ',ierr
54   ! print *,'NF_NOERR = ',NF_NOERR
55   ! print *,'debut = ',debut
56   ! print *,'epais = ',epais
57  !nhl #else
58  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcff)
59  !nhl #endif
60  IF (ierr .NE. NF_NOERR) THEN
61     PRINT*, 'Pb de lecture pour les sources BC'
62     CALL exit(1)
63  ENDIF
64  !
65  !
66  ierr = NF_INQ_VARID (nid1, "BCBB", nvarid)
67  !nhl #ifdef NC_DOUBLE
68  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbb)
69  !nhl #else
70  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbb)
71  !nhl #endif
72  IF (ierr .NE. NF_NOERR) THEN
73     PRINT*, 'Pb de lecture pour les sources BC-biomass'
74     CALL exit(1)
75  ENDIF
76  !
77  !
78  ierr = NF_INQ_VARID (nid1, "BCBL", nvarid)
79  !nhl #ifdef NC_DOUBLE
80  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbbl)
81  !nhl #else
82  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbbl)
83  !nhl #endif
84  IF (ierr .NE. NF_NOERR) THEN
85     PRINT*, 'Pb de lecture pour les sources BC low'
86     CALL exit(1)
87  ENDIF
88  !
89  !
90  ierr = NF_INQ_VARID (nid1, "BCBH", nvarid)
91  !nhl #ifdef NC_DOUBLE
92  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbbh)
93  !nhl #else
94  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbbh)
95  !nhl #endif
96  IF (ierr .NE. NF_NOERR) THEN
97     PRINT*, 'Pb de lecture pour les sources BC high'
98     CALL exit(1)
99  ENDIF
100  !
101  ierr = NF_INQ_VARID (nid1, "TERP", nvarid)
102  !nhl #ifdef NC_DOUBLE
103  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_terp)
104  !nhl #else
105  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_terp)
106  !nhl #endif
107  IF (ierr .NE. NF_NOERR) THEN
108     PRINT*, 'Pb de lecture pour les sources Terpene'
109     CALL exit(1)
110  ENDIF
111  !
112  !
113  ierr = NF_INQ_VARID (nid1, "BC_penner", nvarid)
114  !nhl #ifdef NC_DOUBLE
115  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, &
116        epais, lmt_bc_penner)
117  !nhl #else
118  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais,
119  !nhl      .       lmt_bc_penner)
120  !nhl #endif
121  IF (ierr .NE. NF_NOERR) THEN
122     PRINT*, 'Pb de lecture pour les sources BC Penner'
123     CALL exit(1)
124  ENDIF
125  !
126  !
127  ierr = NF_INQ_VARID (nid1, "OMFF", nvarid)
128  !nhl #ifdef NC_DOUBLE
129  ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_omff)
130  !nhl #else
131  !nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_omff)
132  !nhl #endif
133  IF (ierr .NE. NF_NOERR) THEN
134     PRINT*, 'Pb de lecture pour les sources om-ifossil'
135     CALL exit(1)
136  ENDIF
137  !
138  DO i=1,klon
139    lmt_ombb(i)  = lmt_bcbb(i)*7.0*1.6      !OC/BC=7.0;OM/OC=1.6
140    lmt_ombbl(i) = lmt_bcbbl(i)*7.0*1.6
141    lmt_ombbh(i) = lmt_bcbbh(i)*7.0*1.6
142    lmt_omff(i)  = lmt_omff(i)*1.4          !--OM/OC=1.4
143    lmt_omnat(i)  = lmt_terp(i)*0.11*1.4 !-- 11% Terpene is OC
144  ENDDO
145  !
146  ierr = NF_CLOSE(nid1)
147  PRINT*, 'Carbon sources lues pour jour: ', jour
148  !
149  RETURN
150END SUBROUTINE condsurfc
Note: See TracBrowser for help on using the repository browser.