source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/limit_read_mod.F90

Last change on this file was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

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