Changeset 1265 for LMDZ4/branches/LMDZ4-dev/libf/phylmd/readaerosol.F90
- Timestamp:
- Nov 20, 2009, 5:05:39 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/phylmd/readaerosol.F90
r1249 r1265 7 7 CONTAINS 8 8 9 SUBROUTINE readaerosol(name_aero, type, iyr_in, klev_src, pt_ap, pt_b, pt_out, p surf, load)9 SUBROUTINE readaerosol(name_aero, type, iyr_in, klev_src, pt_ap, pt_b, pt_out, pt_psurf, pt_load, nbr_tsteps) 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, 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 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) 39 40 40 41 ! Local variables 41 CHARACTER(len=4) :: cyear42 REAL, POINTER, DIMENSION(:,:,:) :: pt_243 REAL, DIMENSION(klon,12):: psurf2, load244 REAL :: p0 ! Reference pressure45 INTEGER :: iyr1, iyr2, klev_src246 INTEGER :: it, k, i47 LOGICAL, PARAMETER :: lonlyone=.FALSE.42 CHARACTER(len=4) :: cyear 43 REAL, POINTER, DIMENSION(:,:,:) :: pt_2 44 REAL, POINTER, DIMENSION(:,:) :: psurf2, load2 45 REAL :: p0 ! Reference pressure 46 INTEGER :: iyr1, iyr2, klev_src2 47 INTEGER :: it, k, i 48 LOGICAL, PARAMETER :: lonlyone=.FALSE. 48 49 49 50 !**************************************************************************************** … … 56 57 !**************************************************************************************** 57 58 cyear='1980' 58 ! get_aero_fromfile returns pt_out allocated and initialized with data for 12month59 ! 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, p surf, load)59 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 60 ! 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, pt_psurf, pt_load, nbr_tsteps) 61 62 62 63 … … 65 66 !**************************************************************************************** 66 67 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) 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 70 81 71 82 ELSE IF (type == 'scenario') THEN … … 75 86 cyear='.nat' 76 87 WRITE(lunout,*) 'get_aero 1 iyr_in=', iyr_in,' ',cyear 77 ! get_aero_fromfile returns pt_out allocated and initialized with data for 12month78 ! 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, p surf, load)88 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 89 ! 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, pt_psurf, pt_load, nbr_tsteps) 80 91 81 92 ELSE IF (iyr_in .GE. 2100) THEN 82 93 cyear='2100' 83 94 WRITE(lunout,*) 'get_aero 2 iyr_in=', iyr_in,' ',cyear 84 ! get_aero_fromfile returns pt_out allocated and initialized with data for 12month85 ! 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, p surf, load)95 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 96 ! 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, pt_psurf, pt_load, nbr_tsteps) 87 98 88 99 ELSE … … 102 113 WRITE(cyear,'(I4)') iyr1 103 114 WRITE(lunout,*) 'get_aero 3 iyr_in=', iyr_in,' ',cyear 104 ! get_aero_fromfile returns pt_out allocated and initialized with data for 12month105 ! 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, p surf, load)115 ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 116 ! 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, pt_psurf, pt_load, nbr_tsteps) 107 118 108 119 ! If to read two decades: … … 114 125 115 126 NULLIFY(pt_2) 116 ! get_aero_fromfile returns pt_2 allocated and initialized with data for 12month117 ! 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 )127 ! get_aero_fromfile returns pt_2 allocated and initialized with data for nbr_tsteps month 128 ! 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) 119 130 ! Test for same number of vertical levels 120 131 IF (klev_src /= klev_src2) THEN … … 124 135 125 136 ! Linare interpolate to the actual year: 126 DO it=1, 12137 DO it=1,nbr_tsteps 127 138 DO k=1,klev_src 128 139 DO i = 1, klon … … 134 145 135 146 DO i = 1, klon 136 p surf(i,it) = &137 p surf(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &138 (p surf(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))147 pt_psurf(i,it) = & 148 pt_psurf(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * & 149 (pt_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)) 143 154 END DO 144 155 END DO … … 146 157 ! Deallocate pt_2 no more needed 147 158 DEALLOCATE(pt_2) 159 DEALLOCATE(psurf2) 160 DEALLOCATE(load2) 148 161 149 162 END IF ! lonlyone … … 159 172 160 173 161 SUBROUTINE get_aero_fromfile(varname, cyr, klev_src, pt_ap, pt_b, p0, pt_year, p surf_out, load_out)162 !**************************************************************************************** 163 ! Read 12month aerosol from file and distribute to local process on physical grid.174 SUBROUTINE get_aero_fromfile(varname, cyr, klev_src, pt_ap, pt_b, p0, pt_year, pt_psurf_out, pt_load_out, nbr_tsteps) 175 !**************************************************************************************** 176 ! Read nbr_tsteps month aerosol from file and distribute to local process on physical grid. 164 177 ! Vertical levels, klev_src, may differ from model levels if new file format. 165 178 ! … … 197 210 REAL, POINTER, DIMENSION(:) :: pt_b ! Pointer for describing the vertical levels 198 211 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 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 202 216 203 217 ! Local variables … … 209 223 REAL :: npole, spole 210 224 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varmth 211 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: varyear ! Global variable read from file, 12month212 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varyear_glo1D !(klon_glo, klev_src, 12)225 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: varyear ! Global variable read from file, nbr_tsteps month 226 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: varyear_glo1D !(klon_glo, klev_src, nbr_tsteps) 213 227 REAL, ALLOCATABLE, DIMENSION(:) :: varktmp 214 228 215 REAL, DIMENSION(iim,jjm+1,12) :: psurf_glo2D ! Surface pression for 12 months on dynamics global grid216 REAL, DIMENSION(klon_glo,12) :: psurf_glo1D ! -"- on physical global grid217 REAL, DIMENSION(iim,jjm+1,12) :: load_glo2D ! Load for 12 months on dynamics global grid218 REAL, DIMENSION(klon_glo,12) :: load_glo1D ! -"- on physical global grid229 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: psurf_glo2D 230 REAL, ALLOCATABLE, DIMENSION(:,:) :: psurf_glo1D 231 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: load_glo2D 232 REAL, ALLOCATABLE, DIMENSION(:,:) :: load_glo1D 219 233 REAL, DIMENSION(iim,jjm+1) :: vartmp 220 234 REAL, DIMENSION(iim) :: lon_src ! longitudes in file … … 273 287 CALL abort_gcm('get_aero_fromfile', 'latitudes do not correspond between file and model',1) 274 288 END IF 289 290 ! 1.5) Check number of month in file opened 291 ! 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) THEN 297 CALL abort_gcm('get_aero_fromfile', 'not the right number of months in aerosol file read',1) 298 ENDIF 299 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 determined 303 ! 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 275 310 276 311 ! 2) Check if old or new file is avalabale. … … 301 336 302 337 ! Allocate variables depending on the number of vertical levels 303 ALLOCATE(varmth(iim, jjm+1, klev_src), varyear(iim, jjm+1, klev_src, 12), stat=ierr)338 ALLOCATE(varmth(iim, jjm+1, klev_src), varyear(iim, jjm+1, klev_src, nbr_tsteps), stat=ierr) 304 339 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 1',1) 305 340 … … 323 358 CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)) ) 324 359 325 ! ++) Read surface pression, 12month in one variable360 ! ++) Read surface pression, nbr_tsteps month in one variable 326 361 !**************************************************************************************** 327 362 ! Get variable id … … 363 398 ! ++) Read the aerosol concentration month by month and concatenate to total variable varyear 364 399 !**************************************************************************************** 365 DO imth=1, 12400 DO imth=1, nbr_tsteps 366 401 IF (imth.EQ.1) THEN 367 402 cvar=TRIM(varname)//'JAN' … … 424 459 425 460 ! Inverse vertical levels for varyear 426 DO imth=1, 12461 DO imth=1, nbr_tsteps 427 462 varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly 428 463 DO k=1, klev_src … … 455 490 456 491 ! - Invert latitudes if necessary 457 DO imth=1, 12492 DO imth=1, nbr_tsteps 458 493 IF (invert_lat) THEN 459 494 … … 500 535 END DO ! imth 501 536 502 ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr)537 ALLOCATE(varyear_glo1D(klon_glo, klev_src, nbr_tsteps), stat=ierr) 503 538 IF (ierr /= 0) CALL abort_gcm('get_aero_fromfile', 'pb in allocation 3',1) 504 539 … … 532 567 ! Allocate space for output pointer variable at local process 533 568 IF (ASSOCIATED(pt_year)) DEALLOCATE(pt_year) 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) 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) 536 578 537 579 ! Scatter global field to local domain at local process 538 580 CALL scatter(varyear_glo1D, pt_year) 539 CALL scatter(psurf_glo1D, p surf_out)540 CALL scatter(load_glo1D, load_out)581 CALL scatter(psurf_glo1D, pt_psurf_out) 582 CALL scatter(load_glo1D, pt_load_out) 541 583 542 584 ! 7) Test for negative values
Note: See TracChangeset
for help on using the changeset viewer.
