[2317] | 1 | program aeroptical |
---|
| 2 | ! program for computation of aerosol opacities |
---|
[2318] | 3 | ! author : Antoine Bierjon, April-May 2020 |
---|
[2317] | 4 | ! |
---|
| 5 | !=============================================================================== |
---|
| 6 | ! PREFACE |
---|
| 7 | !=============================================================================== |
---|
[2318] | 8 | ! This program takes as inputs a GCM output file (diagfi,stats,concat) that |
---|
[2317] | 9 | ! contains: |
---|
| 10 | ! - the Mass Mixing Ratios of dust (dustq) and water ice (h2o_ice) |
---|
| 11 | ! - their effective radius (reffdust, reffice(*)) |
---|
| 12 | ! - the atmospheric density (rho) |
---|
[2318] | 13 | ! as well as a wavelength to calibrate the opacities, and the directory |
---|
| 14 | ! containing the ASCII files of the aerosols' optical properties. |
---|
[2317] | 15 | ! |
---|
| 16 | ! It outputs a netcdf file containing the opacities [1/km] of the dust and |
---|
[2318] | 17 | ! water ice aerosols calibrated at the prescribed wavelength. |
---|
[2317] | 18 | ! |
---|
| 19 | ! |
---|
[2318] | 20 | ! (*) due to a high uncertainty of reffice in the GCM, the value is asked |
---|
[2317] | 21 | ! directly to the user (if the user returns 0, then the program reads the GCM |
---|
| 22 | ! file to get reffice) |
---|
| 23 | ! |
---|
| 24 | ! NOTA BENE: |
---|
| 25 | ! 1) if one wanted to add another aerosol to compute, one should look for |
---|
| 26 | ! the comments + NEW AER? that are disseminated all along the code to indicate |
---|
[2318] | 27 | ! the parts of the code that should be modified. |
---|
[2317] | 28 | ! 2) another enhancement of this program could be the possibility to read its |
---|
| 29 | ! own product files and recalibrate the opacities at another wavelength |
---|
| 30 | !=============================================================================== |
---|
| 31 | |
---|
| 32 | |
---|
| 33 | use netcdf |
---|
| 34 | |
---|
| 35 | !=============================================================================== |
---|
| 36 | ! Variable declarations |
---|
| 37 | !=============================================================================== |
---|
| 38 | |
---|
| 39 | implicit none ! for no implicitly typed variables |
---|
| 40 | |
---|
| 41 | |
---|
| 42 | ! GCM file |
---|
| 43 | character(len=128) :: gcmfile ! name of the netcdf GCM input file |
---|
| 44 | integer :: gcmfid ! [netcdf] GCM input file ID number |
---|
| 45 | integer :: ierr ! [netcdf] subroutine returned error code |
---|
| 46 | character(len=256) :: error_text ! text to display in case of error |
---|
[2318] | 47 | integer :: tmpvarid ! temporarily stores a variable ID number |
---|
[2317] | 48 | integer :: lonlen,latlen,altlen,timelen ! nb of grid points along longitude,latitude,altitude,time |
---|
| 49 | integer :: GCM_layers ! number of GCM layers |
---|
| 50 | integer :: layerdimout,interlayerdimout ! "GCM_layers" and "GCM_layers+1" IDs |
---|
| 51 | |
---|
| 52 | logical,dimension(:),allocatable :: aerok ! to know if the needed fields are in the GCM file |
---|
| 53 | real,dimension(:,:,:,:,:),allocatable :: mmr ! aerosols mass mixing ratios [kg/kg] |
---|
| 54 | real,dimension(:,:,:,:,:),allocatable :: reff ! aerosols effective radii [m] |
---|
| 55 | real :: reffwice_val ! value given by the user for reffwice (0 if read in the GCM file) [m] |
---|
| 56 | real,dimension(:,:,:,:),allocatable :: rho ! atmospheric density [kg.m-3] |
---|
| 57 | integer :: naerkind ! nb of aerosols to consider |
---|
[2318] | 58 | integer :: iaer ! aerosol kind index (1=dust, 2=water ice) ! + NEW AER? |
---|
[2317] | 59 | integer :: ilon,ilat,ialt,it ! Loop indices for coordinates |
---|
| 60 | |
---|
| 61 | |
---|
| 62 | ! Output file |
---|
| 63 | character(len=128) :: outfile ! name of the netcdf output file |
---|
| 64 | integer :: outfid ! [netcdf] file ID number |
---|
| 65 | integer :: latdimout,londimout,altdimout,timedimout |
---|
| 66 | ! latdimout: stores latitude dimension ID number |
---|
| 67 | ! londimout: stores longitude dimension ID number |
---|
| 68 | ! altdimout: stores altitude dimension ID number |
---|
| 69 | ! timedimout: stores time dimension ID number |
---|
[2318] | 70 | integer :: tmpvaridout ! temporarily stores a variable ID number |
---|
[2317] | 71 | |
---|
| 72 | real :: wvl_val ! reference wavelength of the output opacities (given by the user) [m] |
---|
| 73 | integer :: varshape(4) ! stores a variable shape (of dimensions' IDs) |
---|
[2318] | 74 | character(len=16) :: tmpvarname ! temporarily stores a variable name |
---|
| 75 | real,dimension(:,:,:,:,:),allocatable :: opa_aer ! Aerosols opacities [1/km] |
---|
[2327] | 76 | real,dimension(:),allocatable :: missval ! Value to put in outfile when the reff is out of bounds |
---|
| 77 | ! or when there is a mising value in input file |
---|
[2317] | 78 | |
---|
| 79 | |
---|
| 80 | ! Optical properties (read in external ASCII files) |
---|
| 81 | character(len=256) :: datadir ! directory containing the ASCII files |
---|
| 82 | character(len=128) :: optpropfile ! name of the ASCII optical properties file |
---|
| 83 | logical :: file_ok ! to know if the file can be opened |
---|
| 84 | integer :: file_unit = 60 ! |
---|
| 85 | |
---|
| 86 | integer :: jfile ! ASCII file scan index |
---|
| 87 | logical :: endwhile ! Reading loop boolean |
---|
| 88 | character(len=132) :: scanline ! ASCII file scanning line |
---|
| 89 | integer :: read_ok ! to know if the line is well read |
---|
| 90 | |
---|
| 91 | integer :: nwvl ! Number of wavelengths in the domain (VIS or IR) |
---|
| 92 | integer :: nsize ! Number of particle sizes stored in the file |
---|
| 93 | integer :: iwvl,isize ! Wavelength and Particle size loop indices |
---|
| 94 | real,dimension(:),allocatable :: wvl ! Wavelength axis [m] |
---|
| 95 | real,dimension(:),allocatable :: radiusdyn ! Particle size axis [m] |
---|
| 96 | real,dimension(:,:),allocatable :: Qext ! Extinction efficiency coefficient [/] |
---|
| 97 | |
---|
| 98 | |
---|
| 99 | ! Opacity computation |
---|
| 100 | integer :: iwvl1,iwvl2,isize1,isize2 ! Wavelength and Particle size indices for the interpolation |
---|
[2318] | 101 | real :: coeff ! Interpolation coefficient |
---|
[2317] | 102 | real,dimension(2) :: reffQext ! Qext after reff interpolation |
---|
| 103 | real :: Qext_val ! Qext after both interpolations |
---|
| 104 | real,dimension(:),allocatable :: rho_aer ! Density of the aerosols [kg.m-3] |
---|
| 105 | |
---|
| 106 | !=============================================================================== |
---|
| 107 | ! 0. USER INPUTS |
---|
| 108 | !=============================================================================== |
---|
| 109 | write(*,*) "Welcome in the aerosol opacities' computation program !" |
---|
| 110 | write(*,*) |
---|
| 111 | |
---|
| 112 | ! Ask the GCM file name |
---|
| 113 | WRITE(*,*) "Enter an input file name (GCM diagfi/stats/concat) :" |
---|
| 114 | READ(*,*) gcmfile |
---|
| 115 | |
---|
| 116 | ! Ask the reffwice to the user |
---|
| 117 | write(*,*)"" |
---|
| 118 | write(*,*) "The water ice effective radius computed by the GCM is known to be a bit inaccurate." |
---|
| 119 | write(*,*) "Which value do you want to use for it (in meters) ?" |
---|
| 120 | write(*,*) "(put 0 if you still want the program to read the value in "//trim(gcmfile)//")" |
---|
| 121 | READ(*,*) reffwice_val |
---|
| 122 | |
---|
| 123 | ! Ask the wavelength to the user |
---|
| 124 | write(*,*)"" |
---|
| 125 | WRITE(*,*) "Value of the reference wavelength for the opacities' computation (in meters) ?" |
---|
| 126 | READ(*,*) wvl_val |
---|
| 127 | |
---|
| 128 | ! Ask the directory containing the optical properties files |
---|
| 129 | write(*,*)"" |
---|
| 130 | WRITE(*,*) "In which directory should we look for the optical properties' files ?" |
---|
| 131 | READ(*,'(a)') datadir |
---|
| 132 | |
---|
| 133 | !=============================================================================== |
---|
| 134 | ! 1. GCM FILE & OUTPUT FILE INITIALIZATIONS |
---|
| 135 | !=============================================================================== |
---|
| 136 | |
---|
| 137 | !========================================================================== |
---|
| 138 | ! 1.1 GCM file opening & dimensions - Output file initializations |
---|
| 139 | !========================================================================== |
---|
| 140 | |
---|
| 141 | !========================================================================== |
---|
| 142 | ! --> 1.1.1 Open the netcdf GCM file given by the user |
---|
| 143 | |
---|
| 144 | ierr=nf90_open(gcmfile,nf90_nowrite,gcmfid) ! nowrite mode=the program can only read the opened file |
---|
| 145 | error_text="Error: could not open file "//trim(gcmfile) |
---|
| 146 | call status_check(ierr,error_text) |
---|
| 147 | |
---|
| 148 | !========================================================================== |
---|
| 149 | ! --> 1.1.2 Creation of the outfile |
---|
| 150 | outfile=gcmfile(1:index(gcmfile, ".nc")-1)//"_OPA.nc" |
---|
| 151 | |
---|
| 152 | ierr=NF90_CREATE(outfile,nf90_clobber,outfid) ! NB: clobber mode=overwrite any dataset with the same file name ! |
---|
| 153 | error_text="Error: could not create file "//trim(outfile) |
---|
| 154 | call status_check(ierr,error_text) |
---|
| 155 | write(*,*)"";WRITE(*,*)"Output file is: ",trim(outfile);write(*,*)"" |
---|
| 156 | |
---|
| 157 | !========================================================================== |
---|
| 158 | ! --> 1.1.3 Get the dimensions and create them in the output file |
---|
| 159 | |
---|
| 160 | ! Initialize output file's lat,lon,alt,time and controle dimensions |
---|
| 161 | call inidims(gcmfile,gcmfid,outfile,outfid,& |
---|
| 162 | lonlen,latlen,altlen,timelen,& |
---|
| 163 | latdimout,londimout,altdimout,timedimout,& |
---|
| 164 | GCM_layers,layerdimout,interlayerdimout) |
---|
| 165 | |
---|
| 166 | ! Initialize output file's aps,bps,ap,bp and phisinit variables |
---|
| 167 | call init2(gcmfid,lonlen,latlen,altlen,GCM_layers,& |
---|
| 168 | outfid,londimout,latdimout,altdimout,& |
---|
| 169 | layerdimout,interlayerdimout) |
---|
| 170 | |
---|
| 171 | !========================================================================== |
---|
| 172 | ! 1.2 GCM file variables |
---|
| 173 | !========================================================================== |
---|
| 174 | |
---|
| 175 | ! Number of aerosols |
---|
| 176 | naerkind = 2 ! dust & water ice ! + NEW AER? |
---|
| 177 | |
---|
| 178 | ! Length allocation of the variables |
---|
| 179 | allocate(mmr(naerkind,lonlen,latlen,altlen,timelen)) |
---|
| 180 | allocate(reff(naerkind,lonlen,latlen,altlen,timelen)) |
---|
| 181 | |
---|
[2327] | 182 | ! Initialize missing value |
---|
| 183 | allocate(missval(naerkind)) |
---|
| 184 | missval(:)=1.e+20 |
---|
| 185 | |
---|
[2317] | 186 | ! Initialize aerok to .true. for all aerosols |
---|
| 187 | allocate(aerok(naerkind)) |
---|
| 188 | aerok(:)=.true. |
---|
| 189 | |
---|
| 190 | !========================================================================== |
---|
| 191 | ! --> 1.2.1 DUST |
---|
| 192 | |
---|
| 193 | ! DUST MASS MIXING RATIO |
---|
| 194 | ! Check that the GCM file contains that variable |
---|
| 195 | ierr=nf90_inq_varid(gcmfid,"dustq",tmpvarid) |
---|
| 196 | error_text="Failed to find variable dustq in "//trim(gcmfile)& |
---|
| 197 | //" We'll skip the dust aerosol." |
---|
| 198 | if (ierr.ne.nf90_noerr) then |
---|
| 199 | write(*,*)trim(error_text) |
---|
| 200 | aerok(1)=.false. |
---|
| 201 | else |
---|
| 202 | ! Load datasets |
---|
| 203 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,mmr(1,:,:,:,:)) |
---|
| 204 | error_text="Failed to load dust mass mixing ratio" |
---|
| 205 | call status_check(ierr,error_text) |
---|
| 206 | write(*,*) "Dust mass mixing ratio loaded from "//trim(gcmfile) |
---|
[2327] | 207 | ! Get missing value |
---|
| 208 | ierr=nf90_get_att(gcmfid,tmpvarid,"missing_value",missval(1)) |
---|
| 209 | if (ierr.ne.nf90_noerr) then |
---|
| 210 | missval(1) = 1.e+20 |
---|
| 211 | endif |
---|
[2317] | 212 | endif |
---|
| 213 | |
---|
| 214 | ! DUST EFFECTIVE RADIUS |
---|
| 215 | if (aerok(1)) then |
---|
| 216 | ! Check that the GCM file contains that variable |
---|
| 217 | ierr=nf90_inq_varid(gcmfid,"reffdust",tmpvarid) |
---|
| 218 | error_text="Failed to find variable reffdust in "//trim(gcmfile)& |
---|
| 219 | //" We'll skip the dust aerosol." |
---|
| 220 | if (ierr.ne.nf90_noerr) then |
---|
| 221 | write(*,*)trim(error_text) |
---|
| 222 | aerok(1)=.false. |
---|
| 223 | else |
---|
| 224 | ! Load datasets |
---|
| 225 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,reff(1,:,:,:,:)) |
---|
| 226 | error_text="Failed to load dust effective radius" |
---|
| 227 | call status_check(ierr,error_text) |
---|
| 228 | write(*,*) "Dust effective radius loaded from "//trim(gcmfile) |
---|
| 229 | endif |
---|
| 230 | endif |
---|
| 231 | |
---|
| 232 | !========================================================================== |
---|
| 233 | ! --> 1.2.2 WATER ICE |
---|
| 234 | |
---|
| 235 | ! WATER ICE MASS MIXING RATIO |
---|
| 236 | ! Check that the GCM file contains that variable |
---|
| 237 | ierr=nf90_inq_varid(gcmfid,"h2o_ice",tmpvarid) |
---|
| 238 | error_text="Failed to find variable h2o_ice in "//trim(gcmfile)& |
---|
| 239 | //" We'll skip the water ice aerosol." |
---|
| 240 | if (ierr.ne.nf90_noerr) then |
---|
| 241 | write(*,*)trim(error_text) |
---|
| 242 | aerok(2)=.false. |
---|
| 243 | else |
---|
| 244 | ! Load datasets |
---|
| 245 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,mmr(2,:,:,:,:)) |
---|
| 246 | error_text="Failed to load water ice mass mixing ratio" |
---|
| 247 | call status_check(ierr,error_text) |
---|
| 248 | write(*,*) "Water ice mass mixing ratio loaded from "//trim(gcmfile) |
---|
[2327] | 249 | ! Get missing value |
---|
| 250 | ierr=nf90_get_att(gcmfid,tmpvarid,"missing_value",missval(2)) |
---|
| 251 | if (ierr.ne.nf90_noerr) then |
---|
| 252 | missval(2) = 1.e+20 |
---|
| 253 | endif |
---|
[2317] | 254 | endif |
---|
| 255 | |
---|
| 256 | ! WATER ICE EFFECTIVE RADIUS |
---|
| 257 | if (aerok(2)) then |
---|
| 258 | IF (reffwice_val.eq.0) THEN |
---|
| 259 | ! Check that the GCM file contains that variable |
---|
| 260 | ierr=nf90_inq_varid(gcmfid,"reffice",tmpvarid) |
---|
| 261 | error_text="Failed to find variable reffice in "//trim(gcmfile)& |
---|
| 262 | //" We'll skip the water ice aerosol." |
---|
| 263 | if (ierr.ne.nf90_noerr) then |
---|
| 264 | write(*,*)trim(error_text) |
---|
| 265 | aerok(2)=.false. |
---|
| 266 | else |
---|
| 267 | ! Load datasets |
---|
| 268 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,reff(2,:,:,1,:)) ! reffice is actually a GCM |
---|
| 269 | ! surface (column-averaged) variable |
---|
| 270 | error_text="Failed to load water ice effective radius" |
---|
| 271 | call status_check(ierr,error_text) |
---|
| 272 | do ialt=2,altlen |
---|
| 273 | reff(2,:,:,ialt,:) = reff(2,:,:,1,:) ! build up along altitude axis |
---|
| 274 | enddo |
---|
| 275 | write(*,*) "Water ice effective radius loaded from "//trim(gcmfile) |
---|
| 276 | endif |
---|
| 277 | ELSE ! if reffwice_val/=0 |
---|
| 278 | reff(2,:,:,:,:) = reffwice_val |
---|
| 279 | write(*,*) "Water ice effective radius loaded from the user input" |
---|
| 280 | ENDIF |
---|
| 281 | endif |
---|
| 282 | |
---|
| 283 | ! Check if there is still at least one aerosol to compute |
---|
| 284 | IF (.NOT.ANY(aerok)) THEN |
---|
| 285 | write(*,*) "Neither dust nor water ice are found in the file. Better stop now..." |
---|
| 286 | stop |
---|
| 287 | ENDIF |
---|
| 288 | |
---|
| 289 | !========================================================================== |
---|
| 290 | ! --> 1.2.3 + NEW AER? |
---|
| 291 | |
---|
| 292 | !========================================================================== |
---|
| 293 | ! --> 1.2.3 ATMOSPHERIC DENSITY |
---|
| 294 | |
---|
| 295 | ! Check that the GCM file contains that variable |
---|
| 296 | ierr=nf90_inq_varid(gcmfid,"rho",tmpvarid) |
---|
| 297 | error_text="Failed to find variable rho in "//trim(gcmfile)& |
---|
| 298 | //" We need it to compute the opacity [1/km]." |
---|
| 299 | call status_check(ierr,error_text) |
---|
| 300 | ! Length allocation for each dimension of the 4D variable |
---|
| 301 | allocate(rho(lonlen,latlen,altlen,timelen)) |
---|
| 302 | ! Load datasets |
---|
| 303 | ierr=nf90_get_var(gcmfid,tmpvarid,rho) |
---|
| 304 | error_text="Failed to load atmospheric density" |
---|
| 305 | call status_check(ierr,error_text) |
---|
| 306 | write(*,*) "Loaded atmospheric density rho from "//trim(gcmfile) |
---|
| 307 | |
---|
| 308 | !========================================================================== |
---|
| 309 | ! 1.3 Some output variable's initializations |
---|
| 310 | !========================================================================== |
---|
| 311 | ! Define the ID shape of the output variables |
---|
| 312 | varshape(1)=londimout |
---|
| 313 | varshape(2)=latdimout |
---|
| 314 | varshape(3)=altdimout |
---|
| 315 | varshape(4)=timedimout |
---|
| 316 | |
---|
| 317 | ! Fill the aerosol density array |
---|
| 318 | allocate(rho_aer(naerkind)) |
---|
| 319 | rho_aer(1)=2500. ! dust |
---|
| 320 | rho_aer(2)=920. ! water ice |
---|
| 321 | ! + NEW AER? |
---|
| 322 | |
---|
| 323 | allocate(opa_aer(naerkind,lonlen,latlen,altlen,timelen)) |
---|
| 324 | |
---|
| 325 | |
---|
| 326 | !=============================================================================== |
---|
| 327 | ! 2. OPTICAL PROPERTIES |
---|
| 328 | !=============================================================================== |
---|
| 329 | |
---|
| 330 | DO iaer = 1, naerkind ! Loop on aerosol kind |
---|
| 331 | if (aerok(iaer)) then ! check if this aerosol can be computed |
---|
| 332 | |
---|
| 333 | !========================================================================== |
---|
| 334 | ! 2.1 Open the ASCII file |
---|
| 335 | !========================================================================== |
---|
| 336 | IF (wvl_val.lt.5.e-6) THEN |
---|
| 337 | ! "VISIBLE" DOMAIN |
---|
| 338 | |
---|
| 339 | SELECT CASE(iaer) |
---|
| 340 | CASE(1) ! DUST |
---|
| 341 | ! Dust file |
---|
| 342 | optpropfile = "optprop_dustvis_TM_n50.dat" |
---|
| 343 | CASE(2) ! WATER ICE |
---|
| 344 | ! Water ice file |
---|
| 345 | optpropfile = "optprop_icevis_n30.dat" |
---|
| 346 | ! + NEW AER? |
---|
| 347 | END SELECT ! iaer |
---|
| 348 | |
---|
| 349 | ELSE ! wvl_val.ge.5.e-6 |
---|
| 350 | ! "INFRARED" DOMAIN |
---|
| 351 | |
---|
| 352 | SELECT CASE(iaer) |
---|
| 353 | CASE(1) ! DUST |
---|
| 354 | ! Dust file |
---|
| 355 | optpropfile = "optprop_dustir_n50.dat" |
---|
| 356 | CASE(2) ! WATER ICE |
---|
| 357 | ! Water ice file |
---|
| 358 | optpropfile = "optprop_iceir_n30.dat" |
---|
| 359 | ! + NEW AER? |
---|
| 360 | END SELECT ! iaer |
---|
| 361 | |
---|
| 362 | ENDIF ! wvl_val |
---|
| 363 | |
---|
| 364 | INQUIRE(FILE=trim(datadir)//'/'//trim(optpropfile),EXIST=file_ok) |
---|
| 365 | if(.not.file_ok) then |
---|
| 366 | write(*,*)'Problem opening ',trim(optpropfile) |
---|
| 367 | write(*,*)'It should be in: ',trim(datadir) |
---|
| 368 | stop |
---|
| 369 | endif |
---|
| 370 | OPEN(UNIT=file_unit,FILE=trim(datadir)//'/'//trim(optpropfile),FORM='formatted') |
---|
| 371 | |
---|
| 372 | !========================================================================== |
---|
| 373 | ! 2.2 Allocate the optical property table |
---|
| 374 | !========================================================================== |
---|
| 375 | jfile = 1 |
---|
| 376 | endwhile = .false. |
---|
| 377 | DO WHILE (.NOT.endwhile) |
---|
| 378 | READ(file_unit,*,iostat=read_ok) scanline |
---|
| 379 | if (read_ok.ne.0) then |
---|
| 380 | write(*,*)'Error reading file ',& |
---|
| 381 | trim(datadir)//'/'//trim(optpropfile) |
---|
| 382 | stop |
---|
| 383 | endif |
---|
| 384 | IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN |
---|
| 385 | BACKSPACE(file_unit) |
---|
| 386 | reading1_seq: SELECT CASE (jfile) ! FIRST READING SEQUENCE |
---|
| 387 | CASE(1) reading1_seq ! nwvl ---------------------------- |
---|
| 388 | read(file_unit,*,iostat=read_ok) nwvl |
---|
| 389 | if (read_ok.ne.0) then |
---|
| 390 | write(*,*)'reading1_seq: Error while reading line: ',& |
---|
| 391 | trim(scanline) |
---|
| 392 | write(*,*)' of file ',& |
---|
| 393 | trim(datadir)//'/'//trim(optpropfile) |
---|
| 394 | stop |
---|
| 395 | endif |
---|
| 396 | jfile = jfile+1 |
---|
| 397 | CASE(2) reading1_seq ! nsize --------------------------- |
---|
| 398 | read(file_unit,*,iostat=read_ok) nsize |
---|
| 399 | if (read_ok.ne.0) then |
---|
| 400 | write(*,*)'reading1_seq: Error while reading line: ',& |
---|
| 401 | trim(scanline) |
---|
| 402 | write(*,*)' of file ',& |
---|
| 403 | trim(datadir)//'/'//trim(optpropfile) |
---|
| 404 | stop |
---|
| 405 | endif |
---|
| 406 | endwhile = .true. |
---|
| 407 | CASE DEFAULT reading1_seq ! default -------------------- |
---|
| 408 | write(*,*) 'reading1_seq: ',& |
---|
| 409 | 'Error while loading optical properties.' |
---|
| 410 | stop |
---|
| 411 | END SELECT reading1_seq ! ============================== |
---|
| 412 | ENDIF |
---|
| 413 | ENDDO ! DO WHILE(.NOT.endwhile) |
---|
| 414 | |
---|
| 415 | ALLOCATE(wvl(nwvl)) ! Wavelength axis |
---|
| 416 | ALLOCATE(radiusdyn(nsize)) ! Aerosol radius axis |
---|
| 417 | ALLOCATE(Qext(nwvl,nsize)) ! Extinction efficiency coeff |
---|
| 418 | |
---|
| 419 | !========================================================================== |
---|
| 420 | ! 2.3 Read the data |
---|
| 421 | !========================================================================== |
---|
| 422 | jfile = 1 |
---|
| 423 | endwhile = .false. |
---|
| 424 | DO WHILE (.NOT.endwhile) |
---|
| 425 | READ(file_unit,*) scanline |
---|
| 426 | IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN |
---|
| 427 | BACKSPACE(file_unit) |
---|
| 428 | reading2_seq: SELECT CASE (jfile) ! SECOND READING SEQUENCE |
---|
| 429 | CASE(1) reading2_seq ! wvl ----------------------------- |
---|
| 430 | read(file_unit,*,iostat=read_ok) wvl |
---|
| 431 | if (read_ok.ne.0) then |
---|
| 432 | write(*,*)'reading2_seq: Error while reading line: ',& |
---|
| 433 | trim(scanline) |
---|
| 434 | write(*,*)' of file ',& |
---|
| 435 | trim(datadir)//'/'//trim(optpropfile) |
---|
| 436 | stop |
---|
| 437 | endif |
---|
| 438 | jfile = jfile+1 |
---|
| 439 | CASE(2) reading2_seq ! radiusdyn ----------------------- |
---|
| 440 | read(file_unit,*,iostat=read_ok) radiusdyn |
---|
| 441 | if (read_ok.ne.0) then |
---|
| 442 | write(*,*)'reading2_seq: Error while reading line: ',& |
---|
| 443 | trim(scanline) |
---|
| 444 | write(*,*)' of file ',& |
---|
| 445 | trim(datadir)//'/'//trim(optpropfile) |
---|
| 446 | stop |
---|
| 447 | endif |
---|
| 448 | jfile = jfile+1 |
---|
| 449 | CASE(3) reading2_seq ! Qext ---------------------------- |
---|
| 450 | isize = 1 |
---|
| 451 | DO WHILE (isize .le. nsize) |
---|
| 452 | READ(file_unit,*,iostat=read_ok) scanline |
---|
| 453 | if (read_ok.ne.0) then |
---|
| 454 | write(*,*)'reading2_seq: Error while reading line: ',& |
---|
| 455 | trim(scanline) |
---|
| 456 | write(*,*)' of file ',& |
---|
| 457 | trim(datadir)//'/'//trim(optpropfile) |
---|
| 458 | stop |
---|
| 459 | endif |
---|
| 460 | IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN |
---|
| 461 | BACKSPACE(file_unit) |
---|
| 462 | read(file_unit,*) Qext(:,isize) |
---|
| 463 | isize = isize + 1 |
---|
| 464 | ENDIF |
---|
| 465 | ENDDO |
---|
| 466 | endwhile = .true. |
---|
| 467 | CASE DEFAULT reading2_seq ! default -------------------- |
---|
| 468 | write(*,*) 'reading2_seq: ',& |
---|
| 469 | 'Error while loading optical properties.' |
---|
| 470 | stop |
---|
| 471 | END SELECT reading2_seq ! ============================== |
---|
| 472 | ENDIF |
---|
| 473 | ENDDO |
---|
| 474 | |
---|
| 475 | ! Close the file |
---|
| 476 | CLOSE(file_unit) |
---|
| 477 | |
---|
| 478 | write(*,*)"" |
---|
| 479 | write(*,*) "Wavelength array loaded from file ",trim(datadir)//'/'//trim(optpropfile) |
---|
| 480 | write(*,*) "ranging from ",wvl(1)," to ",wvl(nwvl)," meters" |
---|
| 481 | write(*,*) "Effective radius array loaded from file ",trim(datadir)//'/'//trim(optpropfile) |
---|
| 482 | write(*,*) "ranging from ",radiusdyn(1)," to ",radiusdyn(nsize)," meters" |
---|
| 483 | |
---|
| 484 | ! + NEW AER? : one may adapt this part to handle the properties' file of the new aerosol |
---|
| 485 | |
---|
| 486 | !========================================================================== |
---|
| 487 | ! 2.4 Get the optpropfile wavelength values encompassing the ref wavelength |
---|
| 488 | !========================================================================== |
---|
| 489 | iwvl=1 |
---|
| 490 | DO WHILE ((iwvl.le.nwvl).and.(wvl(iwvl).lt.wvl_val)) |
---|
| 491 | iwvl=iwvl+1 |
---|
| 492 | ENDDO |
---|
| 493 | if ((iwvl.gt.nwvl).or.(wvl(1).gt.wvl_val)) then |
---|
| 494 | write(*,*) "ERROR: the reference wavelength is out of the bounds" |
---|
| 495 | write(*,*) "of the file ",trim(datadir)//'/'//trim(optpropfile) |
---|
| 496 | write(*,*) "(wvl_inf=",wvl(1),"m ; wvl_sup=",wvl(nwvl),"m)" |
---|
| 497 | write(*,*) "Ensure you wrote it well (in meters)," |
---|
| 498 | write(*,*) "or supply a new optical properties' file (change in aeroptical.F90 directly)" |
---|
| 499 | stop |
---|
| 500 | endif |
---|
| 501 | if (wvl(iwvl).eq.wvl_val) then |
---|
| 502 | ! if the ref wavelength is in the optpropfile |
---|
| 503 | iwvl1 = iwvl |
---|
| 504 | iwvl2 = iwvl |
---|
| 505 | else ! wvl(iwvl)>wvl_val and wvl(iwvl-1)<wvl_val |
---|
| 506 | iwvl1 = iwvl-1 |
---|
| 507 | iwvl2 = iwvl |
---|
| 508 | endif |
---|
| 509 | |
---|
| 510 | |
---|
| 511 | !=============================================================================== |
---|
| 512 | ! 3. OUTPUT FILE VARIABLES |
---|
| 513 | !=============================================================================== |
---|
| 514 | !========================================================================== |
---|
| 515 | ! 3.1 Creation of the output individual aerosol opacities |
---|
| 516 | !========================================================================== |
---|
| 517 | ! Switch to netcdf define mode |
---|
| 518 | ierr=nf90_redef(outfid) |
---|
| 519 | write(*,*)"" |
---|
| 520 | SELECT CASE (iaer) |
---|
| 521 | CASE(1) ! DUST |
---|
| 522 | ! Insert the definition of the variable |
---|
| 523 | tmpvarname="opadust" |
---|
| 524 | ierr=NF90_DEF_VAR(outfid,trim(tmpvarname),nf90_float,varshape,tmpvaridout) |
---|
| 525 | error_text="ERROR: Couldn't create "//trim(tmpvarname)//" in the outfile" |
---|
| 526 | call status_check(ierr,error_text) |
---|
| 527 | write(*,*) trim(tmpvarname)//" has been created in the outfile" |
---|
| 528 | |
---|
| 529 | ! Write the attributes |
---|
| 530 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name","Dust extinction opacity at reference wavelength") |
---|
| 531 | |
---|
| 532 | CASE(2) ! WATER ICE |
---|
| 533 | ! Insert the definition of the variable |
---|
| 534 | tmpvarname="opawice" |
---|
| 535 | ierr=NF90_DEF_VAR(outfid,trim(tmpvarname),nf90_float,varshape,tmpvaridout) |
---|
| 536 | error_text="ERROR: Couldn't create "//trim(tmpvarname)//" in the outfile" |
---|
| 537 | call status_check(ierr,error_text) |
---|
| 538 | write(*,*) trim(tmpvarname)//" has been created in the outfile" |
---|
| 539 | |
---|
| 540 | ! Write the attributes |
---|
| 541 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name","Water ice extinction opacity at reference wavelength") |
---|
| 542 | |
---|
| 543 | ! + NEW AER? |
---|
| 544 | END SELECT ! iaer |
---|
| 545 | |
---|
| 546 | ierr=nf90_put_att(outfid,tmpvaridout,"units","opacity/km") |
---|
| 547 | ierr=nf90_put_att(outfid,tmpvaridout,"refwavelength",wvl_val) |
---|
[2327] | 548 | ierr=nf90_put_att(outfid,tmpvaridout,"missing_value",missval(iaer)) |
---|
| 549 | write(*,*)"with missing value = ",missval(iaer) |
---|
[2317] | 550 | |
---|
| 551 | ! End netcdf define mode |
---|
| 552 | ierr=nf90_enddef(outfid) |
---|
| 553 | |
---|
| 554 | !========================================================================== |
---|
| 555 | ! 3.2 Computation of the opacities |
---|
| 556 | !========================================================================== |
---|
| 557 | do ilon=1,lonlen |
---|
| 558 | do ilat=1,latlen |
---|
| 559 | do ialt=1,altlen |
---|
| 560 | do it=1,timelen |
---|
| 561 | ! Get the optpropfile reff values encompassing the GCM reff |
---|
| 562 | isize=1 |
---|
| 563 | do while((isize.le.nsize).and.(radiusdyn(isize).lt.reff(iaer,ilon,ilat,ialt,it))) |
---|
| 564 | isize=isize+1 |
---|
| 565 | enddo |
---|
| 566 | if ((isize.gt.nsize).or.(radiusdyn(1).gt.reff(iaer,ilon,ilat,ialt,it))) then |
---|
| 567 | ! write(*,*) "WARNING: the GCM reff (",reff(iaer,ilon,ilat,ialt,it),"m) is out of the bounds" |
---|
| 568 | ! write(*,*) "of the file ",trim(datadir)//'/'//trim(optpropfile) |
---|
| 569 | ! write(*,*) "(reff_inf=",radiusdyn(1),"m ; reff_sup=",radiusdyn(nsize),"m)" |
---|
| 570 | ! write(*,*) "A missing value will be written for opacity" |
---|
| 571 | |
---|
| 572 | ! NB: this should especially handle cases when reff=0 |
---|
[2327] | 573 | opa_aer(iaer,ilon,ilat,ialt,it)=missval(iaer) |
---|
| 574 | |
---|
| 575 | else if (mmr(iaer,ilon,ilat,ialt,it).eq.missval(iaer)) then |
---|
| 576 | ! if there is a missing value in input file |
---|
| 577 | opa_aer(iaer,ilon,ilat,ialt,it)=missval(iaer) |
---|
| 578 | |
---|
[2317] | 579 | else |
---|
| 580 | if (radiusdyn(isize).eq.reff(iaer,ilon,ilat,ialt,it)) then |
---|
| 581 | ! if the GCM reff is in the optpropfile |
---|
| 582 | isize1 = isize |
---|
| 583 | isize2 = isize |
---|
| 584 | else ! radius(isize)>reff and radiusdyn(isize-1)<reff |
---|
| 585 | isize1 = isize-1 |
---|
| 586 | isize2 = isize |
---|
| 587 | endif |
---|
| 588 | |
---|
| 589 | ! Linear interpolation in effective radius |
---|
| 590 | if (isize2.ne.isize1) then |
---|
| 591 | coeff = (reff(iaer,ilon,ilat,ialt,it)-radiusdyn(isize1))/(radiusdyn(isize2)-radiusdyn(isize1)) |
---|
| 592 | else |
---|
| 593 | coeff = 0. |
---|
| 594 | endif |
---|
| 595 | reffQext(1) = Qext(iwvl1,isize1)+coeff*(Qext(iwvl1,isize2)-Qext(iwvl1,isize1)) |
---|
| 596 | reffQext(2) = Qext(iwvl2,isize1)+coeff*(Qext(iwvl2,isize2)-Qext(iwvl2,isize1)) |
---|
| 597 | |
---|
| 598 | ! Linear interpolation in wavelength |
---|
| 599 | if (iwvl2.ne.iwvl1) then |
---|
| 600 | coeff = (wvl_val-wvl(iwvl1))/(wvl(iwvl2)-wvl(iwvl1)) |
---|
| 601 | else |
---|
| 602 | coeff = 0. |
---|
| 603 | endif |
---|
| 604 | Qext_val = reffQext(1)+coeff*(reffQext(2)-reffQext(1)) |
---|
| 605 | |
---|
| 606 | ! Computation of the opacity [1/km] |
---|
| 607 | opa_aer(iaer,ilon,ilat,ialt,it)= 750.*Qext_val*mmr(iaer,ilon,ilat,ialt,it)*rho(ilon,ilat,ialt,it)& |
---|
| 608 | / ( rho_aer(iaer) * reff(iaer,ilon,ilat,ialt,it) ) |
---|
| 609 | |
---|
| 610 | endif |
---|
| 611 | enddo ! it |
---|
| 612 | enddo ! ialt |
---|
| 613 | enddo ! ilat |
---|
| 614 | enddo ! ilon |
---|
| 615 | |
---|
| 616 | !========================================================================== |
---|
| 617 | ! 3.3 Writing in the output file |
---|
| 618 | !========================================================================== |
---|
| 619 | ierr = NF90_PUT_VAR(outfid, tmpvaridout, opa_aer(iaer,:,:,:,:)) |
---|
| 620 | error_text="Error: could not write "//trim(tmpvarname)//" data in the outfile" |
---|
| 621 | call status_check(ierr,error_text) |
---|
| 622 | |
---|
| 623 | !========================================================================== |
---|
| 624 | ! 3.4 Prepare next loop |
---|
| 625 | !========================================================================== |
---|
| 626 | DEALLOCATE(wvl) |
---|
| 627 | DEALLOCATE(radiusdyn) |
---|
| 628 | DEALLOCATE(Qext) |
---|
| 629 | |
---|
| 630 | endif ! if aerok(iaer) |
---|
| 631 | |
---|
| 632 | ENDDO ! iaer |
---|
| 633 | |
---|
| 634 | !=============================================================================== |
---|
| 635 | ! 4. Close the files and end the program |
---|
| 636 | !=============================================================================== |
---|
| 637 | ierr = nf90_close(gcmfid) |
---|
| 638 | error_text="Error: could not close file "//trim(gcmfile) |
---|
| 639 | call status_check(ierr,error_text) |
---|
| 640 | |
---|
| 641 | ierr = nf90_close(outfid) |
---|
| 642 | error_text="Error: could not close file "//trim(outfile) |
---|
| 643 | call status_check(ierr,error_text) |
---|
| 644 | |
---|
| 645 | write(*,*)"";write(*,*)"Program aeroptical completed!" |
---|
| 646 | |
---|
| 647 | end program aeroptical |
---|
| 648 | |
---|
| 649 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 650 | !! SUBROUTINES |
---|
| 651 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
| 652 | |
---|
| 653 | subroutine status_check(ierr,error_text) |
---|
| 654 | |
---|
| 655 | use netcdf |
---|
| 656 | implicit none |
---|
| 657 | !================================================================ |
---|
| 658 | ! Arguments: |
---|
| 659 | !================================================================ |
---|
| 660 | integer,intent(in) :: ierr ! NetCDF status number |
---|
| 661 | character(len=256),intent(in) :: error_text |
---|
| 662 | |
---|
| 663 | if (ierr.ne.nf90_noerr) then |
---|
| 664 | write(*,*)trim(error_text) |
---|
| 665 | write(*,*)trim(nf90_strerror(ierr)) |
---|
| 666 | stop |
---|
| 667 | endif |
---|
| 668 | |
---|
| 669 | end subroutine status_check |
---|
| 670 | |
---|
| 671 | |
---|
| 672 | !******************************************************************************* |
---|
| 673 | |
---|
| 674 | subroutine inidims(gcmfile,gcmfid,outfile,outfid,lonlen,latlen,altlen,timelen,& |
---|
| 675 | latdimout,londimout,altdimout,timedimout,& |
---|
| 676 | GCM_layers,layerdimout,interlayerdimout) |
---|
| 677 | |
---|
| 678 | !============================================================================== |
---|
| 679 | ! Purpose: |
---|
| 680 | ! Read the dimensions of the input file |
---|
| 681 | ! and write them in the output file |
---|
| 682 | !============================================================================== |
---|
| 683 | ! Remarks: |
---|
| 684 | ! The NetCDF files must be open |
---|
| 685 | !============================================================================== |
---|
| 686 | use netcdf |
---|
| 687 | |
---|
| 688 | implicit none |
---|
| 689 | |
---|
| 690 | !============================================================================== |
---|
| 691 | ! Arguments: |
---|
| 692 | !============================================================================== |
---|
| 693 | character(len=128),intent(in) :: gcmfile ! name of the netcdf GCM input file |
---|
| 694 | integer,intent(in) :: gcmfid ! [netcdf] GCM input file ID number |
---|
| 695 | character(len=128),intent(in) :: outfile ! name of the netcdf output file |
---|
| 696 | integer,intent(in) :: outfid ! [netcdf] file ID number |
---|
| 697 | |
---|
| 698 | integer,intent(out) :: lonlen,latlen,altlen,timelen |
---|
| 699 | ! nb of grid points along longitude,latitude,altitude,time |
---|
| 700 | integer,intent(out) :: latdimout,londimout,altdimout,timedimout |
---|
| 701 | ! latdimout: stores latitude dimension ID number |
---|
| 702 | ! londimout: stores longitude dimension ID number |
---|
| 703 | ! altdimout: stores altitude dimension ID number |
---|
| 704 | ! timedimout: stores time dimension ID number |
---|
| 705 | integer,intent(out) :: GCM_layers ! number of GCM layers |
---|
| 706 | integer,intent(out) :: layerdimout ! "GCM_layers" ID |
---|
| 707 | integer,intent(out) :: interlayerdimout ! "GCM_layers+1" ID |
---|
| 708 | |
---|
| 709 | !============================================================================== |
---|
| 710 | ! Local variables: |
---|
| 711 | !============================================================================== |
---|
| 712 | integer :: ierr ! [netcdf] subroutine returned error code |
---|
| 713 | character(len=256) :: error_text ! text to display in case of error |
---|
| 714 | |
---|
| 715 | integer :: tmpdimid,tmpvarid ! temporary store a dimension/variable ID number |
---|
| 716 | character (len=64) :: long_name,units,positive |
---|
| 717 | ! long_name(): [netcdf] long_name attribute |
---|
| 718 | ! units(): [netcdf] units attribute |
---|
| 719 | ! positive(): [netcdf] positive direction attribute (for altitude) |
---|
| 720 | real, dimension(:), allocatable:: lat,lon,alt,time,ctl |
---|
| 721 | ! lat(): array, stores latitude coordinates |
---|
| 722 | ! lon(): array, stores longitude coordinates |
---|
| 723 | ! alt(): array, stores altitude coordinates |
---|
| 724 | ! time(): array, stores time coordinates |
---|
| 725 | ! ctl(): array, stores controle variable |
---|
| 726 | integer :: ctllen ! nb of elements in the controle array |
---|
| 727 | integer :: tmpdimidout,tmpvaridout ! temporary stores a dimension/variable ID number |
---|
| 728 | |
---|
| 729 | !============================================================================== |
---|
| 730 | ! LONGITUDE |
---|
| 731 | !============================================================================== |
---|
| 732 | ! Get the dimension in GCM file |
---|
| 733 | ierr=nf90_inq_dimid(gcmfid,"longitude",tmpdimid) |
---|
| 734 | error_text="Error: Dimension <longitude> is missing in file "//trim(gcmfile) |
---|
| 735 | call status_check(ierr,error_text) |
---|
| 736 | |
---|
| 737 | ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=lonlen) |
---|
| 738 | allocate(lon(lonlen)) |
---|
| 739 | |
---|
| 740 | ! Create the dimension in output file |
---|
| 741 | ierr=NF90_DEF_DIM(outfid,"longitude",lonlen,londimout) |
---|
| 742 | error_text="Error: could not define the longitude dimension in the outfile" |
---|
| 743 | call status_check(ierr,error_text) |
---|
| 744 | |
---|
| 745 | ! Get the field in GCM file |
---|
| 746 | ierr=nf90_inq_varid(gcmfid,"longitude",tmpvarid) |
---|
| 747 | error_text="Error: Field <longitude> is missing in file "//trim(gcmfile) |
---|
| 748 | call status_check(ierr,error_text) |
---|
| 749 | |
---|
| 750 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,lon) |
---|
| 751 | error_text="Failed to load longitude" |
---|
| 752 | call status_check(ierr,error_text) |
---|
| 753 | |
---|
| 754 | ! Create the field in the output file |
---|
| 755 | ierr=NF90_DEF_VAR(outfid,"longitude",nf90_float,(/londimout/),tmpvaridout) |
---|
| 756 | error_text="Error: could not define the longitude variable in the outfile" |
---|
| 757 | call status_check(ierr,error_text) |
---|
| 758 | |
---|
| 759 | ! Get the field attributes in the GCM file |
---|
| 760 | ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name) |
---|
| 761 | if (ierr.ne.nf90_noerr) then |
---|
| 762 | ! if no attribute "long_name", try "title" |
---|
| 763 | ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name) |
---|
| 764 | endif |
---|
| 765 | ierr=nf90_get_att(gcmfid,tmpvarid,"units",units) |
---|
| 766 | |
---|
| 767 | ! Put the field attributes in the output file |
---|
| 768 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name) |
---|
| 769 | ierr=nf90_put_att(outfid,tmpvaridout,"units",units) |
---|
| 770 | |
---|
| 771 | ! Write the field values in the output file |
---|
| 772 | ierr=nf90_enddef(outfid) ! end netcdf define mode |
---|
| 773 | error_text="Error: could not end the define mode of the outfile" |
---|
| 774 | call status_check(ierr,error_text) |
---|
| 775 | |
---|
| 776 | ierr=NF90_PUT_VAR(outfid,tmpvaridout,lon) |
---|
| 777 | error_text="Error: could not write the longitude field in the outfile" |
---|
| 778 | call status_check(ierr,error_text) |
---|
| 779 | |
---|
| 780 | !============================================================================== |
---|
| 781 | ! LATITUDE |
---|
| 782 | !============================================================================== |
---|
| 783 | ! Switch to netcdf define mode |
---|
| 784 | ierr=nf90_redef(outfid) |
---|
| 785 | error_text="Error: could not switch to define mode in the outfile" |
---|
| 786 | call status_check(ierr,error_text) |
---|
| 787 | |
---|
| 788 | ! Get the dimension in GCM file |
---|
| 789 | ierr=nf90_inq_dimid(gcmfid,"latitude",tmpdimid) |
---|
| 790 | error_text="Error: Dimension <latitude> is missing in file "//trim(gcmfile) |
---|
| 791 | call status_check(ierr,error_text) |
---|
| 792 | |
---|
| 793 | ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=latlen) |
---|
| 794 | allocate(lat(latlen)) |
---|
| 795 | |
---|
| 796 | ! Create the dimension in output file |
---|
| 797 | ierr=NF90_DEF_DIM(outfid,"latitude",latlen,latdimout) |
---|
| 798 | error_text="Error: could not define the latitude dimension in the outfile" |
---|
| 799 | call status_check(ierr,error_text) |
---|
| 800 | |
---|
| 801 | ! Get the field in GCM file |
---|
| 802 | ierr=nf90_inq_varid(gcmfid,"latitude",tmpvarid) |
---|
| 803 | error_text="Error: Field <latitude> is missing in file "//trim(gcmfile) |
---|
| 804 | call status_check(ierr,error_text) |
---|
| 805 | |
---|
| 806 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,lat) |
---|
| 807 | error_text="Failed to load latitude" |
---|
| 808 | call status_check(ierr,error_text) |
---|
| 809 | |
---|
| 810 | ! Create the field in the output file |
---|
| 811 | ierr=NF90_DEF_VAR(outfid,"latitude",nf90_float,(/latdimout/),tmpvaridout) |
---|
| 812 | error_text="Error: could not define the latitude variable in the outfile" |
---|
| 813 | call status_check(ierr,error_text) |
---|
| 814 | |
---|
| 815 | ! Get the field attributes in the GCM file |
---|
| 816 | ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name) |
---|
| 817 | if (ierr.ne.nf90_noerr) then |
---|
| 818 | ! if no attribute "long_name", try "title" |
---|
| 819 | ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name) |
---|
| 820 | endif |
---|
| 821 | ierr=nf90_get_att(gcmfid,tmpvarid,"units",units) |
---|
| 822 | |
---|
| 823 | ! Put the field attributes in the output file |
---|
| 824 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name) |
---|
| 825 | ierr=nf90_put_att(outfid,tmpvaridout,"units",units) |
---|
| 826 | |
---|
| 827 | ! Write the field values in the output file |
---|
| 828 | ierr=nf90_enddef(outfid) ! end netcdf define mode |
---|
| 829 | error_text="Error: could not end the define mode of the outfile" |
---|
| 830 | call status_check(ierr,error_text) |
---|
| 831 | |
---|
| 832 | ierr=NF90_PUT_VAR(outfid,tmpvaridout,lat) |
---|
| 833 | error_text="Error: could not write the latitude field in the outfile" |
---|
| 834 | call status_check(ierr,error_text) |
---|
| 835 | |
---|
| 836 | !============================================================================== |
---|
| 837 | ! ALTITUDE |
---|
| 838 | !============================================================================== |
---|
| 839 | ! Switch to netcdf define mode |
---|
| 840 | ierr=nf90_redef(outfid) |
---|
| 841 | error_text="Error: could not switch to define mode in the outfile" |
---|
| 842 | call status_check(ierr,error_text) |
---|
| 843 | |
---|
| 844 | ! Get the dimension in GCM file |
---|
| 845 | ierr=nf90_inq_dimid(gcmfid,"altitude",tmpdimid) |
---|
| 846 | error_text="Error: Dimension <altitude> is missing in file "//trim(gcmfile) |
---|
| 847 | call status_check(ierr,error_text) |
---|
| 848 | |
---|
| 849 | ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=altlen) |
---|
| 850 | allocate(alt(altlen)) |
---|
| 851 | |
---|
| 852 | ! Create the dimension in output file |
---|
| 853 | ierr=NF90_DEF_DIM(outfid,"altitude",altlen,altdimout) |
---|
| 854 | error_text="Error: could not define the altitude dimension in the outfile" |
---|
| 855 | call status_check(ierr,error_text) |
---|
| 856 | |
---|
| 857 | ! Get the field in GCM file |
---|
| 858 | ierr=nf90_inq_varid(gcmfid,"altitude",tmpvarid) |
---|
| 859 | error_text="Error: Field <altitude> is missing in file "//trim(gcmfile) |
---|
| 860 | call status_check(ierr,error_text) |
---|
| 861 | |
---|
| 862 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,alt) |
---|
| 863 | error_text="Failed to load altitude" |
---|
| 864 | call status_check(ierr,error_text) |
---|
| 865 | |
---|
| 866 | ! Create the field in the output file |
---|
| 867 | ierr=NF90_DEF_VAR(outfid,"altitude",nf90_float,(/altdimout/),tmpvaridout) |
---|
| 868 | error_text="Error: could not define the altitude variable in the outfile" |
---|
| 869 | call status_check(ierr,error_text) |
---|
| 870 | |
---|
| 871 | ! Get the field attributes in the GCM file |
---|
| 872 | ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name) |
---|
| 873 | if (ierr.ne.nf90_noerr) then |
---|
| 874 | ! if no attribute "long_name", try "title" |
---|
| 875 | ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name) |
---|
| 876 | endif |
---|
| 877 | ierr=nf90_get_att(gcmfid,tmpvarid,"units",units) |
---|
| 878 | ierr=nf90_get_att(gcmfid,tmpvarid,"positive",positive) |
---|
| 879 | |
---|
| 880 | ! Put the field attributes in the output file |
---|
| 881 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name) |
---|
| 882 | ierr=nf90_put_att(outfid,tmpvaridout,"units",units) |
---|
| 883 | ierr=nf90_put_att(outfid,tmpvaridout,"positive",positive) |
---|
| 884 | |
---|
| 885 | ! Write the field values in the output file |
---|
| 886 | ierr=nf90_enddef(outfid) ! end netcdf define mode |
---|
| 887 | error_text="Error: could not end the define mode of the outfile" |
---|
| 888 | call status_check(ierr,error_text) |
---|
| 889 | |
---|
| 890 | ierr=NF90_PUT_VAR(outfid,tmpvaridout,alt) |
---|
| 891 | error_text="Error: could not write the altitude field in the outfile" |
---|
| 892 | call status_check(ierr,error_text) |
---|
| 893 | |
---|
| 894 | !============================================================================== |
---|
| 895 | ! TIME |
---|
| 896 | !============================================================================== |
---|
| 897 | ! Switch to netcdf define mode |
---|
| 898 | ierr=nf90_redef(outfid) |
---|
| 899 | error_text="Error: could not switch to define mode in the outfile" |
---|
| 900 | call status_check(ierr,error_text) |
---|
| 901 | |
---|
| 902 | ! Get the dimension in GCM file |
---|
| 903 | ierr=nf90_inq_dimid(gcmfid,"Time",tmpdimid) |
---|
| 904 | error_text="Error: Dimension <Time> is missing in file "//trim(gcmfile) |
---|
| 905 | call status_check(ierr,error_text) |
---|
| 906 | |
---|
| 907 | ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=timelen) |
---|
| 908 | allocate(time(timelen)) |
---|
| 909 | |
---|
| 910 | ! Create the dimension in output file |
---|
| 911 | ierr=NF90_DEF_DIM(outfid,"Time",timelen,timedimout) |
---|
| 912 | error_text="Error: could not define the time dimension in the outfile" |
---|
| 913 | call status_check(ierr,error_text) |
---|
| 914 | |
---|
| 915 | ! Get the field in GCM file |
---|
| 916 | ierr=nf90_inq_varid(gcmfid,"Time",tmpvarid) |
---|
| 917 | error_text="Error: Field <Time> is missing in file "//trim(gcmfile) |
---|
| 918 | call status_check(ierr,error_text) |
---|
| 919 | |
---|
| 920 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,time) |
---|
| 921 | error_text="Failed to load Time" |
---|
| 922 | call status_check(ierr,error_text) |
---|
| 923 | |
---|
| 924 | ! Create the field in the output file |
---|
| 925 | ierr=NF90_DEF_VAR(outfid,"Time",nf90_float,(/timedimout/),tmpvaridout) |
---|
| 926 | error_text="Error: could not define the Time variable in the outfile" |
---|
| 927 | call status_check(ierr,error_text) |
---|
| 928 | |
---|
| 929 | ! Get the field attributes in the GCM file |
---|
| 930 | ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name) |
---|
| 931 | if (ierr.ne.nf90_noerr) then |
---|
| 932 | ! if no attribute "long_name", try "title" |
---|
| 933 | ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name) |
---|
| 934 | endif |
---|
| 935 | ierr=nf90_get_att(gcmfid,tmpvarid,"units",units) |
---|
| 936 | |
---|
| 937 | ! Put the field attributes in the output file |
---|
| 938 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name) |
---|
| 939 | ierr=nf90_put_att(outfid,tmpvaridout,"units",units) |
---|
| 940 | |
---|
| 941 | ! Write the field values in the output file |
---|
| 942 | ierr=nf90_enddef(outfid) ! end netcdf define mode |
---|
| 943 | error_text="Error: could not end the define mode of the outfile" |
---|
| 944 | call status_check(ierr,error_text) |
---|
| 945 | |
---|
| 946 | ierr=NF90_PUT_VAR(outfid,tmpvaridout,time) |
---|
| 947 | error_text="Error: could not write the Time field in the outfile" |
---|
| 948 | call status_check(ierr,error_text) |
---|
| 949 | |
---|
| 950 | !============================================================================== |
---|
| 951 | ! CONTROLE |
---|
| 952 | !============================================================================== |
---|
| 953 | ! Switch to netcdf define mode |
---|
| 954 | ierr=nf90_redef(outfid) |
---|
| 955 | error_text="Error: could not switch to define mode in the outfile" |
---|
| 956 | call status_check(ierr,error_text) |
---|
| 957 | |
---|
| 958 | ! Get the dimension in GCM file |
---|
| 959 | ierr=nf90_inq_dimid(gcmfid,"index",tmpdimid) |
---|
| 960 | error_text="Dimension <index> is missing in file "//trim(gcmfile)& |
---|
| 961 | //". We'll skip that one." |
---|
| 962 | if (ierr.ne.nf90_noerr) then |
---|
| 963 | write(*,*)trim(error_text) |
---|
| 964 | ierr=nf90_enddef(outfid) ! end netcdf define mode |
---|
| 965 | error_text="Error: could not end the define mode of the outfile" |
---|
| 966 | call status_check(ierr,error_text) |
---|
| 967 | else |
---|
| 968 | ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=ctllen) |
---|
| 969 | allocate(ctl(ctllen)) |
---|
| 970 | |
---|
| 971 | ! Create the dimension in output file |
---|
| 972 | ierr=NF90_DEF_DIM(outfid,"index",ctllen,tmpdimidout) |
---|
| 973 | error_text="Error: could not define the index dimension in the outfile" |
---|
| 974 | call status_check(ierr,error_text) |
---|
| 975 | |
---|
| 976 | ! Get the field in GCM file |
---|
| 977 | ierr=nf90_inq_varid(gcmfid,"controle",tmpvarid) |
---|
| 978 | error_text="Error: Field <controle> is missing in file "//trim(gcmfile) |
---|
| 979 | call status_check(ierr,error_text) |
---|
| 980 | |
---|
| 981 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,ctl) |
---|
| 982 | error_text="Failed to load ctl" |
---|
| 983 | call status_check(ierr,error_text) |
---|
| 984 | |
---|
| 985 | ! Create the field in the output file |
---|
| 986 | ierr=NF90_DEF_VAR(outfid,"controle",nf90_float,(/tmpdimidout/),tmpvaridout) |
---|
| 987 | error_text="Error: could not define the controle variable in the outfile" |
---|
| 988 | call status_check(ierr,error_text) |
---|
| 989 | |
---|
| 990 | ! Get the field attributes in the GCM file |
---|
| 991 | ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name) |
---|
| 992 | if (ierr.ne.nf90_noerr) then |
---|
| 993 | ! if no attribute "long_name", try "title" |
---|
| 994 | ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name) |
---|
| 995 | endif |
---|
| 996 | |
---|
| 997 | ! Put the field attributes in the output file |
---|
| 998 | ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name) |
---|
| 999 | |
---|
| 1000 | ! Write the field values in the output file |
---|
| 1001 | ierr=nf90_enddef(outfid) ! end netcdf define mode |
---|
| 1002 | error_text="Error: could not end the define mode of the outfile" |
---|
| 1003 | call status_check(ierr,error_text) |
---|
| 1004 | |
---|
| 1005 | ierr=NF90_PUT_VAR(outfid,tmpvaridout,ctl) |
---|
| 1006 | error_text="Error: could not write the controle field in the outfile" |
---|
| 1007 | call status_check(ierr,error_text) |
---|
| 1008 | endif |
---|
| 1009 | |
---|
| 1010 | |
---|
| 1011 | !============================================================================== |
---|
| 1012 | ! Load size of aps() or sigma() (in case it is not altlen) |
---|
| 1013 | !============================================================================== |
---|
| 1014 | ! Switch to netcdf define mode |
---|
| 1015 | ierr=nf90_redef(outfid) |
---|
| 1016 | error_text="Error: could not switch to define mode in the outfile" |
---|
| 1017 | call status_check(ierr,error_text) |
---|
| 1018 | |
---|
| 1019 | ! Default is that GCM_layers=altlen |
---|
| 1020 | ! but for outputs of zrecast, it may be a different value |
---|
| 1021 | ierr=nf90_inq_dimid(gcmfid,"GCM_layers",tmpdimid) |
---|
| 1022 | if (ierr.ne.nf90_noerr) then |
---|
| 1023 | ! didn't find a GCM_layers dimension; therefore we have: |
---|
| 1024 | GCM_layers=altlen |
---|
| 1025 | else |
---|
| 1026 | ! load value of GCM_layers |
---|
| 1027 | ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=GCM_layers) |
---|
| 1028 | endif |
---|
| 1029 | |
---|
| 1030 | ! Create the dimensions in output file |
---|
| 1031 | ierr = NF90_DEF_DIM(outfid,"GCM_layers",GCM_layers,layerdimout) |
---|
| 1032 | error_text="Error: could not define the GCM_layers dimension in the outfile" |
---|
| 1033 | call status_check(ierr,error_text) |
---|
| 1034 | ierr = NF90_DEF_DIM(outfid,"GCM_interlayers",GCM_layers+1,interlayerdimout) |
---|
| 1035 | error_text="Error: could not define the GCM_interlayers dimension in the outfile" |
---|
| 1036 | call status_check(ierr,error_text) |
---|
| 1037 | |
---|
| 1038 | ! End netcdf define mode |
---|
| 1039 | ierr=nf90_enddef(outfid) |
---|
| 1040 | error_text="Error: could not end the define mode of the outfile" |
---|
| 1041 | call status_check(ierr,error_text) |
---|
| 1042 | |
---|
| 1043 | end subroutine inidims |
---|
| 1044 | |
---|
| 1045 | |
---|
| 1046 | !******************************************************************************* |
---|
| 1047 | |
---|
| 1048 | subroutine init2(gcmfid,lonlen,latlen,altlen,GCM_layers, & |
---|
| 1049 | outfid,londimout,latdimout,altdimout, & |
---|
| 1050 | layerdimout,interlayerdimout) |
---|
| 1051 | !============================================================================== |
---|
| 1052 | ! Purpose: |
---|
| 1053 | ! Copy ap() , bp(), aps(), bps(), aire() and phisinit() |
---|
| 1054 | ! from input file to outpout file |
---|
| 1055 | !============================================================================== |
---|
| 1056 | ! Remarks: |
---|
| 1057 | ! The NetCDF files must be open |
---|
| 1058 | !============================================================================== |
---|
| 1059 | |
---|
| 1060 | use netcdf |
---|
| 1061 | |
---|
| 1062 | implicit none |
---|
| 1063 | |
---|
| 1064 | !============================================================================== |
---|
| 1065 | ! Arguments: |
---|
| 1066 | !============================================================================== |
---|
| 1067 | integer, intent(in) :: gcmfid ! NetCDF output file ID |
---|
| 1068 | integer, intent(in) :: lonlen ! # of grid points along longitude |
---|
| 1069 | integer, intent(in) :: latlen ! # of grid points along latitude |
---|
[2327] | 1070 | integer, intent(in) :: altlen ! # of grid points along altitude |
---|
[2317] | 1071 | integer, intent(in) :: GCM_layers ! # of GCM atmospheric layers |
---|
| 1072 | integer, intent(in) :: outfid ! NetCDF output file ID |
---|
| 1073 | integer, intent(in) :: londimout ! longitude dimension ID |
---|
| 1074 | integer, intent(in) :: latdimout ! latitude dimension ID |
---|
| 1075 | integer, intent(in) :: altdimout ! altitude dimension ID |
---|
| 1076 | integer, intent(in) :: layerdimout ! GCM_layers dimension ID |
---|
| 1077 | integer, intent(in) :: interlayerdimout ! GCM_layers+1 dimension ID |
---|
| 1078 | !============================================================================== |
---|
| 1079 | ! Local variables: |
---|
| 1080 | !============================================================================== |
---|
| 1081 | real,dimension(:),allocatable :: aps,bps ! hybrid vertical coordinates |
---|
| 1082 | real,dimension(:),allocatable :: ap,bp ! hybrid vertical coordinates |
---|
| 1083 | real,dimension(:),allocatable :: sigma ! sigma levels |
---|
| 1084 | real,dimension(:,:),allocatable :: aire ! mesh areas |
---|
| 1085 | real,dimension(:,:),allocatable :: phisinit ! Ground geopotential |
---|
| 1086 | integer :: ierr |
---|
| 1087 | integer :: tmpvarid ! temporary variable ID |
---|
| 1088 | logical :: area ! is "aire" available ? |
---|
| 1089 | logical :: phis ! is "phisinit" available ? |
---|
| 1090 | logical :: hybrid ! are "aps" and "bps" available ? |
---|
| 1091 | logical :: apbp ! are "ap" and "bp" available ? |
---|
| 1092 | |
---|
| 1093 | !============================================================================== |
---|
| 1094 | ! 1. Read data from input file |
---|
| 1095 | !============================================================================== |
---|
| 1096 | |
---|
| 1097 | ! hybrid coordinate aps |
---|
| 1098 | !write(*,*) "aps: altlen=",altlen," GCM_layers=",GCM_layers |
---|
| 1099 | allocate(aps(GCM_layers),stat=ierr) |
---|
| 1100 | if (ierr.ne.0) then |
---|
| 1101 | write(*,*) "init2: failed to allocate aps!" |
---|
| 1102 | stop |
---|
| 1103 | endif |
---|
| 1104 | ierr=nf90_inq_varid(gcmfid,"aps",tmpvarid) |
---|
| 1105 | if (ierr.ne.nf90_noerr) then |
---|
| 1106 | write(*,*) "Ooops. Failed to get aps ID. OK, will look for sigma coord." |
---|
| 1107 | hybrid=.false. |
---|
| 1108 | else |
---|
| 1109 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,aps) |
---|
| 1110 | hybrid=.true. |
---|
| 1111 | if (ierr.ne.nf90_noerr) then |
---|
| 1112 | stop "init2 Error: Failed reading aps" |
---|
| 1113 | endif |
---|
| 1114 | |
---|
| 1115 | ! hybrid coordinate bps |
---|
| 1116 | ! write(*,*) "bps: altlen=",altlen," GCM_layers=",GCM_layers |
---|
| 1117 | allocate(bps(GCM_layers),stat=ierr) |
---|
| 1118 | if (ierr.ne.0) then |
---|
| 1119 | write(*,*) "init2: failed to allocate bps!" |
---|
| 1120 | stop |
---|
| 1121 | endif |
---|
| 1122 | ierr=nf90_inq_varid(gcmfid,"bps",tmpvarid) |
---|
| 1123 | if (ierr.ne.nf90_noerr) then |
---|
| 1124 | stop "init2 Error: Failed to get bps ID." |
---|
| 1125 | endif |
---|
| 1126 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,bps) |
---|
| 1127 | if (ierr.ne.nf90_noerr) then |
---|
| 1128 | stop "init2 Error: Failed reading bps" |
---|
| 1129 | endif |
---|
| 1130 | endif |
---|
| 1131 | |
---|
| 1132 | ! hybrid coordinate ap |
---|
| 1133 | allocate(ap(GCM_layers+1),stat=ierr) |
---|
| 1134 | if (ierr.ne.0) then |
---|
| 1135 | write(*,*) "init2: failed to allocate ap!" |
---|
| 1136 | stop |
---|
| 1137 | else |
---|
| 1138 | ierr=nf90_inq_varid(gcmfid,"ap",tmpvarid) |
---|
| 1139 | if (ierr.ne.nf90_noerr) then |
---|
| 1140 | write(*,*) "Ooops. Failed to get ap ID. OK." |
---|
| 1141 | apbp=.false. |
---|
| 1142 | else |
---|
| 1143 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,ap) |
---|
| 1144 | apbp=.true. |
---|
| 1145 | if (ierr.ne.nf90_noerr) then |
---|
| 1146 | stop "Error: Failed reading ap" |
---|
| 1147 | endif |
---|
| 1148 | endif |
---|
| 1149 | endif |
---|
| 1150 | |
---|
| 1151 | ! hybrid coordinate bp |
---|
| 1152 | allocate(bp(GCM_layers+1),stat=ierr) |
---|
| 1153 | if (ierr.ne.0) then |
---|
| 1154 | write(*,*) "init2: failed to allocate bp!" |
---|
| 1155 | stop |
---|
| 1156 | else |
---|
| 1157 | ierr=nf90_inq_varid(gcmfid,"bp",tmpvarid) |
---|
| 1158 | if (ierr.ne.nf90_noerr) then |
---|
| 1159 | write(*,*) "Ooops. Failed to get bp ID. OK." |
---|
| 1160 | apbp=.false. |
---|
| 1161 | else |
---|
| 1162 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,bp) |
---|
| 1163 | apbp=.true. |
---|
| 1164 | if (ierr.ne.nf90_noerr) then |
---|
| 1165 | stop "Error: Failed reading bp" |
---|
| 1166 | endif |
---|
| 1167 | endif |
---|
| 1168 | endif |
---|
| 1169 | |
---|
| 1170 | ! sigma levels (if any) |
---|
| 1171 | if (.not.hybrid) then |
---|
| 1172 | allocate(sigma(GCM_layers),stat=ierr) |
---|
| 1173 | if (ierr.ne.0) then |
---|
| 1174 | write(*,*) "init2: failed to allocate sigma" |
---|
| 1175 | stop |
---|
| 1176 | endif |
---|
| 1177 | ierr=nf90_inq_varid(gcmfid,"sigma",tmpvarid) |
---|
| 1178 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,sigma) |
---|
| 1179 | if (ierr.ne.nf90_noerr) then |
---|
| 1180 | stop "init2 Error: Failed reading sigma" |
---|
| 1181 | endif |
---|
| 1182 | endif ! of if (.not.hybrid) |
---|
| 1183 | |
---|
| 1184 | ! mesh area |
---|
| 1185 | allocate(aire(lonlen,latlen),stat=ierr) |
---|
| 1186 | if (ierr.ne.0) then |
---|
| 1187 | write(*,*) "init2: failed to allocate aire!" |
---|
| 1188 | stop |
---|
| 1189 | endif |
---|
| 1190 | ierr=nf90_inq_varid(gcmfid,"aire",tmpvarid) |
---|
| 1191 | if (ierr.ne.nf90_noerr) then |
---|
| 1192 | write(*,*)"init2 warning: Failed to get aire ID." |
---|
| 1193 | area = .false. |
---|
| 1194 | else |
---|
| 1195 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,aire) |
---|
| 1196 | if (ierr.ne.nf90_noerr) then |
---|
| 1197 | stop "init2 Error: Failed reading aire" |
---|
| 1198 | endif |
---|
| 1199 | area = .true. |
---|
| 1200 | endif |
---|
| 1201 | |
---|
| 1202 | ! ground geopotential phisinit |
---|
| 1203 | allocate(phisinit(lonlen,latlen),stat=ierr) |
---|
| 1204 | if (ierr.ne.0) then |
---|
| 1205 | write(*,*) "init2: failed to allocate phisinit!" |
---|
| 1206 | stop |
---|
| 1207 | endif |
---|
| 1208 | ierr=nf90_inq_varid(gcmfid,"phisinit",tmpvarid) |
---|
| 1209 | if (ierr.ne.nf90_noerr) then |
---|
| 1210 | write(*,*)"init2 warning: Failed to get phisinit ID." |
---|
| 1211 | phis = .false. |
---|
| 1212 | else |
---|
| 1213 | ierr=NF90_GET_VAR(gcmfid,tmpvarid,phisinit) |
---|
| 1214 | if (ierr.ne.nf90_noerr) then |
---|
| 1215 | stop "init2 Error: Failed reading phisinit" |
---|
| 1216 | endif |
---|
| 1217 | phis = .true. |
---|
| 1218 | endif |
---|
| 1219 | |
---|
| 1220 | !============================================================================== |
---|
| 1221 | ! 2. Write |
---|
| 1222 | !============================================================================== |
---|
| 1223 | |
---|
| 1224 | !============================================================================== |
---|
[2327] | 1225 | ! 2.1 Hybrid coordinates ap() , bp(), aps() and bps() |
---|
[2317] | 1226 | !============================================================================== |
---|
| 1227 | if(hybrid) then |
---|
| 1228 | ! define aps |
---|
| 1229 | ! Switch to netcdf define mode |
---|
| 1230 | ierr=nf90_redef(outfid) |
---|
| 1231 | ! Insert the definition of the variable |
---|
| 1232 | ierr=NF90_DEF_VAR(outfid,"aps",nf90_float,(/layerdimout/),tmpvarid) |
---|
| 1233 | if (ierr.ne.nf90_noerr) then |
---|
| 1234 | stop "init2 Error: Failed to define the variable aps" |
---|
| 1235 | endif |
---|
| 1236 | ! Write the attributes |
---|
[2327] | 1237 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","hybrid pressure at midlayers") |
---|
[2317] | 1238 | ierr=nf90_put_att(outfid,tmpvarid,"units"," ") |
---|
| 1239 | ! End netcdf define mode |
---|
| 1240 | ierr=nf90_enddef(outfid) |
---|
| 1241 | |
---|
| 1242 | ! write aps |
---|
| 1243 | ierr=NF90_PUT_VAR(outfid,tmpvarid,aps) |
---|
| 1244 | if (ierr.ne.nf90_noerr) then |
---|
| 1245 | stop "init2 Error: Failed to write aps" |
---|
| 1246 | endif |
---|
| 1247 | |
---|
| 1248 | ! define bps |
---|
| 1249 | ! Switch to netcdf define mode |
---|
| 1250 | ierr=nf90_redef(outfid) |
---|
| 1251 | ! Insert the definition of the variable |
---|
| 1252 | ierr=NF90_DEF_VAR(outfid,"bps",nf90_float,(/layerdimout/),tmpvarid) |
---|
| 1253 | if (ierr.ne.nf90_noerr) then |
---|
| 1254 | stop "init2 Error: Failed to define the variable bps" |
---|
| 1255 | endif |
---|
| 1256 | ! Write the attributes |
---|
[2327] | 1257 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","hybrid sigma at midlayers") |
---|
[2317] | 1258 | ierr=nf90_put_att(outfid,tmpvarid,"units"," ") |
---|
| 1259 | ! End netcdf define mode |
---|
| 1260 | ierr=nf90_enddef(outfid) |
---|
| 1261 | |
---|
| 1262 | ! write bps |
---|
| 1263 | ierr=NF90_PUT_VAR(outfid,tmpvarid,bps) |
---|
| 1264 | if (ierr.ne.nf90_noerr) then |
---|
| 1265 | stop "init2 Error: Failed to write bps" |
---|
| 1266 | endif |
---|
| 1267 | |
---|
| 1268 | if (apbp) then |
---|
| 1269 | ! define ap |
---|
| 1270 | |
---|
| 1271 | ! Switch to netcdf define mode |
---|
| 1272 | ierr=nf90_redef(outfid) |
---|
| 1273 | ! Insert the definition of the variable |
---|
| 1274 | ierr=NF90_DEF_VAR(outfid,"ap",nf90_float,(/interlayerdimout/),tmpvarid) |
---|
| 1275 | if (ierr.ne.nf90_noerr) then |
---|
| 1276 | stop "init2 Error: Failed to define the variable ap" |
---|
| 1277 | endif |
---|
| 1278 | ! Write the attributes |
---|
[2327] | 1279 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","hybrid sigma at interlayers") |
---|
[2317] | 1280 | ierr=nf90_put_att(outfid,tmpvarid,"units"," ") |
---|
| 1281 | ! End netcdf define mode |
---|
| 1282 | ierr=nf90_enddef(outfid) |
---|
| 1283 | |
---|
| 1284 | ! write ap |
---|
| 1285 | ierr=NF90_PUT_VAR(outfid,tmpvarid,ap) |
---|
| 1286 | if (ierr.ne.nf90_noerr) then |
---|
| 1287 | stop "Error: Failed to write ap" |
---|
| 1288 | endif |
---|
| 1289 | |
---|
| 1290 | ! define bp |
---|
| 1291 | |
---|
| 1292 | ! Switch to netcdf define mode |
---|
| 1293 | ierr=nf90_redef(outfid) |
---|
| 1294 | ! Insert the definition of the variable |
---|
| 1295 | ierr=NF90_DEF_VAR(outfid,"bp",nf90_float,(/interlayerdimout/),tmpvarid) |
---|
| 1296 | if (ierr.ne.nf90_noerr) then |
---|
| 1297 | stop "init2 Error: Failed to define the variable bp" |
---|
| 1298 | endif |
---|
| 1299 | ! Write the attributes |
---|
[2327] | 1300 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","hybrid sigma at interlayers") |
---|
[2317] | 1301 | ierr=nf90_put_att(outfid,tmpvarid,"units"," ") |
---|
| 1302 | ! End netcdf define mode |
---|
| 1303 | ierr=nf90_enddef(outfid) |
---|
| 1304 | |
---|
| 1305 | ! write bp |
---|
| 1306 | ierr=NF90_PUT_VAR(outfid,tmpvarid,bp) |
---|
| 1307 | if (ierr.ne.nf90_noerr) then |
---|
| 1308 | stop "Error: Failed to write bp" |
---|
| 1309 | endif |
---|
| 1310 | endif ! of if (apbp) |
---|
| 1311 | |
---|
| 1312 | else |
---|
| 1313 | |
---|
| 1314 | ! Switch to netcdf define mode |
---|
| 1315 | ierr=nf90_redef(outfid) |
---|
| 1316 | ! Insert the definition of the variable |
---|
| 1317 | ierr=NF90_DEF_VAR(outfid,"sigma",nf90_float,(/layerdimout/),tmpvarid) |
---|
| 1318 | if (ierr.ne.nf90_noerr) then |
---|
| 1319 | stop "init2 Error: Failed to define the variable sigma" |
---|
| 1320 | endif |
---|
| 1321 | ! Write the attributes |
---|
[2327] | 1322 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","sigma at midlayers") |
---|
[2317] | 1323 | ierr=nf90_put_att(outfid,tmpvarid,"units"," ") |
---|
| 1324 | ! End netcdf define mode |
---|
| 1325 | ierr=nf90_enddef(outfid) |
---|
| 1326 | |
---|
| 1327 | ! write sigma |
---|
| 1328 | ierr=NF90_PUT_VAR(outfid,tmpvarid,sigma) |
---|
| 1329 | if (ierr.ne.nf90_noerr) then |
---|
| 1330 | stop "init2 Error: Failed to write sigma" |
---|
| 1331 | endif |
---|
| 1332 | endif ! of if (hybrid) |
---|
| 1333 | |
---|
| 1334 | !============================================================================== |
---|
[2327] | 1335 | ! 2.2 aire() and phisinit() |
---|
[2317] | 1336 | !============================================================================== |
---|
| 1337 | |
---|
| 1338 | if (area) then |
---|
| 1339 | |
---|
| 1340 | ! Switch to netcdf define mode |
---|
| 1341 | ierr=nf90_redef(outfid) |
---|
| 1342 | ! Insert the definition of the variable |
---|
| 1343 | ierr=NF90_DEF_VAR(outfid,"aire",nf90_float,(/londimout,latdimout/),tmpvarid) |
---|
| 1344 | if (ierr.ne.nf90_noerr) then |
---|
| 1345 | stop "init2 Error: Failed to define the variable aire" |
---|
| 1346 | endif |
---|
| 1347 | ! Write the attributes |
---|
[2327] | 1348 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","Mesh area") |
---|
[2317] | 1349 | ierr=nf90_put_att(outfid,tmpvarid,"units","m2") |
---|
| 1350 | ! End netcdf define mode |
---|
| 1351 | ierr=nf90_enddef(outfid) |
---|
| 1352 | |
---|
| 1353 | ! write aire |
---|
| 1354 | ierr=NF90_PUT_VAR(outfid,tmpvarid,aire) |
---|
| 1355 | if (ierr.ne.nf90_noerr) then |
---|
| 1356 | stop "init2 Error: Failed to write aire" |
---|
| 1357 | endif |
---|
| 1358 | endif ! of if (area) |
---|
| 1359 | |
---|
[2327] | 1360 | if (phis) then |
---|
[2317] | 1361 | |
---|
| 1362 | ! Switch to netcdf define mode |
---|
| 1363 | ierr=nf90_redef(outfid) |
---|
| 1364 | ! Insert the definition of the variable |
---|
| 1365 | ierr=NF90_DEF_VAR(outfid,"phisinit",nf90_float,(/londimout,latdimout/),tmpvarid) |
---|
| 1366 | if (ierr.ne.nf90_noerr) then |
---|
| 1367 | stop "init2 Error: Failed to define the variable phisinit" |
---|
| 1368 | endif |
---|
| 1369 | ! Write the attributes |
---|
[2327] | 1370 | ierr=nf90_put_att(outfid,tmpvarid,"long_name","Ground level geopotential") |
---|
[2317] | 1371 | ierr=nf90_put_att(outfid,tmpvarid,"units"," ") |
---|
| 1372 | ! End netcdf define mode |
---|
| 1373 | ierr=nf90_enddef(outfid) |
---|
| 1374 | |
---|
| 1375 | ! write phisinit |
---|
| 1376 | ierr=NF90_PUT_VAR(outfid,tmpvarid,phisinit) |
---|
| 1377 | if (ierr.ne.nf90_noerr) then |
---|
| 1378 | stop "init2 Error: Failed to write phisinit" |
---|
| 1379 | endif |
---|
| 1380 | |
---|
[2327] | 1381 | endif ! of if (phis) |
---|
[2317] | 1382 | |
---|
| 1383 | |
---|
| 1384 | ! Cleanup |
---|
| 1385 | if (allocated(aps)) deallocate(aps) |
---|
| 1386 | if (allocated(bps)) deallocate(bps) |
---|
| 1387 | if (allocated(ap)) deallocate(ap) |
---|
| 1388 | if (allocated(bp)) deallocate(bp) |
---|
| 1389 | if (allocated(sigma)) deallocate(sigma) |
---|
| 1390 | if (allocated(phisinit)) deallocate(phisinit) |
---|
| 1391 | if (allocated(aire)) deallocate(aire) |
---|
| 1392 | |
---|
| 1393 | end subroutine init2 |
---|