source: trunk/LMDZ.MARS/util/aeroptical.F90 @ 2395

Last change on this file since 2395 was 2327, checked in by abierjon, 5 years ago

Mars GCM:
Some improvements in aeroptical.F90 :
1) add the possibility to input a diagfi_P.nc file (with pressure as altitude coordinates) ;
2) replace all "title" attributes into "long_name" attributes in accordance with ticket #48

AB

File size: 52.0 KB
RevLine 
[2317]1program 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
33use netcdf
34
35!===============================================================================
36! Variable declarations
37!===============================================================================
38
39implicit none ! for no implicitly typed variables
40
41
42! GCM file
43character(len=128) :: gcmfile                 ! name of the netcdf GCM input file
44integer :: gcmfid                             ! [netcdf] GCM input file ID number
45integer :: ierr                               ! [netcdf] subroutine returned error code
46character(len=256) :: error_text              ! text to display in case of error
[2318]47integer :: tmpvarid                           ! temporarily stores a variable ID number
[2317]48integer :: lonlen,latlen,altlen,timelen       ! nb of grid points along longitude,latitude,altitude,time
49integer :: GCM_layers                         ! number of GCM layers
50integer :: layerdimout,interlayerdimout       ! "GCM_layers" and "GCM_layers+1" IDs
51
52logical,dimension(:),allocatable :: aerok     ! to know if the needed fields are in the GCM file
53real,dimension(:,:,:,:,:),allocatable :: mmr  ! aerosols mass mixing ratios [kg/kg]
54real,dimension(:,:,:,:,:),allocatable :: reff ! aerosols effective radii [m]
55real :: reffwice_val                          ! value given by the user for reffwice (0 if read in the GCM file) [m]
56real,dimension(:,:,:,:),allocatable :: rho    ! atmospheric density [kg.m-3]
57integer :: naerkind                           ! nb of aerosols to consider
[2318]58integer :: iaer                               ! aerosol kind index (1=dust, 2=water ice) ! + NEW AER?
[2317]59integer :: ilon,ilat,ialt,it                  ! Loop indices for coordinates
60
61
62! Output file
63character(len=128) :: outfile                    ! name of the netcdf output file
64integer :: outfid                                ! [netcdf] file ID number
65integer :: 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]70integer :: tmpvaridout                           ! temporarily stores a variable ID number
[2317]71
72real :: wvl_val                                  ! reference wavelength of the output opacities (given by the user) [m]
73integer :: varshape(4)                           ! stores a variable shape (of dimensions' IDs)
[2318]74character(len=16) :: tmpvarname                  ! temporarily stores a variable name
75real,dimension(:,:,:,:,:),allocatable :: opa_aer ! Aerosols opacities [1/km]
[2327]76real,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)
81character(len=256) :: datadir              ! directory containing the ASCII files
82character(len=128) :: optpropfile          ! name of the ASCII optical properties file
83logical :: file_ok                         ! to know if the file can be opened
84integer :: file_unit = 60                  !
85
86integer :: jfile                           ! ASCII file scan index
87logical :: endwhile                        ! Reading loop boolean
88character(len=132) :: scanline             ! ASCII file scanning line
89integer :: read_ok                         ! to know if the line is well read
90                   
91integer :: nwvl                            ! Number of wavelengths in the domain (VIS or IR)
92integer :: nsize                           ! Number of particle sizes stored in the file
93integer :: iwvl,isize                      ! Wavelength and Particle size loop indices
94real,dimension(:),allocatable :: wvl       ! Wavelength axis [m]
95real,dimension(:),allocatable :: radiusdyn ! Particle size axis [m]
96real,dimension(:,:),allocatable :: Qext    ! Extinction efficiency coefficient [/]
97
98
99! Opacity computation
100integer :: iwvl1,iwvl2,isize1,isize2     ! Wavelength and Particle size indices for the interpolation
[2318]101real :: coeff                            ! Interpolation coefficient
[2317]102real,dimension(2) :: reffQext            ! Qext after reff interpolation
103real :: Qext_val                         ! Qext after both interpolations
104real,dimension(:),allocatable :: rho_aer ! Density of the aerosols [kg.m-3]
105
106!===============================================================================
107! 0. USER INPUTS
108!===============================================================================
109write(*,*) "Welcome in the aerosol opacities' computation program !"
110write(*,*)
111
112! Ask the GCM file name
113WRITE(*,*) "Enter an input file name (GCM diagfi/stats/concat) :"
114READ(*,*) gcmfile
115
116! Ask the reffwice to the user
117write(*,*)""
118write(*,*) "The water ice effective radius computed by the GCM is known to be a bit inaccurate."
119write(*,*) "Which value do you want to use for it (in meters) ?"
120write(*,*) "(put 0 if you still want the program to read the value in "//trim(gcmfile)//")"
121READ(*,*) reffwice_val
122
123! Ask the wavelength to the user
124write(*,*)""
125WRITE(*,*) "Value of the reference wavelength for the opacities' computation (in meters) ?"
126READ(*,*) wvl_val
127
128! Ask the directory containing the optical properties files
129write(*,*)""
130WRITE(*,*) "In which directory should we look for the optical properties' files ?"
131READ(*,'(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
144ierr=nf90_open(gcmfile,nf90_nowrite,gcmfid) ! nowrite mode=the program can only read the opened file
145error_text="Error: could not open file "//trim(gcmfile)
146call status_check(ierr,error_text)
147
148!==========================================================================
149! --> 1.1.2 Creation of the outfile
150outfile=gcmfile(1:index(gcmfile, ".nc")-1)//"_OPA.nc"
151
152ierr=NF90_CREATE(outfile,nf90_clobber,outfid) ! NB: clobber mode=overwrite any dataset with the same file name !
153error_text="Error: could not create file "//trim(outfile)
154call status_check(ierr,error_text)
155write(*,*)"";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
161call 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
167call 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
176naerkind = 2 ! dust & water ice ! + NEW AER?
177
178! Length allocation of the variables
179allocate(mmr(naerkind,lonlen,latlen,altlen,timelen))
180allocate(reff(naerkind,lonlen,latlen,altlen,timelen))
181
[2327]182! Initialize missing value
183allocate(missval(naerkind))
184missval(:)=1.e+20
185
[2317]186! Initialize aerok to .true. for all aerosols
187allocate(aerok(naerkind))
188aerok(:)=.true.
189
190!==========================================================================
191! --> 1.2.1 DUST
192
193! DUST MASS MIXING RATIO
194! Check that the GCM file contains that variable
195ierr=nf90_inq_varid(gcmfid,"dustq",tmpvarid)
196error_text="Failed to find variable dustq in "//trim(gcmfile)&
197            //" We'll skip the dust aerosol."
198if (ierr.ne.nf90_noerr) then
199  write(*,*)trim(error_text)
200  aerok(1)=.false.
201else
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]212endif
213
214! DUST EFFECTIVE RADIUS
215if (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
230endif
231
232!==========================================================================
233! --> 1.2.2 WATER ICE
234
235! WATER ICE MASS MIXING RATIO
236! Check that the GCM file contains that variable
237ierr=nf90_inq_varid(gcmfid,"h2o_ice",tmpvarid)
238error_text="Failed to find variable h2o_ice in "//trim(gcmfile)&
239            //" We'll skip the water ice aerosol."
240if (ierr.ne.nf90_noerr) then
241  write(*,*)trim(error_text)
242  aerok(2)=.false.
243else
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]254endif
255
256! WATER ICE EFFECTIVE RADIUS
257if (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
281endif
282
283! Check if there is still at least one aerosol to compute
284IF (.NOT.ANY(aerok)) THEN
285  write(*,*) "Neither dust nor water ice are found in the file. Better stop now..."
286  stop
287ENDIF
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
296ierr=nf90_inq_varid(gcmfid,"rho",tmpvarid)
297error_text="Failed to find variable rho in "//trim(gcmfile)&
298            //" We need it to compute the opacity [1/km]."
299call status_check(ierr,error_text)
300! Length allocation for each dimension of the 4D variable
301allocate(rho(lonlen,latlen,altlen,timelen))
302! Load datasets
303ierr=nf90_get_var(gcmfid,tmpvarid,rho)
304error_text="Failed to load atmospheric density"
305call status_check(ierr,error_text)
306write(*,*) "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
312varshape(1)=londimout
313varshape(2)=latdimout
314varshape(3)=altdimout
315varshape(4)=timedimout
316
317! Fill the aerosol density array
318allocate(rho_aer(naerkind))
319rho_aer(1)=2500. ! dust
320rho_aer(2)=920.  ! water ice
321! + NEW AER?
322
323allocate(opa_aer(naerkind,lonlen,latlen,altlen,timelen))
324
325
326!===============================================================================
327! 2. OPTICAL PROPERTIES
328!===============================================================================
329
330DO 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)
386reading1_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)
428reading2_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
632ENDDO ! iaer
633
634!===============================================================================
635! 4. Close the files and end the program
636!===============================================================================
637ierr = nf90_close(gcmfid)
638error_text="Error: could not close file "//trim(gcmfile)
639call status_check(ierr,error_text)
640
641ierr = nf90_close(outfid)
642error_text="Error: could not close file "//trim(outfile)
643call status_check(ierr,error_text)
644
645write(*,*)"";write(*,*)"Program aeroptical completed!"
646
647end program aeroptical
648
649!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
650!! SUBROUTINES
651!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
652
653subroutine status_check(ierr,error_text)
654
655use netcdf
656implicit none
657!================================================================
658!  Arguments:
659!================================================================
660integer,intent(in) :: ierr ! NetCDF status number
661character(len=256),intent(in) :: error_text
662
663if (ierr.ne.nf90_noerr) then
664  write(*,*)trim(error_text)
665  write(*,*)trim(nf90_strerror(ierr))
666  stop
667endif
668
669end subroutine status_check
670
671
672!*******************************************************************************
673
674subroutine 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!==============================================================================
686use netcdf
687
688implicit none
689
690!==============================================================================
691! Arguments:
692!==============================================================================
693character(len=128),intent(in) :: gcmfile ! name of the netcdf GCM input file
694integer,intent(in) :: gcmfid ! [netcdf] GCM input file ID number
695character(len=128),intent(in) :: outfile ! name of the netcdf output file
696integer,intent(in) :: outfid ! [netcdf] file ID number
697
698integer,intent(out) ::  lonlen,latlen,altlen,timelen
699! nb of grid points along longitude,latitude,altitude,time
700integer,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
705integer,intent(out) :: GCM_layers ! number of GCM layers
706integer,intent(out) :: layerdimout ! "GCM_layers" ID
707integer,intent(out) :: interlayerdimout ! "GCM_layers+1" ID
708
709!==============================================================================
710! Local variables:
711!==============================================================================
712integer :: ierr ! [netcdf] subroutine returned error code
713character(len=256) :: error_text ! text to display in case of error
714
715integer :: tmpdimid,tmpvarid ! temporary store a dimension/variable ID number
716character (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)
720real, 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
726integer :: ctllen ! nb of elements in the controle array
727integer :: tmpdimidout,tmpvaridout ! temporary stores a dimension/variable ID number
728
729!==============================================================================
730! LONGITUDE
731!==============================================================================
732! Get the dimension in GCM file
733ierr=nf90_inq_dimid(gcmfid,"longitude",tmpdimid)
734error_text="Error: Dimension <longitude> is missing in file "//trim(gcmfile)
735call status_check(ierr,error_text)
736
737ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=lonlen)
738allocate(lon(lonlen))
739
740! Create the dimension in output file
741ierr=NF90_DEF_DIM(outfid,"longitude",lonlen,londimout)
742error_text="Error: could not define the longitude dimension in the outfile"
743call status_check(ierr,error_text)
744
745! Get the field in GCM file
746ierr=nf90_inq_varid(gcmfid,"longitude",tmpvarid)
747error_text="Error: Field <longitude> is missing in file "//trim(gcmfile)
748call status_check(ierr,error_text)
749
750ierr=NF90_GET_VAR(gcmfid,tmpvarid,lon)
751error_text="Failed to load longitude"
752call status_check(ierr,error_text)
753
754! Create the field in the output file
755ierr=NF90_DEF_VAR(outfid,"longitude",nf90_float,(/londimout/),tmpvaridout)
756error_text="Error: could not define the longitude variable in the outfile"
757call status_check(ierr,error_text)
758
759! Get the field attributes in the GCM file
760ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name)
761if (ierr.ne.nf90_noerr) then
762! if no attribute "long_name", try "title"
763  ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name)
764endif
765ierr=nf90_get_att(gcmfid,tmpvarid,"units",units)
766
767! Put the field attributes in the output file
768ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name)
769ierr=nf90_put_att(outfid,tmpvaridout,"units",units)
770
771! Write the field values in the output file
772ierr=nf90_enddef(outfid) ! end netcdf define mode
773error_text="Error: could not end the define mode of the outfile"
774call status_check(ierr,error_text)
775
776ierr=NF90_PUT_VAR(outfid,tmpvaridout,lon)
777error_text="Error: could not write the longitude field in the outfile"
778call status_check(ierr,error_text)
779
780!==============================================================================
781! LATITUDE
782!==============================================================================
783! Switch to netcdf define mode
784ierr=nf90_redef(outfid)
785error_text="Error: could not switch to define mode in the outfile"
786call status_check(ierr,error_text)
787
788! Get the dimension in GCM file
789ierr=nf90_inq_dimid(gcmfid,"latitude",tmpdimid)
790error_text="Error: Dimension <latitude> is missing in file "//trim(gcmfile)
791call status_check(ierr,error_text)
792
793ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=latlen)
794allocate(lat(latlen))
795
796! Create the dimension in output file
797ierr=NF90_DEF_DIM(outfid,"latitude",latlen,latdimout)
798error_text="Error: could not define the latitude dimension in the outfile"
799call status_check(ierr,error_text)
800
801! Get the field in GCM file
802ierr=nf90_inq_varid(gcmfid,"latitude",tmpvarid)
803error_text="Error: Field <latitude> is missing in file "//trim(gcmfile)
804call status_check(ierr,error_text)
805
806ierr=NF90_GET_VAR(gcmfid,tmpvarid,lat)
807error_text="Failed to load latitude"
808call status_check(ierr,error_text)
809
810! Create the field in the output file
811ierr=NF90_DEF_VAR(outfid,"latitude",nf90_float,(/latdimout/),tmpvaridout)
812error_text="Error: could not define the latitude variable in the outfile"
813call status_check(ierr,error_text)
814
815! Get the field attributes in the GCM file
816ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name)
817if (ierr.ne.nf90_noerr) then
818! if no attribute "long_name", try "title"
819  ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name)
820endif
821ierr=nf90_get_att(gcmfid,tmpvarid,"units",units)
822
823! Put the field attributes in the output file
824ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name)
825ierr=nf90_put_att(outfid,tmpvaridout,"units",units)
826
827! Write the field values in the output file
828ierr=nf90_enddef(outfid) ! end netcdf define mode
829error_text="Error: could not end the define mode of the outfile"
830call status_check(ierr,error_text)
831
832ierr=NF90_PUT_VAR(outfid,tmpvaridout,lat)
833error_text="Error: could not write the latitude field in the outfile"
834call status_check(ierr,error_text)
835
836!==============================================================================
837! ALTITUDE
838!==============================================================================
839! Switch to netcdf define mode
840ierr=nf90_redef(outfid)
841error_text="Error: could not switch to define mode in the outfile"
842call status_check(ierr,error_text)
843
844! Get the dimension in GCM file
845ierr=nf90_inq_dimid(gcmfid,"altitude",tmpdimid)
846error_text="Error: Dimension <altitude> is missing in file "//trim(gcmfile)
847call status_check(ierr,error_text)
848
849ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=altlen)
850allocate(alt(altlen))
851
852! Create the dimension in output file
853ierr=NF90_DEF_DIM(outfid,"altitude",altlen,altdimout)
854error_text="Error: could not define the altitude dimension in the outfile"
855call status_check(ierr,error_text)
856
857! Get the field in GCM file
858ierr=nf90_inq_varid(gcmfid,"altitude",tmpvarid)
859error_text="Error: Field <altitude> is missing in file "//trim(gcmfile)
860call status_check(ierr,error_text)
861
862ierr=NF90_GET_VAR(gcmfid,tmpvarid,alt)
863error_text="Failed to load altitude"
864call status_check(ierr,error_text)
865
866! Create the field in the output file
867ierr=NF90_DEF_VAR(outfid,"altitude",nf90_float,(/altdimout/),tmpvaridout)
868error_text="Error: could not define the altitude variable in the outfile"
869call status_check(ierr,error_text)
870
871! Get the field attributes in the GCM file
872ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name)
873if (ierr.ne.nf90_noerr) then
874! if no attribute "long_name", try "title"
875  ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name)
876endif
877ierr=nf90_get_att(gcmfid,tmpvarid,"units",units)
878ierr=nf90_get_att(gcmfid,tmpvarid,"positive",positive)
879
880! Put the field attributes in the output file
881ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name)
882ierr=nf90_put_att(outfid,tmpvaridout,"units",units)
883ierr=nf90_put_att(outfid,tmpvaridout,"positive",positive)
884
885! Write the field values in the output file
886ierr=nf90_enddef(outfid) ! end netcdf define mode
887error_text="Error: could not end the define mode of the outfile"
888call status_check(ierr,error_text)
889
890ierr=NF90_PUT_VAR(outfid,tmpvaridout,alt)
891error_text="Error: could not write the altitude field in the outfile"
892call status_check(ierr,error_text)
893
894!==============================================================================
895! TIME
896!==============================================================================
897! Switch to netcdf define mode
898ierr=nf90_redef(outfid)
899error_text="Error: could not switch to define mode in the outfile"
900call status_check(ierr,error_text)
901
902! Get the dimension in GCM file
903ierr=nf90_inq_dimid(gcmfid,"Time",tmpdimid)
904error_text="Error: Dimension <Time> is missing in file "//trim(gcmfile)
905call status_check(ierr,error_text)
906
907ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=timelen)
908allocate(time(timelen))
909
910! Create the dimension in output file
911ierr=NF90_DEF_DIM(outfid,"Time",timelen,timedimout)
912error_text="Error: could not define the time dimension in the outfile"
913call status_check(ierr,error_text)
914
915! Get the field in GCM file
916ierr=nf90_inq_varid(gcmfid,"Time",tmpvarid)
917error_text="Error: Field <Time> is missing in file "//trim(gcmfile)
918call status_check(ierr,error_text)
919
920ierr=NF90_GET_VAR(gcmfid,tmpvarid,time)
921error_text="Failed to load Time"
922call status_check(ierr,error_text)
923
924! Create the field in the output file
925ierr=NF90_DEF_VAR(outfid,"Time",nf90_float,(/timedimout/),tmpvaridout)
926error_text="Error: could not define the Time variable in the outfile"
927call status_check(ierr,error_text)
928
929! Get the field attributes in the GCM file
930ierr=nf90_get_att(gcmfid,tmpvarid,"long_name",long_name)
931if (ierr.ne.nf90_noerr) then
932! if no attribute "long_name", try "title"
933  ierr=nf90_get_att(gcmfid,tmpvarid,"title",long_name)
934endif
935ierr=nf90_get_att(gcmfid,tmpvarid,"units",units)
936
937! Put the field attributes in the output file
938ierr=nf90_put_att(outfid,tmpvaridout,"long_name",long_name)
939ierr=nf90_put_att(outfid,tmpvaridout,"units",units)
940
941! Write the field values in the output file
942ierr=nf90_enddef(outfid) ! end netcdf define mode
943error_text="Error: could not end the define mode of the outfile"
944call status_check(ierr,error_text)
945
946ierr=NF90_PUT_VAR(outfid,tmpvaridout,time)
947error_text="Error: could not write the Time field in the outfile"
948call status_check(ierr,error_text)
949
950!==============================================================================
951! CONTROLE
952!==============================================================================
953! Switch to netcdf define mode
954ierr=nf90_redef(outfid)
955error_text="Error: could not switch to define mode in the outfile"
956call status_check(ierr,error_text)
957
958! Get the dimension in GCM file
959ierr=nf90_inq_dimid(gcmfid,"index",tmpdimid)
960error_text="Dimension <index> is missing in file "//trim(gcmfile)&
961           //". We'll skip that one."
962if (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)
967else
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)
1008endif
1009
1010
1011!==============================================================================
1012! Load size of aps() or sigma() (in case it is not altlen)
1013!==============================================================================
1014! Switch to netcdf define mode
1015ierr=nf90_redef(outfid)
1016error_text="Error: could not switch to define mode in the outfile"
1017call 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
1021ierr=nf90_inq_dimid(gcmfid,"GCM_layers",tmpdimid)
1022if (ierr.ne.nf90_noerr) then
1023  ! didn't find a GCM_layers dimension; therefore we have:
1024  GCM_layers=altlen 
1025else
1026  ! load value of GCM_layers
1027  ierr=nf90_inquire_dimension(gcmfid,tmpdimid,len=GCM_layers)
1028endif
1029
1030! Create the dimensions in output file
1031ierr = NF90_DEF_DIM(outfid,"GCM_layers",GCM_layers,layerdimout)
1032error_text="Error: could not define the GCM_layers dimension in the outfile"
1033call status_check(ierr,error_text)
1034ierr = NF90_DEF_DIM(outfid,"GCM_interlayers",GCM_layers+1,interlayerdimout)
1035error_text="Error: could not define the GCM_interlayers dimension in the outfile"
1036call status_check(ierr,error_text)
1037
1038! End netcdf define mode
1039ierr=nf90_enddef(outfid)
1040error_text="Error: could not end the define mode of the outfile"
1041call status_check(ierr,error_text)
1042
1043end subroutine inidims
1044
1045
1046!*******************************************************************************
1047
1048subroutine 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
1060use netcdf
1061
1062implicit none
1063
1064!==============================================================================
1065! Arguments:
1066!==============================================================================
1067integer, intent(in) :: gcmfid  ! NetCDF output file ID
1068integer, intent(in) :: lonlen ! # of grid points along longitude
1069integer, intent(in) :: latlen ! # of grid points along latitude
[2327]1070integer, intent(in) :: altlen ! # of grid points along altitude
[2317]1071integer, intent(in) :: GCM_layers ! # of GCM atmospheric layers
1072integer, intent(in) :: outfid ! NetCDF output file ID
1073integer, intent(in) :: londimout ! longitude dimension ID
1074integer, intent(in) :: latdimout ! latitude dimension ID
1075integer, intent(in) :: altdimout ! altitude dimension ID
1076integer, intent(in) :: layerdimout ! GCM_layers dimension ID
1077integer, intent(in) :: interlayerdimout ! GCM_layers+1 dimension ID
1078!==============================================================================
1079! Local variables:
1080!==============================================================================
1081real,dimension(:),allocatable :: aps,bps ! hybrid vertical coordinates
1082real,dimension(:),allocatable :: ap,bp ! hybrid vertical coordinates
1083real,dimension(:),allocatable :: sigma ! sigma levels
1084real,dimension(:,:),allocatable :: aire ! mesh areas
1085real,dimension(:,:),allocatable :: phisinit ! Ground geopotential
1086integer :: ierr
1087integer :: tmpvarid ! temporary variable ID
1088logical :: area ! is "aire" available ?
1089logical :: phis ! is "phisinit" available ?
1090logical :: hybrid ! are "aps" and "bps" available ?
1091logical :: 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
1099allocate(aps(GCM_layers),stat=ierr)
1100if (ierr.ne.0) then
1101  write(*,*) "init2: failed to allocate aps!"
1102  stop
1103endif
1104ierr=nf90_inq_varid(gcmfid,"aps",tmpvarid)
1105if (ierr.ne.nf90_noerr) then
1106  write(*,*) "Ooops. Failed to get aps ID. OK, will look for sigma coord."
1107  hybrid=.false.
1108else
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
1130endif
1131
1132! hybrid coordinate ap
1133allocate(ap(GCM_layers+1),stat=ierr)
1134if (ierr.ne.0) then
1135  write(*,*) "init2: failed to allocate ap!"
1136  stop
1137else
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
1149endif
1150
1151! hybrid coordinate bp
1152allocate(bp(GCM_layers+1),stat=ierr)
1153if (ierr.ne.0) then
1154  write(*,*) "init2: failed to allocate bp!"
1155  stop
1156else
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
1168endif
1169
1170! sigma levels (if any)
1171if (.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
1182endif ! of if (.not.hybrid)
1183
1184! mesh area
1185allocate(aire(lonlen,latlen),stat=ierr)
1186if (ierr.ne.0) then
1187  write(*,*) "init2: failed to allocate aire!"
1188  stop
1189endif
1190ierr=nf90_inq_varid(gcmfid,"aire",tmpvarid)
1191if (ierr.ne.nf90_noerr) then
1192  write(*,*)"init2 warning: Failed to get aire ID."
1193  area = .false.
1194else
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.
1200endif
1201
1202! ground geopotential phisinit
1203allocate(phisinit(lonlen,latlen),stat=ierr)
1204if (ierr.ne.0) then
1205  write(*,*) "init2: failed to allocate phisinit!"
1206  stop
1207endif
1208ierr=nf90_inq_varid(gcmfid,"phisinit",tmpvarid)
1209if (ierr.ne.nf90_noerr) then
1210  write(*,*)"init2 warning: Failed to get phisinit ID."
1211  phis = .false.
1212else
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.
1218endif
1219
1220!==============================================================================
1221! 2. Write
1222!==============================================================================
1223
1224!==============================================================================
[2327]1225! 2.1 Hybrid coordinates ap() , bp(), aps() and bps()
[2317]1226!==============================================================================
1227if(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
1312else
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
1332endif ! of if (hybrid)
1333
1334!==============================================================================
[2327]1335! 2.2 aire() and phisinit()
[2317]1336!==============================================================================
1337
1338if (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
1358endif ! of if (area)
1359
[2327]1360if (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]1381endif ! of if (phis)
[2317]1382
1383
1384! Cleanup
1385if (allocated(aps)) deallocate(aps)
1386if (allocated(bps)) deallocate(bps)
1387if (allocated(ap)) deallocate(ap)
1388if (allocated(bp)) deallocate(bp)
1389if (allocated(sigma)) deallocate(sigma)
1390if (allocated(phisinit)) deallocate(phisinit)
1391if (allocated(aire)) deallocate(aire)
1392
1393end subroutine init2
Note: See TracBrowser for help on using the repository browser.