source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/condsurf.F_v1864_je @ 5434

Last change on this file since 5434 was 2175, checked in by jescribano, 10 years ago

SPLA code included for first time

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