Context Navigation

condsurf.F @ 558

Last change on this file since 558 was 353, checked in by lmdzadmin, 23 years ago

2 changements pour les fichiers histoire:

utilisation de l'entree "rectilineaire" de IOIPSL pour ne plus avoir

lancer ncregular a chaque fois

le calendrier des fichiers histoire est maintenant base sur la date d'initialisation de la simulation plutot que sur la date de depart du

job

en cours

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 9.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=.TRUE.)
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 = annee_ref
70	anneemax = annee_ref + 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', annee_ref
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$$$c Fraction "ocean":
119	c$$$ ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
120	c$$$ IF (ierr .NE. NF_NOERR) THEN
121	c$$$ PRINT*, "condsurf: Le champ <FOCE> est absent"
122	c$$$ CALL abort
123	c$$$ ENDIF
124	c$$$#ifdef NC_DOUBLE
125	c$$$ ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_oce))
126	c$$$#else
127	c$$$ ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_oce))
128	c$$$#endif
129	c$$$ IF (ierr .NE. NF_NOERR) THEN
130	c$$$ PRINT*, "condsurf: Lecture echouee pour <FOCE>"
131	c$$$ CALL abort
132	c$$$ ENDIF
133	c
134	c Fraction "glace de mer":
135	c
136	c
137	ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
138	IF (ierr .NE. NF_NOERR) THEN
139	PRINT*, "condsurf: Le champ <FSIC> est absent"
140	CALL abort
141	ENDIF
142	#ifdef NC_DOUBLE
143	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_sic))
144	#else
145	ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_sic))
146	#endif
147	IF (ierr .NE. NF_NOERR) THEN
148	PRINT*, "condsurf: Lecture echouee pour <FSIC>"
149	CALL abort
150	ENDIF
151	C
152	C positionnement % ocean libre et verification qu'il y a compatibilite des soussurfaces
153	pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon))
154	$ - pctsrf(1 : klon, is_sic)
155	DO i = 1, klon
156	IF ( pctsrf(i, is_sic) .GT. (1. - zmasq(i)) ) THEN
157	WRITE(,) 'condsurf : sea-ice et masque pb en ', i,
158	$ pctsrf(i, is_sic), (1. - zmasq(i))
159	pctsrf(i, is_sic) = (1. - zmasq(i))
160	pctsrf(i, is_oce) = 0.
161	ENDIF
162	IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
163	$ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA)
164	$ THEN
165	WRITE(,) 'condsurf : pb sous surface au point ', i,
166	$ pctsrf(i, 1 : nbsrf)
167	ENDIF
168	END DO
169	c
170	c$$$c Fraction "terre":
171	c$$$ ierr = NF_INQ_VARID (nid, "FTER", nvarid)
172	c$$$ IF (ierr .NE. NF_NOERR) THEN
173	c$$$ PRINT*, "condsurf: Le champ <FTER> est absent"
174	c$$$ CALL abort
175	c$$$ ENDIF
176	c$$$#ifdef NC_DOUBLE
177	c$$$ ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_ter))
178	c$$$#else
179	c$$$ ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_ter))
180	c$$$#endif
181	c$$$ IF (ierr .NE. NF_NOERR) THEN
182	c$$$ PRINT*, "condsurf: Lecture echouee pour <FTER>"
183	c$$$ CALL abort
184	c$$$ ENDIF
185	c$$$c
186	c$$$c Fraction "glacier terre":
187	c$$$ ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
188	c$$$ IF (ierr .NE. NF_NOERR) THEN
189	c$$$ PRINT*, "condsurf: Le champ <FLIC> est absent"
190	c$$$ CALL abort
191	c$$$ ENDIF
192	c$$$#ifdef NC_DOUBLE
193	c$$$ ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_lic))
194	c$$$#else
195	c$$$ ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_lic))
196	c$$$#endif
197	c$$$ IF (ierr .NE. 0) THEN
198	c$$$ PRINT*, "condsurf: Lecture echouee pour <FLIC>"
199	c$$$ CALL abort
200	c$$$ ENDIF
201	c
202	ELSE ! test sur newlmt
203	c
204	c Indicateur de la nature du sol (0,1,2,3):
205	ierr = NF_INQ_VARID (nid, "NAT", nvarid)
206	IF (ierr .NE. NF_NOERR) THEN
207	PRINT*, "condsurf: Le champ <NAT> est absent"
208	CALL abort
209	ENDIF
210	#ifdef NC_DOUBLE
211	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_nat)
212	#else
213	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_nat)
214	#endif
215	IF (ierr .NE. NF_NOERR) THEN
216	PRINT*, "condsurf: Lecture echouee pour <NAT>"
217	CALL abort
218	ENDIF
219	c
220	DO ig = 1, klon
221	pctsrf(ig,is_oce) = 0.0
222	pctsrf(ig,is_ter) = 0.0
223	pctsrf(ig,is_lic) = 0.0
224	pctsrf(ig,is_sic) = 0.0
225	ENDDO
226	ok = .TRUE.
227	DO ig = 1, klon
228	IF (NINT(lmt_nat(ig)).EQ.0) THEN
229	pctsrf(ig,is_oce) = 1.0
230	ELSE IF (NINT(lmt_nat(ig)).EQ.1) THEN
231	pctsrf(ig,is_ter) = 1.0
232	ELSE IF (NINT(lmt_nat(ig)).EQ.2) THEN
233	pctsrf(ig,is_lic) = 1.0
234	ELSE IF (NINT(lmt_nat(ig)).EQ.3) THEN
235	pctsrf(ig,is_sic) = 1.0
236	ELSE
237	ok = .FALSE.
238	ENDIF
239	ENDDO
240	IF (.NOT.ok) THEN
241	PRINT*, "valeur fausse pour lmt_nat:", lmt_nat
242	CALL abort
243	ENDIF
244	c
245	ENDIF ! fin de test sur newlmt
246	c
247	c Sea surface temperature:
248	ierr = NF_INQ_VARID (nid, "SST", nvarid)
249	IF (ierr .NE. NF_NOERR) THEN
250	PRINT*, "condsurf: Le champ <SST> est absent"
251	CALL abort
252	ENDIF
253	#ifdef NC_DOUBLE
254	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_sst)
255	#else
256	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_sst)
257	#endif
258	IF (ierr .NE. NF_NOERR) THEN
259	PRINT*, "condsurf: Lecture echouee pour <SST>"
260	CALL abort
261	ENDIF
262	c
263	c Albedo de surface:
264	ierr = NF_INQ_VARID (nid, "ALB", nvarid)
265	IF (ierr .NE. NF_NOERR) THEN
266	PRINT*, "condsurf: Le champ <ALB> est absent"
267	CALL abort
268	ENDIF
269	#ifdef NC_DOUBLE
270	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_alb)
271	#else
272	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_alb)
273	#endif
274	IF (ierr .NE. NF_NOERR) THEN
275	PRINT*, "condsurf: Lecture echouee pour <ALB>"
276	CALL abort
277	ENDIF
278	c
279	c Longueur de rugosite au sol:
280	ierr = NF_INQ_VARID (nid, "RUG", nvarid)
281	IF (ierr .NE. NF_NOERR) THEN
282	PRINT*, "condsurf: Le champ <RUG> est absent"
283	CALL abort
284	ENDIF
285	#ifdef NC_DOUBLE
286	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_rug)
287	#else
288	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_rug)
289	#endif
290	IF (ierr .NE. NF_NOERR) THEN
291	PRINT*, "condsurf: Lecture echouee pour <RUG>"
292	CALL abort
293	ENDIF
294	c
295	c Bilan flux de chaleur au sol:
296	ierr = NF_INQ_VARID (nid, "BILS", nvarid)
297	IF (ierr .NE. NF_NOERR) THEN
298	PRINT*, "condsurf: Le champ <BILS> est absent"
299	CALL abort
300	ENDIF
301	#ifdef NC_DOUBLE
302	ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_bils)
303	#else
304	ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_bils)
305	#endif
306	IF (ierr .NE. NF_NOERR) THEN
307	PRINT*, "condsurf: Lecture echouee pour <BILS>"
308	CALL abort
309	ENDIF
310	c
311	c Fermer le fichier:
312	c
313	ierr = NF_CLOSE(nid)
314	c
315	c
316	PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour
317	c
318	RETURN
319	END

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

Download in other formats:

Original Format