source: LMDZ.3.3/branches/rel-LF/libf/phylmd/condsurf.F @ 281

Last change on this file since 281 was 258, checked in by lmdzadmin, 23 years ago

Phasage avec la version de PB pour le sol, dlw (juillet 2001)
LF
  • 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 
1c $Header$
2c
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=.TRUE.)
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$$$c Fraction "ocean":
119c$$$      ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
120c$$$      IF (ierr .NE. NF_NOERR) THEN
121c$$$         PRINT*, "condsurf: Le champ <FOCE> est absent"
122c$$$         CALL abort
123c$$$      ENDIF
124c$$$#ifdef NC_DOUBLE
125c$$$      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_oce))
126c$$$#else
127c$$$      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_oce))
128c$$$#endif
129c$$$      IF (ierr .NE. NF_NOERR) THEN
130c$$$         PRINT*, "condsurf: Lecture echouee pour <FOCE>"
131c$$$         CALL abort
132c$$$      ENDIF
133c
134c Fraction "glace de mer":
135c
136c
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
151C
152C 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
169c
170c$$$c Fraction "terre":
171c$$$      ierr = NF_INQ_VARID (nid, "FTER", nvarid)
172c$$$      IF (ierr .NE. NF_NOERR) THEN
173c$$$         PRINT*, "condsurf: Le champ <FTER> est absent"
174c$$$         CALL abort
175c$$$      ENDIF
176c$$$#ifdef NC_DOUBLE
177c$$$      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_ter))
178c$$$#else
179c$$$      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_ter))
180c$$$#endif
181c$$$      IF (ierr .NE. NF_NOERR) THEN
182c$$$         PRINT*, "condsurf: Lecture echouee pour <FTER>"
183c$$$         CALL abort
184c$$$      ENDIF
185c$$$c
186c$$$c Fraction "glacier terre":
187c$$$      ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
188c$$$      IF (ierr .NE. NF_NOERR) THEN
189c$$$         PRINT*, "condsurf: Le champ <FLIC> est absent"
190c$$$         CALL abort
191c$$$      ENDIF
192c$$$#ifdef NC_DOUBLE
193c$$$      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_lic))
194c$$$#else
195c$$$      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_lic))
196c$$$#endif
197c$$$      IF (ierr .NE. 0) THEN
198c$$$         PRINT*, "condsurf: Lecture echouee pour <FLIC>"
199c$$$         CALL abort
200c$$$      ENDIF
201c
202      ELSE ! test sur newlmt
203c
204c 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
219c
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
244c
245      ENDIF ! fin de test sur newlmt
246c
247c 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
262c
263c 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
278c
279c 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
294c
295c 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
310c
311c Fermer le fichier:
312c
313      ierr = NF_CLOSE(nid)
314c
315c
316      PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour
317c
318      RETURN
319      END
Note: See TracBrowser for help on using the repository browser.