source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/limit_read_mod.F90 @ 3814

Last change on this file since 3814 was 3814, checked in by ymipsl, 10 years ago

remove all dynamic dependency in LMDZ physics except for the include "dimensions.h"

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