Changeset 1270 for LMDZ4/branches/LMDZ4-dev/libf/phylmd/readaerosol.F90
- Timestamp:
- Nov 25, 2009, 3:02:45 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/phylmd/readaerosol.F90
r1265 r1270 7 7 CONTAINS 8 8 9 SUBROUTINE readaerosol(name_aero, type, iyr_in, klev_src, pt_ap, pt_b, pt_out, p t_psurf, pt_load, nbr_tsteps)9 SUBROUTINE readaerosol(name_aero, type, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load) 10 10 11 11 !**************************************************************************************** … … 34 34 REAL, POINTER, DIMENSION(:) :: pt_ap ! Pointer for describing the vertical levels 35 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, nbr_tsteps) 37 REAL, POINTER, DIMENSION(:,:) :: pt_psurf ! The massvar distributions, DIMENSION(klon, nbr_tsteps) 38 REAL, POINTER, DIMENSION(:,:) :: pt_load ! The massvar distributions, DIMENSION(klon, nbr_tsteps) 39 INTEGER :: nbr_tsteps ! number of timesteps in read file (12 or 14) 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 40 39 41 40 ! Local variables 42 CHARACTER(len=4) 43 REAL, POINTER, DIMENSION(:,:,:) 44 REAL, POINTER, DIMENSION(:,:):: psurf2, load245 REAL 46 INTEGER 47 INTEGER 48 LOGICAL, PARAMETER 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. 49 48 50 49 !**************************************************************************************** … … 57 56 !**************************************************************************************** 58 57 cyear='1980' 59 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tstepsmonth60 ! pt_out has dimensions (klon, klev_src, nbr_tsteps)61 CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, p t_psurf, pt_load, nbr_tsteps)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) 62 61 63 62 … … 66 65 !**************************************************************************************** 67 66 cyear='.nat' 68 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 69 ! pt_out has dimensions (klon, klev_src, nbr_tsteps) 70 CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, pt_psurf, pt_load, nbr_tsteps) 71 72 ELSE IF (type == 'annuel') THEN 73 ! Read and return data from scenario annual files 74 !**************************************************************************************** 75 WRITE(cyear,'(I4)') iyr_in 76 WRITE(lunout,*) 'get_aero 3 iyr_in=', iyr_in,' ',cyear 77 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 78 ! pt_out has dimensions (klon, klev_src, nbr_tsteps) 79 CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, pt_psurf, pt_load, nbr_tsteps) 80 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) 81 70 82 71 ELSE IF (type == 'scenario') THEN … … 86 75 cyear='.nat' 87 76 WRITE(lunout,*) 'get_aero 1 iyr_in=', iyr_in,' ',cyear 88 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tstepsmonth89 ! pt_out has dimensions (klon, klev_src, nbr_tsteps)90 CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, p t_psurf, pt_load, nbr_tsteps)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) 91 80 92 81 ELSE IF (iyr_in .GE. 2100) THEN 93 82 cyear='2100' 94 83 WRITE(lunout,*) 'get_aero 2 iyr_in=', iyr_in,' ',cyear 95 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tstepsmonth96 ! pt_out has dimensions (klon, klev_src, nbr_tsteps)97 CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, p t_psurf, pt_load, nbr_tsteps)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) 98 87 99 88 ELSE … … 113 102 WRITE(cyear,'(I4)') iyr1 114 103 WRITE(lunout,*) 'get_aero 3 iyr_in=', iyr_in,' ',cyear 115 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tstepsmonth116 ! pt_out has dimensions (klon, klev_src, nbr_tsteps)117 CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, p t_psurf, pt_load, nbr_tsteps)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) 118 107 119 108 ! If to read two decades: … … 125 114 126 115 NULLIFY(pt_2) 127 ! get_aero_fromfile returns pt_2 allocated and initialized with data for nbr_tstepsmonth128 ! pt_2 has dimensions (klon, klev_src, nbr_tsteps)129 CALL get_aero_fromfile(name_aero, cyear, klev_src2, pt_ap, pt_b, p0, pt_2, psurf2, load2 , nbr_tsteps)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) 130 119 ! Test for same number of vertical levels 131 120 IF (klev_src /= klev_src2) THEN … … 135 124 136 125 ! Linare interpolate to the actual year: 137 DO it=1, nbr_tsteps126 DO it=1,12 138 127 DO k=1,klev_src 139 128 DO i = 1, klon … … 145 134 146 135 DO i = 1, klon 147 p t_psurf(i,it) = &148 p t_psurf(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &149 (p t_psurf(i,it) - psurf2(i,it))150 151 pt_load(i,it) = &152 pt_load(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &153 ( pt_load(i,it) - load2(i,it))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)) 154 143 END DO 155 144 END DO … … 157 146 ! Deallocate pt_2 no more needed 158 147 DEALLOCATE(pt_2) 159 DEALLOCATE(psurf2)160 DEALLOCATE(load2)161 148 162 149 END IF ! lonlyone … … 172 159 173 160 174 SUBROUTINE get_aero_fromfile(varname, cyr, klev_src, pt_ap, pt_b, p0, pt_year, p t_psurf_out, pt_load_out, nbr_tsteps)175 !**************************************************************************************** 176 ! Read nbr_tstepsmonth aerosol from file and distribute to local process on physical grid.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. 177 164 ! Vertical levels, klev_src, may differ from model levels if new file format. 178 165 ! … … 210 197 REAL, POINTER, DIMENSION(:) :: pt_b ! Pointer for describing the vertical levels 211 198 REAL :: p0 ! Reference pressure value 212 REAL, POINTER, DIMENSION(:,:,:) :: pt_year ! Pointer-variabale from file, nbr_tsteps month, grid : klon,klev_src 213 REAL, POINTER, DIMENSION(:,:) :: pt_psurf_out ! Surface pression for nbr_tsteps months 214 REAL, POINTER, DIMENSION(:,:) :: pt_load_out ! Aerosol mass load in each column 215 INTEGER :: nbr_tsteps ! number of month in file read 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 216 202 217 203 ! Local variables … … 223 209 REAL :: npole, spole 224 210 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varmth 225 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: varyear ! Global variable read from file, nbr_tstepsmonth226 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varyear_glo1D !(klon_glo, klev_src, nbr_tsteps)211 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: varyear ! Global variable read from file, 12 month 212 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varyear_glo1D !(klon_glo, klev_src, 12) 227 213 REAL, ALLOCATABLE, DIMENSION(:) :: varktmp 228 214 229 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: psurf_glo2D230 REAL, ALLOCATABLE, DIMENSION(:,:) :: psurf_glo1D231 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: load_glo2D232 REAL, ALLOCATABLE, DIMENSION(:,:) :: load_glo1D215 REAL, DIMENSION(iim,jjm+1,12) :: psurf_glo2D ! Surface pression for 12 months on dynamics global grid 216 REAL, DIMENSION(klon_glo,12) :: psurf_glo1D ! -"- on physical global grid 217 REAL, DIMENSION(iim,jjm+1,12) :: load_glo2D ! Load for 12 months on dynamics global grid 218 REAL, DIMENSION(klon_glo,12) :: load_glo1D ! -"- on physical global grid 233 219 REAL, DIMENSION(iim,jjm+1) :: vartmp 234 220 REAL, DIMENSION(iim) :: lon_src ! longitudes in file … … 287 273 CALL abort_gcm('get_aero_fromfile', 'latitudes do not correspond between file and model',1) 288 274 END IF 289 290 ! 1.5) Check number of month in file opened291 !292 !**************************************************************************************************293 ierr = nf90_inq_dimid(ncid, 'TIME',dimid)294 ! ierr = nf90_inq_dimlen(ncid, dimid, nbr_tsteps)295 CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps) )296 IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN297 CALL abort_gcm('get_aero_fromfile', 'not the right number of months in aerosol file read',1)298 ENDIF299 write(lunout,*)'get_aero_fromfile: ', nbr_tsteps,' months to read from aerosols file'300 call bcast(nbr_tsteps)301 302 ! 1.6) Allocation of some variables once the number of months in the file has been determined303 !304 !**************************************************************************************************305 ALLOCATE(psurf_glo2D(iim, jjm+1, nbr_tsteps), load_glo2D(iim, jjm+1, nbr_tsteps), stat=ierr)306 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 0.5',1)307 ALLOCATE(psurf_glo1D(klon_glo, nbr_tsteps), load_glo1D(klon_glo, nbr_tsteps), stat=ierr)308 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 0.5',1)309 310 275 311 276 ! 2) Check if old or new file is avalabale. … … 336 301 337 302 ! Allocate variables depending on the number of vertical levels 338 ALLOCATE(varmth(iim, jjm+1, klev_src), varyear(iim, jjm+1, klev_src, nbr_tsteps), stat=ierr)303 ALLOCATE(varmth(iim, jjm+1, klev_src), varyear(iim, jjm+1, klev_src, 12), stat=ierr) 339 304 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 1',1) 340 305 … … 358 323 CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)) ) 359 324 360 ! ++) Read surface pression, nbr_tstepsmonth in one variable325 ! ++) Read surface pression, 12 month in one variable 361 326 !**************************************************************************************** 362 327 ! Get variable id … … 398 363 ! ++) Read the aerosol concentration month by month and concatenate to total variable varyear 399 364 !**************************************************************************************** 400 DO imth=1, nbr_tsteps365 DO imth=1, 12 401 366 IF (imth.EQ.1) THEN 402 367 cvar=TRIM(varname)//'JAN' … … 459 424 460 425 ! Inverse vertical levels for varyear 461 DO imth=1, nbr_tsteps426 DO imth=1, 12 462 427 varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly 463 428 DO k=1, klev_src … … 490 455 491 456 ! - Invert latitudes if necessary 492 DO imth=1, nbr_tsteps457 DO imth=1, 12 493 458 IF (invert_lat) THEN 494 459 … … 535 500 END DO ! imth 536 501 537 ALLOCATE(varyear_glo1D(klon_glo, klev_src, nbr_tsteps), stat=ierr)502 ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr) 538 503 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 3',1) 539 504 … … 567 532 ! Allocate space for output pointer variable at local process 568 533 IF (ASSOCIATED(pt_year)) DEALLOCATE(pt_year) 569 write(lunout,*)'get_aero_fromfile: klon, ...',klon, klev_src, nbr_tsteps 570 ALLOCATE(pt_year(klon, klev_src, nbr_tsteps), stat=ierr) 571 ! IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 5.1',1) 572 IF (ASSOCIATED(pt_psurf_out)) DEALLOCATE(pt_psurf_out) 573 ALLOCATE(pt_psurf_out(klon, nbr_tsteps), stat=ierr) 574 ! IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 5.2',1) 575 IF (ASSOCIATED(pt_load_out)) DEALLOCATE(pt_load_out) 576 ALLOCATE(pt_load_out(klon, nbr_tsteps), stat=ierr) 577 ! IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 5.3',1) 534 ALLOCATE(pt_year(klon, klev_src, 12), stat=ierr) 535 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 5',1) 578 536 579 537 ! Scatter global field to local domain at local process 580 538 CALL scatter(varyear_glo1D, pt_year) 581 CALL scatter(psurf_glo1D, p t_psurf_out)582 CALL scatter(load_glo1D, pt_load_out)539 CALL scatter(psurf_glo1D, psurf_out) 540 CALL scatter(load_glo1D, load_out) 583 541 584 542 ! 7) Test for negative values
Note: See TracChangeset
for help on using the changeset viewer.
