Context Navigation

condsurf.F @ 5444

Last change on this file since 5444 was 207, checked in by lmdz, 24 years ago
petit detail LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 8.4 KB

Line
1	c $Header$
2	c
3	SUBROUTINE condsurf( jour, jourvrai, pctsrf,
4	s lmt_sst,lmt_alb,lmt_rug,lmt_bils )
5	IMPLICIT none
6	c
7	c Lire les conditions aux limites du modele.
8	c -----------------------------------------
9	c jour : input , numero du jour a lire
10	c jourvrai : input , vrai jour de la simulation
11	c
12	c pctsrf: sous-maille fractionnelle, la somme doit = 1
13	c lmt_sst: temperature de la surface oceanique
14	c lmt_alb: albedo du sol
15	c lmt_rug: longeur de rugosite du sol
16	c lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean")
17	c
18	#include "netcdf.inc"
19	INTEGER nid, nvarid
20	INTEGER debut(2)
21	INTEGER epais(2)
22	INTEGER lnblnk
23	EXTERNAL lnblnk
24	c
25	#include "dimensions.h"
26	#include "dimphy.h"
27	#include "indicesol.h"
28	#include "temps.h"
29	#include "clesphys.h"
30	c
31	c newlmt indique l'utilisation de la sous-maille fractionnelle,
32	c tandis que l'ancien regime utilisait l'indicateur du sol (0,1,2,3).
33
34	LOGICAL newlmt
35	PARAMETER (newlmt=.FALSE.)
36
37	INTEGER nannemax
38	PARAMETER ( nannemax = 60 )
39	c
40	INTEGER jour,jourvrai
41	REAL lmt_nat(klon) ! indicateur de la nature du sol
42	REAL pctsrf(klon,nbsrf) ! sous-maille fractionnelle
43	REAL lmt_sst(klon) ! temperature de la surface oceanique
44	REAL lmt_alb(klon) ! albedo du sol
45	REAL lmt_rug(klon) ! longeur de rugosite du sol
46	REAL lmt_bils(klon)
47	c
48	c Variables locales:
49	INTEGER ig, i, j, kt, ierr
50	LOGICAL ok
51	INTEGER anneelim,anneemax
52	CHARACTER*20 fich
53	cc
54	cc .....................................................................
55	cc
56	cc Pour lire le fichier limit correspondant vraiment a l'annee de la
57	cc simulation en cours , il suffit de mettre ok_limitvrai = .TRUE.
58	cc
59	cc ......................................................................
60	c
61	c
62	IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN
63	PRINT*,'Le jour demande n est pas correct: ', jour
64	CALL ABORT
65	ENDIF
66	c
67	c ............. modif ( P. Le Van ) ...........
68
69	anneelim = anne_ini
70	anneemax = anne_ini + nannemax
71	c
72	c
73	IF( ok_limitvrai ) THEN
74	DO kt = 1, nannemax
75	IF(jourvrai.LE. (kt-1)*360 + 359 ) THEN
76	WRITE(fich,'("limit",i4,".nc")') anneelim
77	PRINT *,' Fichier Limite ',fich
78	GO TO 100
79	ENDIF
80	anneelim = anneelim + 1
81	ENDDO
82
83	PRINT *,' PBS ! Le jour a lire sur le fichier limit ne se '
84	PRINT *,' trouve pas sur les ',nannemax,' annees a partir de '
85	PRINT *,' l annee de debut', anne_ini
86	CALL EXIT(1)
87	c
88	100 CONTINUE
89	c
90	ELSE
91
92	WRITE(fich,'("limit.nc")')
93	PRINT *,' Fichier Limite ',fich
94	ENDIF
95	c
96	c ........... ( fin modif P. Le Van ) ............
97	c
98	c Ouvrir le fichier en format NetCDF:
99	c
100	ierr = NF_OPEN (fich, NF_NOWRITE,nid)
101	IF (ierr.NE.NF_NOERR) THEN
102	WRITE(6,*)' Pb d''ouverture du fichier ', fich
103	WRITE(6,*)' Le fichier limit ',fich,' (avec 4 chiffres , pour'
104	WRITE(6,*)' l an 2000 ) , n existe pas ! '
105	WRITE(6,*)' ierr = ', ierr
106	CALL EXIT(1)
107	ENDIF
108	c
109	c La tranche de donnees a lire:
110	c
111	debut(1) = 1
112	debut(2) = jour + 1
113	epais(1) = klon
114	epais(2) = 1
115	c
116	IF (newlmt) THEN
117	c
118	c Fraction "ocean":
119	ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
120	IF (ierr .NE. NF_NOERR) THEN
121	PRINT*, "condsurf: Le champ <FOCE> est absent"
122	CALL abort
123	ENDIF
124	#ifdef NC_DOUBLE
125	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_oce))
126	#else
127	ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_oce))
128	#endif
129	IF (ierr .NE. NF_NOERR) THEN
130	PRINT*, "condsurf: Lecture echouee pour <FOCE>"
131	CALL abort
132	ENDIF
133	c
134	c Fraction "glace de mer":
135	ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
136	IF (ierr .NE. NF_NOERR) THEN
137	PRINT*, "condsurf: Le champ <FSIC> est absent"
138	CALL abort
139	ENDIF
140	#ifdef NC_DOUBLE
141	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_sic))
142	#else
143	ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_sic))
144	#endif
145	IF (ierr .NE. NF_NOERR) THEN
146	PRINT*, "condsurf: Lecture echouee pour <FSIC>"
147	CALL abort
148	ENDIF
149	c
150	c Fraction "terre":
151	ierr = NF_INQ_VARID (nid, "FTER", nvarid)
152	IF (ierr .NE. NF_NOERR) THEN
153	PRINT*, "condsurf: Le champ <FTER> est absent"
154	CALL abort
155	ENDIF
156	#ifdef NC_DOUBLE
157	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_ter))
158	#else
159	ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_ter))
160	#endif
161	IF (ierr .NE. NF_NOERR) THEN
162	PRINT*, "condsurf: Lecture echouee pour <FTER>"
163	CALL abort
164	ENDIF
165	c
166	c Fraction "glacier terre":
167	ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
168	IF (ierr .NE. NF_NOERR) THEN
169	PRINT*, "condsurf: Le champ <FLIC> est absent"
170	CALL abort
171	ENDIF
172	#ifdef NC_DOUBLE
173	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_lic))
174	#else
175	ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_lic))
176	#endif
177	IF (ierr .NE. 0) THEN
178	PRINT*, "condsurf: Lecture echouee pour <FLIC>"
179	CALL abort
180	ENDIF
181	c
182	ELSE ! test sur newlmt
183	c
184	c Indicateur de la nature du sol (0,1,2,3):
185	ierr = NF_INQ_VARID (nid, "NAT", nvarid)
186	IF (ierr .NE. NF_NOERR) THEN
187	PRINT*, "condsurf: Le champ <NAT> est absent"
188	CALL abort
189	ENDIF
190	#ifdef NC_DOUBLE
191	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_nat)
192	#else
193	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_nat)
194	#endif
195	IF (ierr .NE. NF_NOERR) THEN
196	PRINT*, "condsurf: Lecture echouee pour <NAT>"
197	CALL abort
198	ENDIF
199	c
200	DO ig = 1, klon
201	pctsrf(ig,is_oce) = 0.0
202	pctsrf(ig,is_ter) = 0.0
203	pctsrf(ig,is_lic) = 0.0
204	pctsrf(ig,is_sic) = 0.0
205	ENDDO
206	ok = .TRUE.
207	DO ig = 1, klon
208	IF (NINT(lmt_nat(ig)).EQ.0) THEN
209	pctsrf(ig,is_oce) = 1.0
210	ELSE IF (NINT(lmt_nat(ig)).EQ.1) THEN
211	pctsrf(ig,is_ter) = 1.0
212	ELSE IF (NINT(lmt_nat(ig)).EQ.2) THEN
213	pctsrf(ig,is_lic) = 1.0
214	ELSE IF (NINT(lmt_nat(ig)).EQ.3) THEN
215	pctsrf(ig,is_sic) = 1.0
216	ELSE
217	ok = .FALSE.
218	ENDIF
219	ENDDO
220	IF (.NOT.ok) THEN
221	PRINT*, "valeur fausse pour lmt_nat:", lmt_nat
222	CALL abort
223	ENDIF
224	c
225	ENDIF ! fin de test sur newlmt
226	c
227	c Sea surface temperature:
228	ierr = NF_INQ_VARID (nid, "SST", nvarid)
229	IF (ierr .NE. NF_NOERR) THEN
230	PRINT*, "condsurf: Le champ <SST> est absent"
231	CALL abort
232	ENDIF
233	#ifdef NC_DOUBLE
234	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_sst)
235	#else
236	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_sst)
237	#endif
238	IF (ierr .NE. NF_NOERR) THEN
239	PRINT*, "condsurf: Lecture echouee pour <SST>"
240	CALL abort
241	ENDIF
242	c
243	c Albedo de surface:
244	ierr = NF_INQ_VARID (nid, "ALB", nvarid)
245	IF (ierr .NE. NF_NOERR) THEN
246	PRINT*, "condsurf: Le champ <ALB> est absent"
247	CALL abort
248	ENDIF
249	#ifdef NC_DOUBLE
250	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_alb)
251	#else
252	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_alb)
253	#endif
254	IF (ierr .NE. NF_NOERR) THEN
255	PRINT*, "condsurf: Lecture echouee pour <ALB>"
256	CALL abort
257	ENDIF
258	c
259	c Longueur de rugosite au sol:
260	ierr = NF_INQ_VARID (nid, "RUG", nvarid)
261	IF (ierr .NE. NF_NOERR) THEN
262	PRINT*, "condsurf: Le champ <RUG> est absent"
263	CALL abort
264	ENDIF
265	#ifdef NC_DOUBLE
266	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_rug)
267	#else
268	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_rug)
269	#endif
270	IF (ierr .NE. NF_NOERR) THEN
271	PRINT*, "condsurf: Lecture echouee pour <RUG>"
272	CALL abort
273	ENDIF
274	c
275	c Bilan flux de chaleur au sol:
276	ierr = NF_INQ_VARID (nid, "BILS", nvarid)
277	IF (ierr .NE. NF_NOERR) THEN
278	PRINT*, "condsurf: Le champ <BILS> est absent"
279	CALL abort
280	ENDIF
281	#ifdef NC_DOUBLE
282	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_bils)
283	#else
284	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_bils)
285	#endif
286	IF (ierr .NE. NF_NOERR) THEN
287	PRINT*, "condsurf: Lecture echouee pour <BILS>"
288	CALL abort
289	ENDIF
290	c
291	c Fermer le fichier:
292	c
293	ierr = NF_CLOSE(nid)
294	c
295	c
296	PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour
297	c
298	RETURN
299	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format