source: LMDZ4/trunk/libf/phylmd/limit_read_mod.F90 @ 996

Last change on this file since 996 was 996, checked in by lsce, 16 years ago
  • Modifications liées au calcul des nouveau sous-fractions
  • Nettoyage de ocean slab : il reste uniquement la version avec glace de mer forcé
  • Nouveaux variables pour distiguer la version et type d'ocean : type_ocean=force/slab/couple, version_ocean=opa8/nemo pour couplé ou version_ocean=sicOBS pour slab

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