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

Last change on this file since 177 was 98, checked in by lmdzadmin, 24 years ago

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