source: LMDZ.3.3/trunk/libf/phylmd/condsurf.F @ 404

Last change on this file since 404 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
RevLine 
[207]1c $Header$
[199]2c
[2]3      SUBROUTINE condsurf( jour, jourvrai, pctsrf,
4     s                    lmt_sst,lmt_alb,lmt_rug,lmt_bils )
5      IMPLICIT none
6c
7c Lire les conditions aux limites du modele.
8c -----------------------------------------
9c jour     : input  , numero du jour a lire
10c jourvrai : input  , vrai jour de la simulation 
11c
12c pctsrf:  sous-maille fractionnelle, la somme doit = 1
13c lmt_sst: temperature de la surface oceanique
14c lmt_alb: albedo du sol
15c lmt_rug: longeur de rugosite du sol
16c lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean")
17c
18#include "netcdf.inc"
19      INTEGER nid, nvarid
20      INTEGER debut(2)
21      INTEGER epais(2)
22      INTEGER lnblnk
23      EXTERNAL lnblnk
24c
25#include "dimensions.h"
26#include "dimphy.h"
27#include "indicesol.h"
28#include "temps.h"
29#include "clesphys.h"
30c
31c newlmt indique l'utilisation de la sous-maille fractionnelle,
32c 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 )
39c
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)
47c
48c Variables locales:
49      INTEGER ig, i, j, kt, ierr
50      LOGICAL ok
51      INTEGER anneelim,anneemax
52      CHARACTER*20 fich
53cc
54cc   .....................................................................
55cc
56cc    Pour lire le fichier limit correspondant vraiment  a l'annee de la
57cc     simulation en cours , il suffit de mettre  ok_limitvrai = .TRUE.
58cc
59cc   ......................................................................
60c
61c
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
66c
67c  .............   modif  (  P. Le Van )  ...........
68
69       anneelim  = anne_ini
70       anneemax  = anne_ini + nannemax
71c
72c
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)
87c
88100     CONTINUE
89c
90       ELSE
91     
92            WRITE(fich,'("limit.nc")')
93            PRINT *,' Fichier  Limite ',fich
94       ENDIF
95c
96c  ........... ( fin   modif   P. Le Van  ) ............
97c
98c Ouvrir le fichier en format NetCDF:
99c
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
108c
109c La tranche de donnees a lire:
110c
111      debut(1) = 1
112      debut(2) = jour + 1
113      epais(1) = klon
114      epais(2) = 1
115c
116      IF (newlmt) THEN
117c
118c 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
133c
134c 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
149c
150c 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
165c
166c 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
181c
182      ELSE ! test sur newlmt
183c
184c 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
199c
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
224c
225      ENDIF ! fin de test sur newlmt
226c
227c 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
242c
243c 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
258c
259c 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
274c
275c 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
290c
291c Fermer le fichier:
292c
293      ierr = NF_CLOSE(nid)
294c
295c
296      PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour
297c
298      RETURN
299      END
Note: See TracBrowser for help on using the repository browser.