program aeroptical ! program for computation of aerosol opacities ! author : Antoine Bierjon, April-May 2020 ! !=============================================================================== ! PREFACE !=============================================================================== ! This program takes as inputs a GCM output file (diagfi,stats,concat) that ! contains: ! - the Mass Mixing Ratios of dust (dustq), water ice (h2o_ice), ! stormdust (rdsdustq) & topdust (topdustq) ! - their effective radius (reffdust, reffice(*), ! reffstormdust, refftopdust) ! - the atmospheric density (rho) ! as well as a wavelength to calibrate the opacities, and the directory ! containing the ASCII files of the aerosols' optical properties. ! ! It outputs a netcdf file containing the opacities [1/km] of the dust, ! water ice and stormdust aerosols calibrated at the prescribed wavelength. ! The type of opacity (extinction or absorption) is given by the user. ! ! (*) due to a high uncertainty of reffice in the GCM, the value is asked ! directly to the user (if the user returns 0, then the program reads the GCM ! file to get reffice) ! ! NOTA BENE: ! 1) if one wanted to add another aerosol to compute, one should look for ! the comments + NEW AER? that are disseminated all along the code to indicate ! the parts of the code that should be modified. ! 2) another enhancement of this program could be the possibility to read its ! own product files and recalibrate the opacities at another wavelength !=============================================================================== use netcdf !=============================================================================== ! Variable declarations !=============================================================================== implicit none ! for no implicitly typed variables ! GCM file character(len=128) :: gcmfile ! name of the netcdf GCM input file integer :: gcmfid ! [netcdf] GCM input file ID number integer :: ierr ! [netcdf] subroutine returned error code character(len=256) :: error_text ! text to display in case of error integer :: lonlen,latlen,altlen,timelen ! nb of grid points along longitude,latitude,altitude,time integer :: GCM_layers ! number of GCM layers integer :: layerdimout,interlayerdimout ! "GCM_layers" and "GCM_layers+1" IDs logical,dimension(:),allocatable :: aerok ! to know if the needed fields are in the GCM file integer,dimension(:),allocatable :: mmrvarid ! stores a MMR variable ID number integer,dimension(:),allocatable :: reffvarid ! stores a reff variable ID number integer :: tmpvarid ! temporarily stores a variable ID number real,dimension(:,:,:,:),allocatable :: mmr ! aerosols mass mixing ratios [kg/kg] real,dimension(:,:,:,:),allocatable :: reff ! aerosols effective radii [m] real :: reffwice_val ! value given by the user for reffwice (0 if read in the GCM file) [m] real,dimension(:,:,:,:),allocatable :: rho ! atmospheric density [kg.m-3] integer :: naerkind ! nb of aerosols to consider integer :: iaer ! aerosol kind index (1=dust,2=water ice,3=stormdust,4=topdust) ! + NEW AER? integer :: ilon,ilat,ialt,it ! Loop indices for coordinates ! Output file character(len=128) :: outfile ! name of the netcdf output file integer :: outfid ! [netcdf] file ID number integer :: latdimout,londimout,altdimout,timedimout ! latdimout: stores latitude dimension ID number ! londimout: stores longitude dimension ID number ! altdimout: stores altitude dimension ID number ! timedimout: stores time dimension ID number integer :: tmpvaridout ! temporarily stores a variable ID number real :: wvl_val ! reference wavelength of the output opacities (given by the user) [m] character(len=3) :: opatype ! opacity type : extinction (ext) or absorption (abs) (given by the user) integer :: varshape(4) ! stores a variable shape (of dimensions' IDs) character(len=16) :: tmpvarname ! temporarily stores a variable name real,dimension(:,:,:,:),allocatable :: opa_aer ! Aerosols opacities [1/km] real,dimension(:),allocatable :: missval ! Value to put in outfile when the reff is out of bounds ! or when there is a mising value in input file ! Optical properties (read in external ASCII files) character(len=256) :: datadir ! directory containing the ASCII files character(len=128) :: optpropfile ! name of the ASCII optical properties file logical :: file_ok ! to know if the file can be opened integer :: file_unit = 60 ! ASCII file ID integer :: jfile ! ASCII file scan index logical :: endwhile ! Reading loop boolean character(len=132) :: scanline ! ASCII file scanning line integer :: read_ok ! to know if the line is well read integer :: nwvl ! Number of wavelengths in the domain (VIS or IR) integer :: nsize ! Number of particle sizes stored in the file integer :: iwvl,isize ! Wavelength and Particle size loop indices real,dimension(:),allocatable :: wvl ! Wavelength axis [m] real,dimension(:),allocatable :: radiusdyn ! Particle size axis [m] real,dimension(:,:),allocatable :: Qext ! Extinction efficiency coefficient [/] real,dimension(:,:),allocatable :: omeg ! Single scattering albedo [/] ! Opacity computation integer :: iwvl1,iwvl2,isize1,isize2 ! Wavelength and Particle size indices for the interpolation real :: coeff ! Interpolation coefficient real,dimension(2) :: reffQext ! Qext after reff interpolation real :: Qext_val ! Qext after both interpolations real,dimension(2) :: reffomeg ! omeg after reff interpolation real :: omeg_val ! omeg after both interpolations real,dimension(:),allocatable :: rho_aer ! Density of the aerosols [kg.m-3] !=============================================================================== ! 0. USER INPUTS !=============================================================================== write(*,*) "Welcome in the aerosol opacities' computation program !" write(*,*) ! Ask the GCM file name WRITE(*,*) "Enter an input file name (GCM diagfi/stats/concat) :" READ(*,*) gcmfile ! Ask the reffwice to the user write(*,*)"" write(*,*) "The water ice effective radius computed by the GCM is known to be a bit inaccurate." write(*,*) "Which value do you want to use for it (in meters) ?" write(*,*) "(put 0 if you still want the program to read the value in "//trim(gcmfile)//")" READ(*,*) reffwice_val ! Ask the wavelength to the user write(*,*)"" WRITE(*,*) "Value of the reference wavelength for the opacities' computation (in meters) ?" READ(*,*) wvl_val ! Ask the directory containing the optical properties files write(*,*)"" WRITE(*,*) "In which directory should we look for the optical properties' files ?" READ(*,'(a)') datadir ! Ask the type of opacity that has to be computed write(*,*)"" WRITE(*,*) "Do you want to compute extinction or absorption opacities ? (ext/abs)" READ(*,*) opatype if ((trim(opatype).ne."ext").and.(trim(opatype).ne."abs")) then write(*,*) "opatype = "//opatype write(*,*) "Error: the opacity type must be ext or abs" stop endif !=============================================================================== ! 1. GCM FILE & OUTPUT FILE INITIALIZATIONS !=============================================================================== !========================================================================== ! 1.1 GCM file opening & dimensions - Output file initializations !========================================================================== !========================================================================== ! --> 1.1.1 Open the netcdf GCM file given by the user ierr=nf90_open(gcmfile,nf90_nowrite,gcmfid) ! nowrite mode=the program can only read the opened file error_text="Error: could not open file "//trim(gcmfile) call status_check(ierr,error_text) !========================================================================== ! --> 1.1.2 Creation of the outfile if (opatype.eq."ext") then outfile=gcmfile(1:index(gcmfile, ".nc")-1)//"_OPAext.nc" else ! opatype.eq."abs" outfile=gcmfile(1:index(gcmfile, ".nc")-1)//"_OPAabs.nc" endif ierr=NF90_CREATE(outfile,IOR(nf90_clobber,nf90_64bit_offset),outfid) ! NB: clobber mode=overwrite any dataset with the same file name ! ! 64bit_offset enables the creation of large netcdf files with variables>2GB error_text="Error: could not create file "//trim(outfile) call status_check(ierr,error_text) write(*,*)"";WRITE(*,*)"Output file is: ",trim(outfile);write(*,*)"" !========================================================================== ! --> 1.1.3 Get the dimensions and create them in the output file ! Initialize output file's lat,lon,alt,time and controle dimensions call inidims(gcmfile,gcmfid,outfile,outfid,& lonlen,latlen,altlen,timelen,& latdimout,londimout,altdimout,timedimout,& GCM_layers,layerdimout,interlayerdimout) ! Initialize output file's aps,bps,ap,bp and phisinit variables call init2(gcmfid,lonlen,latlen,altlen,GCM_layers,& outfid,londimout,latdimout,altdimout,& layerdimout,interlayerdimout) !========================================================================== ! 1.2 GCM aerosols !========================================================================== ! Number of aerosols naerkind = 4 ! dust, water ice, stormdust, topdust ! + NEW AER? ! Variables length allocation allocate(mmrvarid(naerkind)) allocate(reffvarid(naerkind)) ! Initialize missing value allocate(missval(naerkind)) missval(:)=1.e+20 ! Initialize aerok to .true. for all aerosols allocate(aerok(naerkind)) aerok(:)=.true. !========================================================================== ! --> 1.2.1 DUST ! DUST MASS MIXING RATIO ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"dustq",mmrvarid(1)) error_text="Failed to find variable dustq in "//trim(gcmfile)& //" We'll skip the dust aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(1)=.false. endif ! DUST EFFECTIVE RADIUS if (aerok(1)) then ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"reffdust",reffvarid(1)) error_text="Failed to find variable reffdust in "//trim(gcmfile)& //" We'll skip the dust aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(1)=.false. endif endif !========================================================================== ! --> 1.2.2 WATER ICE ! WATER ICE MASS MIXING RATIO ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"h2o_ice",mmrvarid(2)) error_text="Failed to find variable h2o_ice in "//trim(gcmfile)& //" We'll skip the water ice aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(2)=.false. endif ! WATER ICE EFFECTIVE RADIUS if (aerok(2)) then IF (reffwice_val.eq.0) THEN ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"reffice",reffvarid(2)) error_text="Failed to find variable reffice in "//trim(gcmfile)& //" We'll skip the water ice aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(2)=.false. endif ENDIF endif !========================================================================== ! --> 1.2.3 STORMDUST ! STORMDUST MASS MIXING RATIO ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"rdsdustq",mmrvarid(3)) error_text="Failed to find variable rdsdustq in "//trim(gcmfile)& //" We'll skip the stormdust aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(3)=.false. endif ! STORMDUST EFFECTIVE RADIUS if (aerok(3)) then ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"reffstormdust",reffvarid(3)) error_text="Failed to find variable reffstormdust in "//trim(gcmfile)& //" We'll skip the stormdust aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(3)=.false. endif endif !========================================================================== ! --> 1.2.4 TOPDUST ! TOPDUST MASS MIXING RATIO ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"topdustq",mmrvarid(4)) error_text="Failed to find variable topdustq in "//trim(gcmfile)& //" We'll skip the topdust aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(4)=.false. endif ! TOPDUST EFFECTIVE RADIUS if (aerok(4)) then ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"refftopdust",reffvarid(4)) error_text="Failed to find variable refftopdust in "//trim(gcmfile)& //" We'll skip the topdust aerosol." if (ierr.ne.nf90_noerr) then write(*,*)trim(error_text) aerok(4)=.false. endif endif !========================================================================== ! --> 1.2.5 + NEW AER? ! Check if there is still at least one aerosol to compute IF (.NOT.ANY(aerok)) THEN ! + NEW AER? write(*,*) "No aerosol among [dust/water ice/stormdust/topdust] was found in the file. Better stop now..." stop ENDIF !========================================================================== ! 1.3 GCM ATMOSPHERIC DENSITY !========================================================================== ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"rho",tmpvarid) error_text="Failed to find variable rho in "//trim(gcmfile)& //" We need it to compute the opacity [1/km]." call status_check(ierr,error_text) ! Length allocation for each dimension of the 4D variable allocate(rho(lonlen,latlen,altlen,timelen)) ! Load dataset ierr=nf90_get_var(gcmfid,tmpvarid,rho) error_text="Failed to load atmospheric density" call status_check(ierr,error_text) write(*,*) "Atmospheric density rho loaded from "//trim(gcmfile) !========================================================================== ! 1.4 Output variable's initializations and datasets loading !========================================================================== ! Define the ID shape of the output variables varshape(1)=londimout varshape(2)=latdimout varshape(3)=altdimout varshape(4)=timedimout ! Fill the aerosol density array allocate(rho_aer(naerkind)) rho_aer(1)=2500. ! dust rho_aer(2)=920. ! water ice rho_aer(3)=2500. ! stormdust rho_aer(4)=2500. ! topdust ! + NEW AER? DO iaer = 1, naerkind ! Loop on aerosol kind if (aerok(iaer)) then ! check if this aerosol can be computed write(*,*)"" SELECT CASE(iaer) CASE(1) ! DUST write(*,*)"Computing dust opacity..." CASE(2) ! WATER ICE write(*,*)"Computing water ice opacity..." CASE(3) ! STORMDUST write(*,*)"Computing stormdust opacity..." CASE(4) ! TOPDUST write(*,*)"Computing topdust opacity..." ! + NEW AER? END SELECT ! iaer ! Length allocation of the input variables ALLOCATE(mmr(lonlen,latlen,altlen,timelen)) ALLOCATE(reff(lonlen,latlen,altlen,timelen)) ! Datasets loading ! MMR ierr=NF90_GET_VAR(gcmfid,mmrvarid(iaer),mmr(:,:,:,:)) error_text="Failed to load mass mixing ratio" call status_check(ierr,error_text) write(*,*) "Mass mixing ratio loaded from "//trim(gcmfile) ! Get missing value ierr=nf90_get_att(gcmfid,mmrvarid(1),"missing_value",missval(1)) if (ierr.ne.nf90_noerr) then missval(1) = 1.e+20 endif ! REFF if (iaer.ne.2) then ! Load dataset ierr=NF90_GET_VAR(gcmfid,reffvarid(iaer),reff(:,:,:,:)) error_text="Failed to load effective radius" call status_check(ierr,error_text) write(*,*) "Effective radius loaded from "//trim(gcmfile) else ! water ice special case IF (reffwice_val.eq.0) THEN ! Load dataset ierr=NF90_GET_VAR(gcmfid,reffvarid(iaer),reff(:,:,1,:)) ! reffice is actually a GCM ! surface (column-averaged) variable error_text="Failed to load effective radius" call status_check(ierr,error_text) do ialt=2,altlen reff(:,:,ialt,:) = reff(:,:,1,:) ! build up along altitude axis enddo write(*,*) "Effective radius loaded from "//trim(gcmfile) ELSE ! if reffwice_val/=0 reff(:,:,:,:) = reffwice_val write(*,*) "Effective radius loaded from the user input" ENDIF endif ! iaer.ne.2 ! Length allocation of the output variable ALLOCATE(opa_aer(lonlen,latlen,altlen,timelen)) !=============================================================================== ! 2. OPTICAL PROPERTIES !=============================================================================== !========================================================================== ! 2.1 Open the ASCII file !========================================================================== IF (wvl_val.lt.5.e-6) THEN ! "VISIBLE" DOMAIN SELECT CASE(iaer) CASE(1) ! DUST ! Dust file optpropfile = "optprop_dustvis_TM_n50.dat" CASE(2) ! WATER ICE ! Water ice file optpropfile = "optprop_icevis_n30.dat" CASE(3) ! STORMDUST ! Dust file optpropfile = "optprop_dustvis_TM_n50.dat" CASE(4) ! TOPDUST ! Dust file optpropfile = "optprop_dustvis_TM_n50.dat" ! + NEW AER? END SELECT ! iaer ELSE ! wvl_val.ge.5.e-6 ! "INFRARED" DOMAIN SELECT CASE(iaer) CASE(1) ! DUST ! Dust file optpropfile = "optprop_dustir_n50.dat" CASE(2) ! WATER ICE ! Water ice file optpropfile = "optprop_iceir_n30.dat" CASE(3) ! STORMDUST ! Dust file optpropfile = "optprop_dustir_n50.dat" CASE(4) ! TOPDUST ! Dust file optpropfile = "optprop_dustir_n50.dat" ! + NEW AER? END SELECT ! iaer ENDIF ! wvl_val INQUIRE(FILE=trim(datadir)//'/'//trim(optpropfile),EXIST=file_ok) if(.not.file_ok) then write(*,*)'Problem opening ',trim(optpropfile) write(*,*)'It should be in: ',trim(datadir) stop endif OPEN(UNIT=file_unit,FILE=trim(datadir)//'/'//trim(optpropfile),FORM='formatted') !========================================================================== ! 2.2 Allocate the optical property table !========================================================================== jfile = 1 endwhile = .false. DO WHILE (.NOT.endwhile) READ(file_unit,*,iostat=read_ok) scanline if (read_ok.ne.0) then write(*,*)'Error reading file ',& trim(datadir)//'/'//trim(optpropfile) stop endif IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN BACKSPACE(file_unit) reading1_seq: SELECT CASE (jfile) ! FIRST READING SEQUENCE CASE(1) reading1_seq ! nwvl ---------------------------- read(file_unit,*,iostat=read_ok) nwvl if (read_ok.ne.0) then write(*,*)'reading1_seq: Error while reading line: ',& trim(scanline) write(*,*)' of file ',& trim(datadir)//'/'//trim(optpropfile) stop endif jfile = jfile+1 CASE(2) reading1_seq ! nsize --------------------------- read(file_unit,*,iostat=read_ok) nsize if (read_ok.ne.0) then write(*,*)'reading1_seq: Error while reading line: ',& trim(scanline) write(*,*)' of file ',& trim(datadir)//'/'//trim(optpropfile) stop endif endwhile = .true. CASE DEFAULT reading1_seq ! default -------------------- write(*,*) 'reading1_seq: ',& 'Error while loading optical properties.' stop END SELECT reading1_seq ! ============================== ENDIF ENDDO ! DO WHILE(.NOT.endwhile) ALLOCATE(wvl(nwvl)) ! Wavelength axis ALLOCATE(radiusdyn(nsize)) ! Aerosol radius axis ALLOCATE(Qext(nwvl,nsize)) ! Extinction efficiency coeff ALLOCATE(omeg(nwvl,nsize)) ! Single scattering albedo !========================================================================== ! 2.3 Read the data !========================================================================== jfile = 1 endwhile = .false. DO WHILE (.NOT.endwhile) READ(file_unit,*) scanline IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN BACKSPACE(file_unit) reading2_seq: SELECT CASE (jfile) ! SECOND READING SEQUENCE CASE(1) reading2_seq ! wvl ----------------------------- read(file_unit,*,iostat=read_ok) wvl if (read_ok.ne.0) then write(*,*)'reading2_seq: Error while reading line: ',& trim(scanline) write(*,*)' of file ',& trim(datadir)//'/'//trim(optpropfile) stop endif jfile = jfile+1 CASE(2) reading2_seq ! radiusdyn ----------------------- read(file_unit,*,iostat=read_ok) radiusdyn if (read_ok.ne.0) then write(*,*)'reading2_seq: Error while reading line: ',& trim(scanline) write(*,*)' of file ',& trim(datadir)//'/'//trim(optpropfile) stop endif jfile = jfile+1 CASE(3) reading2_seq ! Qext ---------------------------- isize = 1 DO WHILE (isize .le. nsize) READ(file_unit,*,iostat=read_ok) scanline if (read_ok.ne.0) then write(*,*)'reading2_seq: Error while reading line: ',& trim(scanline) write(*,*)' of file ',& trim(datadir)//'/'//trim(optpropfile) stop endif IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN BACKSPACE(file_unit) read(file_unit,*) Qext(:,isize) isize = isize + 1 ENDIF ENDDO jfile = jfile+1 CASE(4) reading2_seq ! omeg ---------------------------- isize = 1 DO WHILE (isize .le. nsize) READ(file_unit,*,iostat=read_ok) scanline if (read_ok.ne.0) then write(*,*)'reading2_seq: Error while reading line: ',& trim(scanline) write(*,*)' of file ',& trim(datadir)//'/'//trim(optpropfile) stop endif IF ((scanline(1:1).ne.'#').and.(scanline(1:1).ne.' ')) THEN BACKSPACE(file_unit) read(file_unit,*) omeg(:,isize) isize = isize + 1 ENDIF ENDDO endwhile = .true. CASE DEFAULT reading2_seq ! default -------------------- write(*,*) 'reading2_seq: ',& 'Error while loading optical properties.' stop END SELECT reading2_seq ! ============================== ENDIF ENDDO ! Close the file CLOSE(file_unit) write(*,*)"" write(*,*) "Wavelength array loaded from file ",trim(datadir)//'/'//trim(optpropfile) write(*,*) "ranging from ",wvl(1)," to ",wvl(nwvl)," meters" write(*,*) "Effective radius array loaded from file ",trim(datadir)//'/'//trim(optpropfile) write(*,*) "ranging from ",radiusdyn(1)," to ",radiusdyn(nsize)," meters" ! + NEW AER? : one may adapt this part to handle the properties' file of the new aerosol !========================================================================== ! 2.4 Get the optpropfile wavelength values encompassing the ref wavelength !========================================================================== iwvl=1 DO WHILE ((iwvl.le.nwvl).and.(wvl(iwvl).lt.wvl_val)) iwvl=iwvl+1 ENDDO if ((iwvl.gt.nwvl).or.(wvl(1).gt.wvl_val)) then write(*,*) "ERROR: the reference wavelength is out of the bounds" write(*,*) "of the file ",trim(datadir)//'/'//trim(optpropfile) write(*,*) "(wvl_inf=",wvl(1),"m ; wvl_sup=",wvl(nwvl),"m)" write(*,*) "Ensure you wrote it well (in meters)," write(*,*) "or supply a new optical properties' file (change in aeroptical.F90 directly)" stop endif if (wvl(iwvl).eq.wvl_val) then ! if the ref wavelength is in the optpropfile iwvl1 = iwvl iwvl2 = iwvl else ! wvl(iwvl)>wvl_val and wvl(iwvl-1)reff and radiusdyn(isize-1)