source: lmdz_wrf/WRFV3/lmdz/limit_read_mod.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 13.1 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    USE indice_sol_mod
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    PRINT *,'  Lluis: knon: ',knon,' sst_out: ',UBOUND(sst_out),' : ',UBOUND(sst), 'x', UBOUND(knindex)
122
123    DO i = 1, knon
124       sst_out(i) = sst(knindex(i))
125    END DO
126
127  END SUBROUTINE limit_read_sst
128
129!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
130!!
131!! Private subroutine :
132!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
133
134  SUBROUTINE limit_read_tot(itime, dtime, jour, is_modified)
135!
136! Read everything needed from limit.nc
137!
138! 0) Initialize
139! 1) Open the file limit.nc, if it is time
140! 2) Read fraction, if not type_ocean=couple
141! 3) Read sea surface temperature, if not type_ocean=couple
142! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
143! 5) Close file and distribuate variables to all processus
144
145    USE dimphy
146    USE mod_grid_phy_lmdz
147    USE mod_phys_lmdz_para
148    USE surface_data, ONLY : type_ocean, ok_veget
149    USE netcdf
150    USE indice_sol_mod
151
152    IMPLICIT NONE
153   
154    INCLUDE "iniprint.h"
155
156! In- and ouput arguments
157!****************************************************************************************
158    INTEGER, INTENT(IN) :: itime   ! numero du pas de temps courant
159    INTEGER, INTENT(IN) :: jour    ! jour a lire dans l'annee
160    REAL   , INTENT(IN) :: dtime   ! pas de temps de la physique (en s)
161
162    LOGICAL, INTENT(OUT) :: is_modified  ! true if pctsrf is modified at this time step
163
164! Locals variables with attribute SAVE
165!****************************************************************************************
166! frequence de lecture des conditions limites (en pas de physique)
167    INTEGER,SAVE                              :: lmt_pas
168!$OMP THREADPRIVATE(lmt_pas)
169    LOGICAL, SAVE                             :: first_call=.TRUE.
170!$OMP THREADPRIVATE(first_call) 
171    INTEGER, SAVE                             :: jour_lu = -1
172!$OMP THREADPRIVATE(jour_lu) 
173! Locals variables
174!****************************************************************************************
175    INTEGER                                   :: nid, nvarid
176    INTEGER                                   :: ii, ierr
177    INTEGER, DIMENSION(2)                     :: start, epais
178    REAL, DIMENSION(klon_glo,nbsrf)           :: pct_glo  ! fraction at global grid
179    REAL, DIMENSION(klon_glo)                 :: sst_glo  ! sea-surface temperature at global grid
180    REAL, DIMENSION(klon_glo)                 :: rug_glo  ! rugosity at global grid
181    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
182    CHARACTER(len=20)                         :: modname='limit_read_mod'     
183
184! End declaration
185!****************************************************************************************
186
187!****************************************************************************************
188! 0) Initialization
189!
190!****************************************************************************************
191    IF (first_call) THEN
192       ! calculate number of time steps for one day
193       lmt_pas = NINT(86400./dtime * 1.0)
194       
195       ! Allocate module save variables
196       IF ( type_ocean /= 'couple' ) THEN
197          ALLOCATE(pctsrf(klon,nbsrf), sst(klon), stat=ierr)
198          IF (ierr /= 0) CALL abort_gcm(modname, 'PB in allocating pctsrf and sst',1)
199       END IF
200
201       IF ( .NOT. ok_veget ) THEN
202          ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
203          IF (ierr /= 0) CALL abort_gcm(modname, 'PB in allocating rugos and albedo',1)
204       END IF
205
206       first_call=.FALSE.
207    ENDIF
208 
209!****************************************************************************************
210! 1) Open the file limit.nc if it is the right moment to read, once a day.
211!    The file is read only by the master thread of the master mpi process(is_mpi_root)
212!
213!****************************************************************************************
214
215    is_modified = .FALSE.
216    IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN   ! time to read
217       jour_lu = jour
218       is_modified = .TRUE.
219!$OMP MASTER  ! Only master thread
220       IF (is_mpi_root) THEN ! Only master processus
221
222          ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
223          IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,&
224               'Pb d''ouverture du fichier de conditions aux limites',1)
225         
226          ! La tranche de donnees a lire:
227          start(1) = 1
228          start(2) = jour
229          epais(1) = klon_glo
230          epais(2) = 1
231
232
233!****************************************************************************************
234! 2) Read fraction if not type_ocean=couple
235!
236!****************************************************************************************
237
238          IF ( type_ocean /= 'couple') THEN
239!
240! Ocean fraction
241             ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
242             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname, 'Le champ <FOCE> est absent',1)
243             
244             ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_oce),start,epais)
245             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FOCE>' ,1)
246!
247! Sea-ice fraction
248             ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)
249             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <FSIC> est absent',1)
250
251             ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_sic),start,epais)
252             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FSIC>' ,1)
253
254
255! Read land and continentals fraction only if asked for
256             IF (read_continents .OR. itime == 1) THEN
257!
258! Land fraction
259                ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)
260                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <FTER> est absent',1)
261               
262                ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_ter),start,epais)
263                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FTER>',1)
264!
265! Continentale ice fraction
266                ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)
267                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <FLIC> est absent',1)
268
269                ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_lic),start,epais)
270                IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <FLIC>',1)
271             END IF
272
273          END IF ! type_ocean /= couple
274
275!****************************************************************************************
276! 3) Read sea-surface temperature, if not coupled ocean
277!
278!****************************************************************************************
279          IF ( type_ocean /= 'couple') THEN
280
281             ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
282             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <SST> est absent',1)
283
284             ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
285             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <SST>',1)
286         
287          END IF
288
289!****************************************************************************************
290! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
291!
292!****************************************************************************************
293
294          IF (.NOT. ok_veget) THEN
295!
296! Read albedo
297             ierr = NF90_INQ_VARID(nid, 'ALB', nvarid)
298             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <ALB> est absent',1)
299
300             ierr = NF90_GET_VAR(nid,nvarid,alb_glo,start,epais)
301             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <ALB>',1)
302!
303! Read rugosity
304             ierr = NF90_INQ_VARID(nid, 'RUG', nvarid)
305             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <RUG> est absent',1)
306
307             ierr = NF90_GET_VAR(nid,nvarid,rug_glo,start,epais)
308             IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <RUG>',1)
309
310          END IF
311
312!****************************************************************************************
313! 5) Close file and distribuate variables to all processus
314!
315!****************************************************************************************
316          ierr = NF90_CLOSE(nid)
317          IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Pb when closing file', 1)
318       ENDIF ! is_mpi_root
319
320!$OMP END MASTER
321!$OMP BARRIER
322
323       IF ( type_ocean /= 'couple') THEN
324          CALL Scatter(sst_glo,sst)
325          CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
326          CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))
327          IF (read_continents .OR. itime == 1) THEN
328             CALL Scatter(pct_glo(:,is_ter),pctsrf(:,is_ter))
329             CALL Scatter(pct_glo(:,is_lic),pctsrf(:,is_lic))
330          END IF
331       END IF
332
333       IF (.NOT. ok_veget) THEN
334          CALL Scatter(alb_glo, albedo)
335          CALL Scatter(rug_glo, rugos)
336       END IF
337
338    ENDIF ! time to read
339
340  END SUBROUTINE limit_read_tot
341
342
343END MODULE limit_read_mod
Note: See TracBrowser for help on using the repository browser.