source: trunk/LMDZ.EARTH/libf/phylmd/limit_read_mod.F90 @ 357

Last change on this file since 357 was 1, checked in by emillour, 14 years ago

Import initial LMDZ5
File size: 12.9 KB
Line 
1!
2! $Header$
3!
4MODULE limit_read_mod
5!
6! This module reads the fichier "limit.nc" containing fields for surface forcing.
7!
8! Module subroutines :
9!  limit_read_frac    : call limit_read_tot and return the fractions
10!  limit_read_rug_alb : return rugosity and albedo, if coupled ocean call limit_read_tot first
11!  limit_read_sst     : return sea ice temperature   
12!  limit_read_tot     : read limit.nc and store the fields in local modules variables
13!
14  IMPLICIT NONE
15
16  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE, PRIVATE :: pctsrf
17!$OMP THREADPRIVATE(pctsrf)
18  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: rugos
19!$OMP THREADPRIVATE(rugos)
20  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: albedo
21!$OMP THREADPRIVATE(albedo) 
22  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sst
23!$OMP THREADPRIVATE(sst) 
24  LOGICAL,SAVE :: read_continents=.FALSE.
25!$OMP THREADPRIVATE(read_continents)
26
27CONTAINS
28!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
29!!
30!! Public subroutines :
31!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32
33  SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified)
34!
35! This subroutine is called from "change_srf_frac" for case of
36! ocean=force or from ocean_slab_frac for ocean=slab.
37! The fraction for all sub-surfaces at actual time step is returned.
38
39    USE dimphy
40    INCLUDE "indicesol.h"
41
42! Input arguments
43!****************************************************************************************
44    INTEGER, INTENT(IN) :: itime   ! time step
45    INTEGER, INTENT(IN) :: jour    ! current day
46    REAL   , INTENT(IN) :: dtime   ! length of time step
47 
48! Output arguments
49!****************************************************************************************
50    REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pctsrf_new  ! sub surface fractions
51    LOGICAL, INTENT(OUT)                     :: is_modified ! true if pctsrf is modified at this time step
52
53! End declaration
54!****************************************************************************************
55
56! 1) Read file limit.nc
57    CALL limit_read_tot(itime, dtime, jour, is_modified)
58
59! 2) Return the fraction read in limit_read_tot
60    pctsrf_new(:,:) = pctsrf(:,:)
61   
62  END SUBROUTINE limit_read_frac
63
64!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
65
66  SUBROUTINE limit_read_rug_alb(itime, dtime, jour, &
67       knon, knindex, &
68       rugos_out, alb_out)
69!
70! This subroutine is called from surf_land_bucket.
71! The flag "ok_veget" must can not be true. If coupled run, "ocean=couple"
72! then this routine will call limit_read_tot.
73!
74    USE dimphy
75    USE surface_data
76
77! Input arguments
78!****************************************************************************************
79    INTEGER, INTENT(IN) :: itime                     ! numero du pas de temps courant
80    INTEGER, INTENT(IN) :: jour                      ! jour a lire dans l'annee
81    REAL   , INTENT(IN) :: dtime                     ! pas de temps de la physique (en s)
82    INTEGER, INTENT(IN) :: knon                      ! nomber of points on compressed grid
83    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
84! Output arguments
85!****************************************************************************************
86    REAL, DIMENSION(klon), INTENT(OUT) :: rugos_out
87    REAL, DIMENSION(klon), INTENT(OUT) :: alb_out
88   
89! Local variables
90!****************************************************************************************
91    INTEGER :: i
92    LOGICAL :: is_modified
93!****************************************************************************************
94
95    IF (type_ocean == 'couple') THEN
96       ! limit.nc has not yet been read. Do it now!
97       CALL limit_read_tot(itime, dtime, jour, is_modified)
98    END IF
99
100    DO i=1,knon
101       rugos_out(i) = rugos(knindex(i))
102       alb_out(i)  = albedo(knindex(i))
103    END DO
104
105  END SUBROUTINE limit_read_rug_alb
106
107!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
108
109  SUBROUTINE limit_read_sst(knon, knindex, sst_out)
110!
111! This subroutine returns the sea surface temperature already read from limit.nc.
112!
113    USE dimphy, ONLY : klon
114
115    INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
116    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
117    REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out
118
119    INTEGER :: i
120
121    DO i = 1, knon
122       sst_out(i) = sst(knindex(i))
123    END DO
124
125  END SUBROUTINE limit_read_sst
126
127!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
128!!
129!! Private subroutine :
130!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
131
132  SUBROUTINE limit_read_tot(itime, dtime, jour, is_modified)
133!
134! Read everything needed from limit.nc
135!
136! 0) Initialize
137! 1) Open the file limit.nc, if it is time
138! 2) Read fraction, if not type_ocean=couple
139! 3) Read sea surface temperature, if not type_ocean=couple
140! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
141! 5) Close file and distribuate variables to all processus
142
143    USE dimphy
144    USE mod_grid_phy_lmdz
145    USE mod_phys_lmdz_para
146    USE surface_data, ONLY : type_ocean, ok_veget
147    USE netcdf
148
149    IMPLICIT NONE
150   
151    INCLUDE "indicesol.h"
152
153! In- and ouput arguments
154!****************************************************************************************
155    INTEGER, INTENT(IN) :: itime   ! numero du pas de temps courant
156    INTEGER, INTENT(IN) :: jour    ! jour a lire dans l'annee
157    REAL   , INTENT(IN) :: dtime   ! pas de temps de la physique (en s)
158
159    LOGICAL, INTENT(OUT) :: is_modified  ! true if pctsrf is modified at this time step
160
161! Locals variables with attribute SAVE
162!****************************************************************************************
163! frequence de lecture des conditions limites (en pas de physique)
164    INTEGER,SAVE                              :: lmt_pas
165!$OMP THREADPRIVATE(lmt_pas)
166    LOGICAL, SAVE                             :: first_call=.TRUE.
167!$OMP THREADPRIVATE(first_call)   
168! Locals variables
169!****************************************************************************************
170    INTEGER                                   :: nid, nvarid
171    INTEGER                                   :: ii, ierr
172    INTEGER, DIMENSION(2)                     :: start, epais
173    REAL, DIMENSION(klon_glo,nbsrf)           :: pct_glo  ! fraction at global grid
174    REAL, DIMENSION(klon_glo)                 :: sst_glo  ! sea-surface temperature at global grid
175    REAL, DIMENSION(klon_glo)                 :: rug_glo  ! rugosity at global grid
176    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
177    CHARACTER(len=20)                         :: modname='limit_read_mod'     
178
179! End declaration
180!****************************************************************************************
181
182!****************************************************************************************
183! 0) Initialization
184!
185!****************************************************************************************
186    IF (first_call) THEN
187       ! calculate number of time steps for one day
188       lmt_pas = NINT(86400./dtime * 1.0)
189       
190       ! Allocate module save variables
191       IF ( type_ocean /= 'couple' ) THEN
192          ALLOCATE(pctsrf(klon,nbsrf), sst(klon), stat=ierr)
193          IF (ierr /= 0) CALL abort_gcm(modname, 'PB in allocating pctsrf and sst',1)
194       END IF
195
196       IF ( .NOT. ok_veget ) THEN
197          ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
198          IF (ierr /= 0) CALL abort_gcm(modname, 'PB in allocating rugos and albedo',1)
199       END IF
200
201       first_call=.FALSE.
202    ENDIF
203 
204!****************************************************************************************
205! 1) Open the file limit.nc if it is the right moment to read, once a day.
206!    The file is read only by the master thread of the master mpi process(is_mpi_root)
207!
208!****************************************************************************************
209
210    is_modified = .FALSE.
211    IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
212       is_modified = .TRUE.
213!$OMP MASTER  ! Only master thread
214       IF (is_mpi_root) THEN ! Only master processus
215
216          ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
217          IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,&
218               'Pb d''ouverture du fichier de conditions aux limites',1)
219         
220          ! La tranche de donnees a lire:
221          start(1) = 1
222          start(2) = jour
223          epais(1) = klon_glo
224          epais(2) = 1
225
226
227!****************************************************************************************
228! 2) Read fraction if not type_ocean=couple
229!
230!****************************************************************************************
231
232          IF ( type_ocean /= 'couple') THEN
233!
234! Ocean fraction
235             ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
236             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname, 'Le champ <FOCE> est absent',1)
237             
238             ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_oce),start,epais)
239             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FOCE>' ,1)
240!
241! Sea-ice fraction
242             ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)
243             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <FSIC> est absent',1)
244
245             ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_sic),start,epais)
246             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FSIC>' ,1)
247
248
249! Read land and continentals fraction only if asked for
250             IF (read_continents .OR. itime == 1) THEN
251!
252! Land fraction
253                ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)
254                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <FTER> est absent',1)
255               
256                ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_ter),start,epais)
257                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FTER>',1)
258!
259! Continentale ice fraction
260                ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)
261                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <FLIC> est absent',1)
262
263                ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_lic),start,epais)
264                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FLIC>',1)
265             END IF
266
267          END IF ! type_ocean /= couple
268
269!****************************************************************************************
270! 3) Read sea-surface temperature, if not coupled ocean
271!
272!****************************************************************************************
273          IF ( type_ocean /= 'couple') THEN
274
275             ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
276             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <SST> est absent',1)
277
278             ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
279             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <SST>',1)
280         
281          END IF
282
283!****************************************************************************************
284! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
285!
286!****************************************************************************************
287
288          IF (.NOT. ok_veget) THEN
289!
290! Read albedo
291             ierr = NF90_INQ_VARID(nid, 'ALB', nvarid)
292             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <ALB> est absent',1)
293
294             ierr = NF90_GET_VAR(nid,nvarid,alb_glo,start,epais)
295             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <ALB>',1)
296!
297! Read rugosity
298             ierr = NF90_INQ_VARID(nid, 'RUG', nvarid)
299             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <RUG> est absent',1)
300
301             ierr = NF90_GET_VAR(nid,nvarid,rug_glo,start,epais)
302             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <RUG>',1)
303
304          END IF
305
306!****************************************************************************************
307! 5) Close file and distribuate variables to all processus
308!
309!****************************************************************************************
310          ierr = NF90_CLOSE(nid)
311          IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Pb when closing file', 1)
312       ENDIF ! is_mpi_root
313
314!$OMP END MASTER
315!$OMP BARRIER
316
317       IF ( type_ocean /= 'couple') THEN
318          CALL Scatter(sst_glo,sst)
319          CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
320          CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))
321          IF (read_continents .OR. itime == 1) THEN
322             CALL Scatter(pct_glo(:,is_ter),pctsrf(:,is_ter))
323             CALL Scatter(pct_glo(:,is_lic),pctsrf(:,is_lic))
324          END IF
325       END IF
326
327       IF (.NOT. ok_veget) THEN
328          CALL Scatter(alb_glo, albedo)
329          CALL Scatter(rug_glo, rugos)
330       END IF
331
332    ENDIF ! time to read
333
334  END SUBROUTINE limit_read_tot
335
336
337END MODULE limit_read_mod
Note: See TracBrowser for help on using the repository browser.