9 SUBROUTINE readaerosol(name_aero, type, filename, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load)
27 CHARACTER(len=7),
INTENT(IN) :: name_aero
28 CHARACTER(len=*),
INTENT(IN) ::
type
29 CHARACTER(len=8),
INTENT(IN) :: filename
30 INTEGER,
INTENT(IN) :: iyr_in
33 INTEGER,
INTENT(OUT) :: klev_src
34 REAL,
POINTER,
DIMENSION(:) :: pt_ap
35 REAL,
POINTER,
DIMENSION(:) :: pt_b
36 REAL,
POINTER,
DIMENSION(:,:,:) :: pt_out
37 REAL,
DIMENSION(klon,12),
INTENT(OUT) :: psurf
38 REAL,
DIMENSION(klon,12),
INTENT(OUT) :: load
41 CHARACTER(len=4) :: cyear
42 REAL,
POINTER,
DIMENSION(:,:,:) :: pt_2
43 REAL,
DIMENSION(klon,12) :: psurf2, load2
45 INTEGER :: iyr1, iyr2, klev_src2
47 LOGICAL,
PARAMETER :: lonlyone=.
false.
54 IF (
type ==
'actuel') then
60 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
63 ELSE IF (
type ==
'preind') then
69 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
71 ELSE IF (
type ==
'annuel') then
74 WRITE(cyear,
'(I4)') iyr_in
75 WRITE(
lunout,*)
'get_aero 3 iyr_in=', iyr_in,
' ',cyear
78 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
80 ELSE IF (
type ==
'scenario') then
83 IF (iyr_in .LT. 1850)
THEN
85 WRITE(
lunout,*)
'get_aero 1 iyr_in=', iyr_in,
' ',cyear
88 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
90 ELSE IF (iyr_in .GE. 2100)
THEN
92 WRITE(
lunout,*)
'get_aero 2 iyr_in=', iyr_in,
' ',cyear
95 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
100 IF (iyr_in.LT.1900)
THEN
103 ELSE IF (iyr_in.GE.1900.AND.iyr_in.LT.1920)
THEN
107 iyr1 = int(iyr_in/10)*10
108 iyr2 = int(1+iyr_in/10)*10
111 WRITE(cyear,
'(I4)') iyr1
112 WRITE(
lunout,*)
'get_aero 3 iyr_in=', iyr_in,
' ',cyear
115 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
118 IF (.NOT.lonlyone)
THEN
121 WRITE(cyear,
'(I4)') iyr2
122 WRITE(
lunout,*)
'get_aero 4 iyr_in=', iyr_in,
' ',cyear
127 CALL get_aero_fromfile(name_aero, cyear, filename, klev_src2, pt_ap, pt_b, p0, pt_2, psurf2, load2)
129 IF (klev_src /= klev_src2)
THEN
130 WRITE(
lunout,*)
'Two aerosols files with different number of vertical levels is not allowded'
131 CALL abort_physic(
'readaersosol',
'Error in number of vertical levels',1)
139 pt_out(i,k,it) -
REAL(iyr_in-iyr1)/
REAL(iyr2-iyr1) * &
140 (pt_out(i,k,it) - pt_2(i,k,it))
146 psurf(i,it) -
REAL(iyr_in-iyr1)/
REAL(iyr2-iyr1) * &
147 (psurf(i,it) - psurf2(i,it))
150 load(i,it) -
REAL(iyr_in-iyr1)/
REAL(iyr2-iyr1) * &
151 (load(i,it) - load2(i,it))
162 WRITE(
lunout,*)
'This option is not implemented : aer_type = ',
type,
' name_aero=',name_aero
163 CALL abort_physic(
'readaerosol',
'Error : aer_type parameter not accepted',1)
170 SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, p0, pt_year, psurf_out, load_out)
199 CHARACTER(len=7),
INTENT(IN) :: varname
200 CHARACTER(len=4),
INTENT(IN) :: cyr
201 CHARACTER(len=8),
INTENT(IN) :: filename
204 INTEGER,
INTENT(OUT) :: klev_src
205 REAL,
POINTER,
DIMENSION(:) :: pt_ap
206 REAL,
POINTER,
DIMENSION(:) :: pt_b
208 REAL,
POINTER,
DIMENSION(:,:,:) :: pt_year
209 REAL,
DIMENSION(klon,12),
INTENT(OUT) :: psurf_out
210 REAL,
DIMENSION(klon,12),
INTENT(OUT) :: load_out
211 INTEGER :: nbr_tsteps
214 CHARACTER(len=30) :: fname
215 CHARACTER(len=30) :: cvar
216 INTEGER :: ncid, dimid, varid
217 INTEGER :: imth, i, j, k, ierr
219 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: varmth
220 REAL,
ALLOCATABLE,
DIMENSION(:,:,:,:) :: varyear
221 REAL,
ALLOCATABLE,
DIMENSION(:,:,:) :: varyear_glo1D
222 REAL,
ALLOCATABLE,
DIMENSION(:) :: varktmp
224 REAL,
DIMENSION(nbp_lon,nbp_lat,12) :: psurf_glo2D
225 REAL,
DIMENSION(klon_glo,12) :: psurf_glo1D
226 REAL,
DIMENSION(nbp_lon,nbp_lat,12) :: load_glo2D
227 REAL,
DIMENSION(klon_glo,12) :: load_glo1D
228 REAL,
DIMENSION(nbp_lon,nbp_lat) :: vartmp
229 REAL,
DIMENSION(nbp_lon) :: lon_src
230 REAL,
DIMENSION(nbp_lat) :: lat_src, lat_src_inv
232 LOGICAL :: invert_lat
236 IF (
ASSOCIATED(pt_ap))
DEALLOCATE(pt_ap)
237 IF (
ASSOCIATED(pt_b))
DEALLOCATE(pt_b)
239 IF (is_mpi_root .AND. is_omp_root)
THEN
244 fname = trim(filename)//cyr//
'.nc'
246 WRITE(
lunout,*)
'reading variable ',trim(varname),
' in file ', trim(fname)
247 CALL check_err( nf90_open(trim(fname), nf90_nowrite, ncid),
"pb open "//trim(varname) )
252 CALL check_err( nf90_inq_varid(ncid,
'lon', varid),
"pb inq lon" )
253 CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),
"pb get lon" )
255 IF (maxval(abs(lon_src -
io_lon)) > 0.001)
THEN
256 WRITE(
lunout,*)
'Problem in longitudes read from file : ',trim(fname)
257 WRITE(
lunout,*)
'longitudes in file ', trim(fname),
' : ', lon_src
260 CALL abort_physic(
'get_aero_fromfile',
'longitudes are not the same in file and model',1)
264 CALL check_err( nf90_inq_varid(ncid,
'lat', varid),
"pb inq lat" )
265 CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),
"pb get lat" )
269 lat_src_inv(j) = lat_src(
nbp_lat +1 -j)
272 IF (maxval(abs(lat_src -
io_lat)) < 0.001)
THEN
275 ELSE IF (maxval(abs(lat_src_inv -
io_lat)) < 0.001)
THEN
277 WRITE(
lunout,*)
'latitudes will be inverted for file : ',trim(fname)
280 WRITE(
lunout,*)
'Problem in latitudes read from file : ',trim(fname)
281 WRITE(
lunout,*)
'latitudes in file ', trim(fname),
' : ', lat_src
283 CALL abort_physic(
'get_aero_fromfile',
'latitudes do not correspond between file and model',1)
291 ierr = nf90_inq_dimid(ncid,
'lev', dimid)
292 IF (ierr /= nf90_noerr)
THEN
294 ierr = nf90_inq_dimid(ncid,
'PRESNIVS', dimid)
295 IF (ierr /= nf90_noerr)
THEN
297 CALL abort_physic(
'get_aero_fromfile',
'dimension lev or presnivs not in file',1)
301 WRITE(
lunout,*)
'Vertical interpolation for ',trim(varname),
' will not be done'
306 WRITE(
lunout,*)
'Vertical interpolation for ',trim(varname),
' will be done'
311 CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),
"pb inq dim for PRESNIVS or lev" )
315 IF (ierr /= 0)
CALL abort_physic(
'get_aero_fromfile',
'pb in allocation 1',1)
317 ALLOCATE(pt_ap(klev_src), pt_b(klev_src), varktmp(klev_src), stat=ierr)
318 IF (ierr /= 0)
CALL abort_physic(
'get_aero_fromfile',
'pb in allocation 2',1)
329 ierr = nf90_inq_dimid(ncid,
'TIME',dimid)
330 CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps),
"pb inq dim TIME" )
332 IF (nbr_tsteps /= 12 )
THEN
333 CALL abort_physic(
'get_aero_fromfile',
'not the right number of months in aerosol file read (should be 12 for the moment)' &
340 CALL check_err( nf90_inq_varid(ncid, trim(varname), varid),
"pb inq var "//trim(varname) )
343 CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)),
"pb get var "//trim(varname) )
348 CALL check_err( nf90_inq_varid(ncid,
"ps", varid),
"pb inq var ps" )
350 CALL check_err( nf90_get_var(ncid, varid, psurf_glo2d),
"pb get var ps" )
355 CALL check_err( nf90_inq_varid(ncid,
"load_"//trim(varname), varid) ,
"pb inq var load_"//trim(varname))
357 CALL check_err( nf90_get_var(ncid, varid, load_glo2d),
"pb get var load_"//trim(varname) )
362 CALL check_err( nf90_inq_varid(ncid,
"ap", varid),
"pb inq var ap" )
364 CALL check_err( nf90_get_var(ncid, varid, pt_ap),
"pb get var ap" )
369 CALL check_err( nf90_inq_varid(ncid,
"b", varid),
"pb inq var b" )
371 CALL check_err( nf90_get_var(ncid, varid, pt_b),
"pb get var b" )
376 CALL check_err( nf90_inq_varid(ncid,
"p0", varid),
"pb inq var p0" )
378 CALL check_err( nf90_get_var(ncid, varid, p0),
"pb get var p0" )
387 cvar=trim(varname)//
'JAN'
388 ELSE IF (imth.EQ.2)
THEN
389 cvar=trim(varname)//
'FEB'
390 ELSE IF (imth.EQ.3)
THEN
391 cvar=trim(varname)//
'MAR'
392 ELSE IF (imth.EQ.4)
THEN
393 cvar=trim(varname)//
'APR'
394 ELSE IF (imth.EQ.5)
THEN
395 cvar=trim(varname)//
'MAY'
396 ELSE IF (imth.EQ.6)
THEN
397 cvar=trim(varname)//
'JUN'
398 ELSE IF (imth.EQ.7)
THEN
399 cvar=trim(varname)//
'JUL'
400 ELSE IF (imth.EQ.8)
THEN
401 cvar=trim(varname)//
'AUG'
402 ELSE IF (imth.EQ.9)
THEN
403 cvar=trim(varname)//
'SEP'
404 ELSE IF (imth.EQ.10)
THEN
405 cvar=trim(varname)//
'OCT'
406 ELSE IF (imth.EQ.11)
THEN
407 cvar=trim(varname)//
'NOV'
408 ELSE IF (imth.EQ.12)
THEN
409 cvar=trim(varname)//
'DEC'
413 CALL check_err( nf90_inq_varid(ncid, trim(cvar), varid),
"pb inq var "//trim(cvar) )
416 CALL check_err( nf90_get_var(ncid, varid, varmth),
"pb get var "//trim(cvar) )
419 varyear(:,:,:,imth)=varmth(:,:,:)
433 CALL check_err( nf90_close(ncid),
"pb in close" )
440 IF ((pt_b(1) < pt_b(klev_src)) .OR. .NOT. new_file)
THEN
447 varmth(:,:,:) = varyear(:,:,:,imth)
451 varyear(i,j,k,imth) = varmth(i,j,klev_src+1-k)
458 varktmp(:) = pt_ap(:)
460 pt_ap(k) = varktmp(klev_src+1-k)
465 pt_b(k) = varktmp(klev_src+1-k)
467 WRITE(
lunout,*)
'after pt_ap = ', pt_ap
468 WRITE(
lunout,*)
'after pt_b = ', pt_b
471 WRITE(
lunout,*)
'Vertical axis in file ',trim(fname),
' is ok, no vertical inversion is done'
472 WRITE(
lunout,*)
'pt_ap = ', pt_ap
473 WRITE(
lunout,*)
'pt_b = ', pt_b
481 varmth(:,:,:) = varyear(:,:,:,imth)
485 varyear(i,j,k,imth) = varmth(i,
nbp_lat+1-j,k)
491 vartmp(:,:) = psurf_glo2d(:,:,imth)
494 psurf_glo2d(i,j,imth)= vartmp(i,
nbp_lat+1-j)
499 vartmp(:,:) = load_glo2d(:,:,imth)
502 load_glo2d(i,j,imth)= vartmp(i,
nbp_lat+1-j)
512 npole = npole + varyear(i,1,k,imth)
513 spole = spole + varyear(i,
nbp_lat,k,imth)
517 varyear(:,1, k,imth) = npole
518 varyear(:,
nbp_lat,k,imth) = spole
522 ALLOCATE(varyear_glo1d(
klon_glo, klev_src, 12), stat=ierr)
523 IF (ierr /= 0)
CALL abort_physic(
'get_aero_fromfile',
'pb in allocation 3',1)
531 ALLOCATE(varyear_glo1d(0,0,0))
545 IF (.NOT.
ASSOCIATED(pt_ap))
THEN
546 ALLOCATE(pt_ap(klev_src), pt_b(klev_src), stat=ierr)
547 IF (ierr /= 0)
CALL abort_physic(
'get_aero_fromfile',
'pb in allocation 4',1)
553 IF (
ASSOCIATED(pt_year))
DEALLOCATE(pt_year)
554 ALLOCATE(pt_year(
klon, klev_src, 12), stat=ierr)
555 IF (ierr /= 0)
CALL abort_physic(
'get_aero_fromfile',
'pb in allocation 5',1)
558 CALL scatter(varyear_glo1d, pt_year)
559 CALL scatter(psurf_glo1d, psurf_out)
560 CALL scatter(load_glo1d, load_out)
564 IF (minval(pt_year) < 0.)
THEN
565 WRITE(
lunout,*)
'Warning! Negative values read from file :', fname
576 INTEGER,
INTENT (IN) :: status
577 CHARACTER(len=*),
INTENT (IN),
OPTIONAL :: text
579 IF (status /= nf90_noerr)
THEN
580 WRITE(
lunout,*)
'Error in get_aero_fromfile, netcdf error code = ',status
581 IF (
PRESENT(text))
THEN
582 WRITE(
lunout,*)
'Error in get_aero_fromfile : ',text
584 CALL abort_physic(
'get_aero_fromfile',trim(nf90_strerror(status)),1)
!IM Implemente en modes sequentiel et parallele CALL rlon_glo CALL bcast(rlon_glo)!$OMP MASTER if(is_mpi_root) then!zstophy
real, dimension(:), allocatable, save io_lat
subroutine check_err(status, text)
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
subroutine get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, p0, pt_year, psurf_out, load_out)
real, dimension(:), allocatable, save io_lon
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
subroutine readaerosol(name_aero, type, filename, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load)
subroutine abort_physic(modname, message, ierr)
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout