program aeroptical ! program for computation of aerosol opacities ! author : Antoine Bierjon, April 2020 ! !=============================================================================== ! PREFACE !=============================================================================== ! This program takes in input a GCM output file (diagfi,stats,concat) that ! contains: ! - the Mass Mixing Ratios of dust (dustq) and water ice (h2o_ice) ! - their effective radius (reffdust, reffice(*)) ! - the atmospheric density (rho) ! as well as the 2 boundaries of a wavelength interval and the directory ! containing the ASCII files of the optical properties of the aerosols. ! ! It outputs a netcdf file containing the opacities [1/km] of the dust and ! water ice aerosols as well as the combined opacity of the 2 aerosols, ! averaged within the prescribed wavelength interval. ! ! ! (*) 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 must 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 :: tmpvarid ! temporary store a variable ID number 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 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) 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 ! temporary stores a variable ID number real :: wvl_val ! reference wavelength of the output opacities (given by the user) [m] integer :: varshape(4) ! stores a variable shape (of dimensions' IDs) character(len=16) :: tmpvarname ! temporary stores a variable name real,dimension(:,:,:,:,:),allocatable :: opa_aer ! Opacity of the aerosols [1/km] real :: missval ! Value to put in outfile when the reff is out of bounds PARAMETER(missval=1E+20) ! 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 ! 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 [/] ! Opacity computation integer :: iwvl1,iwvl2,isize1,isize2 ! Wavelength and Particle size indices for the interpolation real :: coeff ! Interpolation coeficient real,dimension(2) :: reffQext ! Qext after reff interpolation real :: Qext_val ! Qext 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 !=============================================================================== ! 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 outfile=gcmfile(1:index(gcmfile, ".nc")-1)//"_OPA.nc" ierr=NF90_CREATE(outfile,nf90_clobber,outfid) ! NB: clobber mode=overwrite any dataset with the same file name ! 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 file variables !========================================================================== ! Number of aerosols naerkind = 2 ! dust & water ice ! + NEW AER? ! Length allocation of the variables allocate(mmr(naerkind,lonlen,latlen,altlen,timelen)) allocate(reff(naerkind,lonlen,latlen,altlen,timelen)) ! 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",tmpvarid) 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. else ! Load datasets ierr=NF90_GET_VAR(gcmfid,tmpvarid,mmr(1,:,:,:,:)) error_text="Failed to load dust mass mixing ratio" call status_check(ierr,error_text) write(*,*) "Dust mass mixing ratio loaded from "//trim(gcmfile) endif ! DUST EFFECTIVE RADIUS if (aerok(1)) then ! Check that the GCM file contains that variable ierr=nf90_inq_varid(gcmfid,"reffdust",tmpvarid) 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. else ! Load datasets ierr=NF90_GET_VAR(gcmfid,tmpvarid,reff(1,:,:,:,:)) error_text="Failed to load dust effective radius" call status_check(ierr,error_text) write(*,*) "Dust effective radius loaded from "//trim(gcmfile) 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",tmpvarid) 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. else ! Load datasets ierr=NF90_GET_VAR(gcmfid,tmpvarid,mmr(2,:,:,:,:)) error_text="Failed to load water ice mass mixing ratio" call status_check(ierr,error_text) write(*,*) "Water ice mass mixing ratio loaded from "//trim(gcmfile) 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",tmpvarid) 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. else ! Load datasets ierr=NF90_GET_VAR(gcmfid,tmpvarid,reff(2,:,:,1,:)) ! reffice is actually a GCM ! surface (column-averaged) variable error_text="Failed to load water ice effective radius" call status_check(ierr,error_text) do ialt=2,altlen reff(2,:,:,ialt,:) = reff(2,:,:,1,:) ! build up along altitude axis enddo write(*,*) "Water ice effective radius loaded from "//trim(gcmfile) endif ELSE ! if reffwice_val/=0 reff(2,:,:,:,:) = reffwice_val write(*,*) "Water ice effective radius loaded from the user input" ENDIF endif ! Check if there is still at least one aerosol to compute IF (.NOT.ANY(aerok)) THEN write(*,*) "Neither dust nor water ice are found in the file. Better stop now..." stop ENDIF !========================================================================== ! --> 1.2.3 + NEW AER? !========================================================================== ! --> 1.2.3 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 datasets ierr=nf90_get_var(gcmfid,tmpvarid,rho) error_text="Failed to load atmospheric density" call status_check(ierr,error_text) write(*,*) "Loaded atmospheric density rho from "//trim(gcmfile) !========================================================================== ! 1.3 Some output variable's initializations !========================================================================== ! 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 ! + NEW AER? allocate(opa_aer(naerkind,lonlen,latlen,altlen,timelen)) !=============================================================================== ! 2. OPTICAL PROPERTIES !=============================================================================== DO iaer = 1, naerkind ! Loop on aerosol kind if (aerok(iaer)) then ! check if this aerosol can be computed !========================================================================== ! 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" ! + 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" ! + 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 !========================================================================== ! 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 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)