Context Navigation

readaerosol.F90 @ 1319

Last change on this file since 1319 was 1319, checked in by Laurent Fairhead, 15 years ago

Modifications to the start and limit creation routines to account for different

calendars

Modification to phyetat0 to force the mask read in the start files to match the

surface fractions read in the limit file

Force readaerosol.F90 to read in aerosols file with 12 timesteps

Modifications aux routines de créations des fichiers start et limit pour prendre

en compte différents calendriers

Modification à phyetat0 pour forcer le masque lu dans le fichier start à être

compatible avec les fractions de surface lu dans le fichier limit

Forcer readaerosol à ne lire que des fichiers à 12 pas de temps

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 23.1 KB

Line
1	! $Id: readaerosol.F90 1319 2010-02-23 21:29:54Z fairhead $
2	!
3	MODULE readaerosol_mod
4
5	REAL, SAVE :: not_valid=-333.
6
7	CONTAINS
8
9	SUBROUTINE readaerosol(name_aero, type, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load)
10
11	!****************************************************************************************
12	! This routine will read the aersosol from file.
13	!
14	! Read a year data with get_aero_fromfile depending on aer_type :
15	! - actuel : read year 1980
16	! - preind : read natural data
17	! - scenario : read one or two years and do eventually linare time interpolation
18	!
19	! Return pointer, pt_out, to the year read or result from interpolation
20	!****************************************************************************************
21	USE dimphy
22
23	IMPLICIT NONE
24
25	INCLUDE "iniprint.h"
26
27	! Input arguments
28	CHARACTER(len=7), INTENT(IN) :: name_aero
29	CHARACTER(len=*), INTENT(IN) :: type ! correspond to aer_type in clesphys.h
30	INTEGER, INTENT(IN) :: iyr_in
31
32	! Output
33	INTEGER, INTENT(OUT) :: klev_src
34	REAL, POINTER, DIMENSION(:) :: pt_ap ! Pointer for describing the vertical levels
35	REAL, POINTER, DIMENSION(:) :: pt_b ! Pointer for describing the vertical levels
36	REAL, POINTER, DIMENSION(:,:,:) :: pt_out ! The massvar distributions, DIMENSION(klon, klev_src, 12)
37	REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf ! Surface pression for 12 months
38	REAL, DIMENSION(klon,12), INTENT(OUT) :: load ! Aerosol mass load in each column for 12 months
39
40	! Local variables
41	CHARACTER(len=4) :: cyear
42	REAL, POINTER, DIMENSION(:,:,:) :: pt_2
43	REAL, DIMENSION(klon,12) :: psurf2, load2
44	REAL :: p0 ! Reference pressure
45	INTEGER :: iyr1, iyr2, klev_src2
46	INTEGER :: it, k, i
47	LOGICAL, PARAMETER :: lonlyone=.FALSE.
48
49	!****************************************************************************************
50	! Read data depending on aer_type
51	!
52	!****************************************************************************************
53
54	IF (type == 'actuel') THEN
55	! Read and return data for year 1980
56	!****************************************************************************************
57	cyear='1980'
58	! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
59	! pt_out has dimensions (klon, klev_src, 12)
60	CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
61
62
63	ELSE IF (type == 'preind') THEN
64	! Read and return data from file with suffix .nat
65	!****************************************************************************************
66	cyear='.nat'
67	! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
68	! pt_out has dimensions (klon, klev_src, 12)
69	CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
70
71	ELSE IF (type == 'scenario') THEN
72	! Read data depending on actual year and interpolate if necessary
73	!****************************************************************************************
74	IF (iyr_in .LT. 1850) THEN
75	cyear='.nat'
76	WRITE(lunout,*) 'get_aero 1 iyr_in=', iyr_in,' ',cyear
77	! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
78	! pt_out has dimensions (klon, klev_src, 12)
79	CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
80
81	ELSE IF (iyr_in .GE. 2100) THEN
82	cyear='2100'
83	WRITE(lunout,*) 'get_aero 2 iyr_in=', iyr_in,' ',cyear
84	! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
85	! pt_out has dimensions (klon, klev_src, 12)
86	CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
87
88	ELSE
89	! Read data from 2 decades and interpolate to actual year
90	! a) from actual 10-yr-period
91	IF (iyr_in.LT.1900) THEN
92	iyr1 = 1850
93	iyr2 = 1900
94	ELSE IF (iyr_in.GE.1900.AND.iyr_in.LT.1920) THEN
95	iyr1 = 1900
96	iyr2 = 1920
97	ELSE
98	iyr1 = INT(iyr_in/10)*10
99	iyr2 = INT(1+iyr_in/10)*10
100	ENDIF
101
102	WRITE(cyear,'(I4)') iyr1
103	WRITE(lunout,*) 'get_aero 3 iyr_in=', iyr_in,' ',cyear
104	! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
105	! pt_out has dimensions (klon, klev_src, 12)
106	CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
107
108	! If to read two decades:
109	IF (.NOT.lonlyone) THEN
110
111	! b) from the next following one
112	WRITE(cyear,'(I4)') iyr2
113	WRITE(lunout,*) 'get_aero 4 iyr_in=', iyr_in,' ',cyear
114
115	NULLIFY(pt_2)
116	! get_aero_fromfile returns pt_2 allocated and initialized with data for 12 month
117	! pt_2 has dimensions (klon, klev_src, 12)
118	CALL get_aero_fromfile(name_aero, cyear, klev_src2, pt_ap, pt_b, p0, pt_2, psurf2, load2)
119	! Test for same number of vertical levels
120	IF (klev_src /= klev_src2) THEN
121	WRITE(lunout,*) 'Two aerosols files with different number of vertical levels is not allowded'
122	CALL abort_gcm('readaersosol','Error in number of vertical levels',1)
123	END IF
124
125	! Linare interpolate to the actual year:
126	DO it=1,12
127	DO k=1,klev_src
128	DO i = 1, klon
129	pt_out(i,k,it) = &
130	pt_out(i,k,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &
131	(pt_out(i,k,it) - pt_2(i,k,it))
132	END DO
133	END DO
134
135	DO i = 1, klon
136	psurf(i,it) = &
137	psurf(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &
138	(psurf(i,it) - psurf2(i,it))
139
140	load(i,it) = &
141	load(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &
142	(load(i,it) - load2(i,it))
143	END DO
144	END DO
145
146	! Deallocate pt_2 no more needed
147	DEALLOCATE(pt_2)
148
149	END IF ! lonlyone
150	END IF ! iyr_in .LT. 1850
151
152	ELSE
153	WRITE(lunout,*)'This option is not implemented : aer_type = ', type
154	CALL abort_gcm('readaerosol','Error : aer_type parameter not accepted',1)
155	END IF ! type
156
157
158	END SUBROUTINE readaerosol
159
160
161	SUBROUTINE get_aero_fromfile(varname, cyr, klev_src, pt_ap, pt_b, p0, pt_year, psurf_out, load_out)
162	!****************************************************************************************
163	! Read 12 month aerosol from file and distribute to local process on physical grid.
164	! Vertical levels, klev_src, may differ from model levels if new file format.
165	!
166	! For mpi_root and master thread :
167	! 1) Open file
168	! 2) Find vertical dimension klev_src
169	! 3) Read field month by month
170	! 4) Close file
171	! 5) Transform the global field from 2D(iim, jjp+1) to 1D(klon_glo)
172	! - Also the levels and the latitudes have to be inversed
173	!
174	! For all processes and threads :
175	! 6) Scatter global field(klon_glo) to local process domain(klon)
176	! 7) Test for negative values
177	!****************************************************************************************
178
179	USE netcdf
180	USE dimphy
181	USE mod_grid_phy_lmdz
182	USE mod_phys_lmdz_para
183	USE iophy, ONLY : io_lon, io_lat
184
185	IMPLICIT NONE
186
187	INCLUDE "dimensions.h"
188	INCLUDE "iniprint.h"
189
190	! Input argumets
191	CHARACTER(len=7), INTENT(IN) :: varname
192	CHARACTER(len=4), INTENT(IN) :: cyr
193
194	! Output arguments
195	INTEGER, INTENT(OUT) :: klev_src ! Number of vertical levels in file
196	REAL, POINTER, DIMENSION(:) :: pt_ap ! Pointer for describing the vertical levels
197	REAL, POINTER, DIMENSION(:) :: pt_b ! Pointer for describing the vertical levels
198	REAL :: p0 ! Reference pressure value
199	REAL, POINTER, DIMENSION(:,:,:) :: pt_year ! Pointer-variabale from file, 12 month, grid : klon,klev_src
200	REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf_out ! Surface pression for 12 months
201	REAL, DIMENSION(klon,12), INTENT(OUT) :: load_out ! Aerosol mass load in each column
202	INTEGER :: nbr_tsteps ! number of month in file read
203
204	! Local variables
205	CHARACTER(len=30) :: fname
206	CHARACTER(len=8) :: filename='aerosols'
207	CHARACTER(len=30) :: cvar
208	INTEGER :: ncid, dimid, varid
209	INTEGER :: imth, i, j, k, ierr
210	REAL :: npole, spole
211	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varmth
212	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: varyear ! Global variable read from file, 12 month
213	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varyear_glo1D !(klon_glo, klev_src, 12)
214	REAL, ALLOCATABLE, DIMENSION(:) :: varktmp
215
216	REAL, DIMENSION(iim,jjm+1,12) :: psurf_glo2D ! Surface pression for 12 months on dynamics global grid
217	REAL, DIMENSION(klon_glo,12) :: psurf_glo1D ! -"- on physical global grid
218	REAL, DIMENSION(iim,jjm+1,12) :: load_glo2D ! Load for 12 months on dynamics global grid
219	REAL, DIMENSION(klon_glo,12) :: load_glo1D ! -"- on physical global grid
220	REAL, DIMENSION(iim,jjm+1) :: vartmp
221	REAL, DIMENSION(iim) :: lon_src ! longitudes in file
222	REAL, DIMENSION(jjm+1) :: lat_src, lat_src_inv ! latitudes in file
223	LOGICAL :: new_file ! true if new file format detected
224	LOGICAL :: invert_lat ! true if the field has to be inverted for latitudes
225
226
227	! Deallocate pointers
228	IF (ASSOCIATED(pt_ap)) DEALLOCATE(pt_ap)
229	IF (ASSOCIATED(pt_b)) DEALLOCATE(pt_b)
230
231	IF (is_mpi_root .AND. is_omp_root) THEN
232
233	! 1) Open file
234	!****************************************************************************************
235	fname = filename//cyr//'.nc'
236
237	WRITE(lunout,*) 'reading ', TRIM(fname)
238	CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid) )
239
240	! Test for equal longitudes and latitudes in file and model
241	!****************************************************************************************
242	! Read and test longitudes
243	CALL check_err( nf90_inq_varid(ncid, 'lon', varid) )
244	CALL check_err( nf90_get_var(ncid, varid, lon_src(:)) )
245
246	IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN
247	WRITE(lunout,*) 'Problem in longitudes read from file : ',TRIM(fname)
248	WRITE(lunout,*) 'longitudes in file ', TRIM(fname),' : ', lon_src
249	WRITE(lunout,*) 'longitudes in model :', io_lon
250
251	CALL abort_gcm('get_aero_fromfile', 'longitudes are not the same in file and model',1)
252	END IF
253
254	! Read and test latitudes
255	CALL check_err( nf90_inq_varid(ncid, 'lat', varid) )
256	CALL check_err( nf90_get_var(ncid, varid, lat_src(:)) )
257
258	! Invert source latitudes
259	DO j = 1, jjm+1
260	lat_src_inv(j) = lat_src(jjm+1 +1 -j)
261	END DO
262
263	IF (maxval(ABS(lat_src - io_lat)) < 0.001) THEN
264	! Latitudes are the same
265	invert_lat=.FALSE.
266	ELSE IF (maxval(ABS(lat_src_inv - io_lat)) < 0.001) THEN
267	! Inverted source latitudes correspond to model latitudes
268	WRITE(lunout,*) 'latitudes will be inverted for file : ',TRIM(fname)
269	invert_lat=.TRUE.
270	ELSE
271	WRITE(lunout,*) 'Problem in latitudes read from file : ',TRIM(fname)
272	WRITE(lunout,*) 'latitudes in file ', TRIM(fname),' : ', lat_src
273	WRITE(lunout,*) 'latitudes in model :', io_lat
274	CALL abort_gcm('get_aero_fromfile', 'latitudes do not correspond between file and model',1)
275	END IF
276
277	! 1.5) Check number of month in file opened
278	!
279	!**************************************************************************************************
280	ierr = nf90_inq_dimid(ncid, 'TIME',dimid)
281	CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps) )
282	! IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN
283	IF (nbr_tsteps /= 12 ) THEN
284	CALL abort_gcm('get_aero_fromfile', 'not the right number of months in aerosol file read (should be 12 for the moment)',1)
285	ENDIF
286
287
288	! 2) Check if old or new file is avalabale.
289	! New type of file should contain the dimension 'lev'
290	! Old type of file should contain the dimension 'PRESNIVS'
291	!****************************************************************************************
292	ierr = nf90_inq_dimid(ncid, 'lev', dimid)
293	IF (ierr /= NF90_NOERR) THEN
294	! Coordinate axe lev not found. Check for presnivs.
295	ierr = nf90_inq_dimid(ncid, 'PRESNIVS', dimid)
296	IF (ierr /= NF90_NOERR) THEN
297	! Dimension PRESNIVS not found either
298	CALL abort_gcm('get_aero_fromfile', 'dimension lev or presnivs not in file',1)
299	ELSE
300	! Old file found
301	new_file=.FALSE.
302	WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will not be done'
303	END IF
304	ELSE
305	! New file found
306	new_file=.TRUE.
307	WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will be done'
308	END IF
309
310	! 2) Find vertical dimension klev_src
311	!****************************************************************************************
312	CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src) )
313
314	! Allocate variables depending on the number of vertical levels
315	ALLOCATE(varmth(iim, jjm+1, klev_src), varyear(iim, jjm+1, klev_src, 12), stat=ierr)
316	IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 1',1)
317
318	ALLOCATE(pt_ap(klev_src), pt_b(klev_src), varktmp(klev_src), stat=ierr)
319	IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 2',1)
320
321	! 3) Read all variables from file
322	! There is 2 options for the file structure :
323	! new_file=TRUE : read varyear, ps, pt_ap and pt_b
324	! new_file=FALSE : read varyear month by month
325	!****************************************************************************************
326
327	IF (new_file) THEN
328
329	! ++) Read the aerosol concentration month by month and concatenate to total variable varyear
330	!****************************************************************************************
331	! Get variable id
332	CALL check_err( nf90_inq_varid(ncid, TRIM(varname), varid) )
333
334	! Get the variable
335	CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)) )
336
337	! ++) Read surface pression, 12 month in one variable
338	!****************************************************************************************
339	! Get variable id
340	CALL check_err( nf90_inq_varid(ncid, "ps", varid) )
341	! Get the variable
342	CALL check_err( nf90_get_var(ncid, varid, psurf_glo2D) )
343
344	! ++) Read mass load, 12 month in one variable
345	!****************************************************************************************
346	! Get variable id
347	CALL check_err( nf90_inq_varid(ncid, "load_"//TRIM(varname), varid) )
348	! Get the variable
349	CALL check_err( nf90_get_var(ncid, varid, load_glo2D) )
350
351	! ++) Read ap
352	!****************************************************************************************
353	! Get variable id
354	CALL check_err( nf90_inq_varid(ncid, "ap", varid) )
355	! Get the variable
356	CALL check_err( nf90_get_var(ncid, varid, pt_ap) )
357
358	! ++) Read b
359	!****************************************************************************************
360	! Get variable id
361	CALL check_err( nf90_inq_varid(ncid, "b", varid) )
362	! Get the variable
363	CALL check_err( nf90_get_var(ncid, varid, pt_b) )
364
365	! ++) Read p0 : reference pressure
366	!****************************************************************************************
367	! Get variable id
368	CALL check_err( nf90_inq_varid(ncid, "p0", varid) )
369	! Get the variable
370	CALL check_err( nf90_get_var(ncid, varid, p0) )
371
372
373	ELSE ! old file
374
375	! ++) Read the aerosol concentration month by month and concatenate to total variable varyear
376	!****************************************************************************************
377	DO imth=1, 12
378	IF (imth.EQ.1) THEN
379	cvar=TRIM(varname)//'JAN'
380	ELSE IF (imth.EQ.2) THEN
381	cvar=TRIM(varname)//'FEB'
382	ELSE IF (imth.EQ.3) THEN
383	cvar=TRIM(varname)//'MAR'
384	ELSE IF (imth.EQ.4) THEN
385	cvar=TRIM(varname)//'APR'
386	ELSE IF (imth.EQ.5) THEN
387	cvar=TRIM(varname)//'MAY'
388	ELSE IF (imth.EQ.6) THEN
389	cvar=TRIM(varname)//'JUN'
390	ELSE IF (imth.EQ.7) THEN
391	cvar=TRIM(varname)//'JUL'
392	ELSE IF (imth.EQ.8) THEN
393	cvar=TRIM(varname)//'AUG'
394	ELSE IF (imth.EQ.9) THEN
395	cvar=TRIM(varname)//'SEP'
396	ELSE IF (imth.EQ.10) THEN
397	cvar=TRIM(varname)//'OCT'
398	ELSE IF (imth.EQ.11) THEN
399	cvar=TRIM(varname)//'NOV'
400	ELSE IF (imth.EQ.12) THEN
401	cvar=TRIM(varname)//'DEC'
402	END IF
403
404	! Get variable id
405	CALL check_err( nf90_inq_varid(ncid, TRIM(cvar), varid) )
406
407	! Get the variable
408	CALL check_err( nf90_get_var(ncid, varid, varmth) )
409
410	! Store in variable for the whole year
411	varyear(:,:,:,imth)=varmth(:,:,:)
412
413	END DO
414
415	! Putting dummy
416	psurf_glo2D(:,:,:) = not_valid
417	load_glo2D(:,:,:) = not_valid
418	pt_ap(:) = not_valid
419	pt_b(:) = not_valid
420
421	END IF
422
423	! 4) Close file
424	!****************************************************************************************
425	CALL check_err( nf90_close(ncid) )
426
427
428	! 5) Transform the global field from 2D(iim, jjp+1) to 1D(klon_glo)
429	!****************************************************************************************
430	! Test if vertical levels have to be inversed
431
432	IF ((pt_b(1) < pt_b(klev_src)) .OR. .NOT. new_file) THEN
433	WRITE(lunout,*) 'Vertical axis in file ',TRIM(fname), ' needs to be inverted'
434	WRITE(lunout,*) 'before pt_ap = ', pt_ap
435	WRITE(lunout,*) 'before pt_b = ', pt_b
436
437	! Inverse vertical levels for varyear
438	DO imth=1, 12
439	varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly
440	DO k=1, klev_src
441	DO j=1, jjm+1
442	DO i=1,iim
443	varyear(i,j,k,imth) = varmth(i,j,klev_src+1-k)
444	END DO
445	END DO
446	END DO
447	END DO
448
449	! Inverte vertical axes for pt_ap and pt_b
450	varktmp(:) = pt_ap(:)
451	DO k=1, klev_src
452	pt_ap(k) = varktmp(klev_src+1-k)
453	END DO
454
455	varktmp(:) = pt_b(:)
456	DO k=1, klev_src
457	pt_b(k) = varktmp(klev_src+1-k)
458	END DO
459	WRITE(lunout,*) 'after pt_ap = ', pt_ap
460	WRITE(lunout,*) 'after pt_b = ', pt_b
461
462	ELSE
463	WRITE(lunout,*) 'Vertical axis in file ',TRIM(fname), ' is ok, no vertical inversion is done'
464	WRITE(lunout,*) 'pt_ap = ', pt_ap
465	WRITE(lunout,*) 'pt_b = ', pt_b
466	END IF
467
468	! - Invert latitudes if necessary
469	DO imth=1, 12
470	IF (invert_lat) THEN
471
472	! Invert latitudes for the variable
473	varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly
474	DO k=1,klev_src
475	DO j=1,jjm+1
476	DO i=1,iim
477	varyear(i,j,k,imth) = varmth(i,jjm+1+1-j,k)
478	END DO
479	END DO
480	END DO
481
482	! Invert latitudes for surface pressure
483	vartmp(:,:) = psurf_glo2D(:,:,imth)
484	DO j=1, jjm+1
485	DO i=1,iim
486	psurf_glo2D(i,j,imth)= vartmp(i,jjm+1+1-j)
487	END DO
488	END DO
489
490	! Invert latitudes for the load
491	vartmp(:,:) = load_glo2D(:,:,imth)
492	DO j=1, jjm+1
493	DO i=1,iim
494	load_glo2D(i,j,imth)= vartmp(i,jjm+1+1-j)
495	END DO
496	END DO
497	END IF ! invert_lat
498
499	! Do zonal mead at poles and distribut at whole first and last latitude
500	DO k=1, klev_src
501	npole=0. ! North pole, j=1
502	spole=0. ! South pole, j=jjm+1
503	DO i=1,iim
504	npole = npole + varyear(i,1,k,imth)
505	spole = spole + varyear(i,jjm+1,k,imth)
506	END DO
507	npole = npole/FLOAT(iim)
508	spole = spole/FLOAT(iim)
509	varyear(:,1, k,imth) = npole
510	varyear(:,jjm+1,k,imth) = spole
511	END DO
512	END DO ! imth
513
514	ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr)
515	IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 3',1)
516
517	! Transform from 2D to 1D field
518	CALL grid2Dto1D_glo(varyear,varyear_glo1D)
519	CALL grid2Dto1D_glo(psurf_glo2D,psurf_glo1D)
520	CALL grid2Dto1D_glo(load_glo2D,load_glo1D)
521
522	ELSE
523	ALLOCATE(varyear_glo1D(0,0,0))
524	END IF ! is_mpi_root .AND. is_omp_root
525
526	!$OMP BARRIER
527
528	! 6) Distribute to all processes
529	! Scatter global field(klon_glo) to local process domain(klon)
530	! and distribute klev_src to all processes
531	!****************************************************************************************
532
533	! Distribute klev_src
534	CALL bcast(klev_src)
535
536	! Allocate and distribute pt_ap and pt_b
537	IF (.NOT. ASSOCIATED(pt_ap)) THEN ! if pt_ap is allocated also pt_b is allocated
538	ALLOCATE(pt_ap(klev_src), pt_b(klev_src), stat=ierr)
539	IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 4',1)
540	END IF
541	CALL bcast(pt_ap)
542	CALL bcast(pt_b)
543
544	! Allocate space for output pointer variable at local process
545	IF (ASSOCIATED(pt_year)) DEALLOCATE(pt_year)
546	ALLOCATE(pt_year(klon, klev_src, 12), stat=ierr)
547	IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 5',1)
548
549	! Scatter global field to local domain at local process
550	CALL scatter(varyear_glo1D, pt_year)
551	CALL scatter(psurf_glo1D, psurf_out)
552	CALL scatter(load_glo1D, load_out)
553
554	! 7) Test for negative values
555	!****************************************************************************************
556	IF (MINVAL(pt_year) < 0.) THEN
557	WRITE(lunout,*) 'Warning! Negative values read from file :', fname
558	END IF
559
560	END SUBROUTINE get_aero_fromfile
561
562
563	SUBROUTINE check_err(status)
564	USE netcdf
565	IMPLICIT NONE
566
567	INCLUDE "iniprint.h"
568	INTEGER, INTENT (IN) :: status
569
570	IF (status /= NF90_NOERR) THEN
571	WRITE(lunout,*) 'Error in get_aero_fromfile ',status
572	CALL abort_gcm('get_aero_fromfile',trim(nf90_strerror(status)),1)
573	END IF
574
575	END SUBROUTINE check_err
576
577
578	END MODULE readaerosol_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format