source: trunk/LMDZ.PLUTO/libf/phypluto/setspv.F90 @ 3504

Last change on this file since 3504 was 3504, checked in by afalco, 13 days ago

Pluto: print only on master process.
AF

File size: 4.6 KB
Line 
1      subroutine setspv
2
3!==================================================================
4!
5!     Purpose
6!     -------
7!     Set up spectral intervals, stellar spectrum and Rayleigh
8!     opacity in the shortwave.
9!
10!     Authors
11!     -------
12!     Adapted from setspv in the NASA Ames radiative code by
13!     Robin Wordsworth (2009).
14!
15!     Called by
16!     ---------
17!     callcorrk.F
18!
19!     Calls
20!     -----
21!     ave_stelspec.F
22!
23!==================================================================
24
25      use radinc_h,    only: L_NSPECTV, corrkdir, banddir
26      use radcommon_h, only: BWNV,BLAMV,WNOV,DWNV,WAVEV, &
27                             STELLARF,TAURAY
28      use datafile_mod, only: datadir
29      use callkeys_mod, only: Fat1AU,rayleigh
30      use mod_phys_lmdz_para, only : is_master
31
32      implicit none
33
34      logical file_ok
35
36      integer N, M, file_entries
37
38      character(len=30)  :: temp1
39      character(len=200) :: file_id
40      character(len=200) :: file_path
41
42      real*8 :: lastband(2)
43
44      real*8 STELLAR(L_NSPECTV)
45      real*8 sum, dummy
46
47      !! used to count lines
48      integer :: nb
49      integer :: ierr
50
51!=======================================================================
52!     Set up spectral bands - wavenumber [cm^(-1)]. Go from smaller to
53!     larger wavenumbers, the same as in the IR.
54
55      write(temp1,'(i2.2)') L_NSPECTV
56      file_id='/corrk_data/'//trim(adjustl(banddir))//'/narrowbands_VI.in'
57      file_path=TRIM(datadir)//TRIM(file_id)
58
59      ! check that the file exists
60      inquire(FILE=file_path,EXIST=file_ok)
61      if(.not.file_ok) then
62         write(*,*)'The file ',TRIM(file_path)
63         write(*,*)'was not found by setspv.F90, exiting.'
64         write(*,*)'Check that your path to datagcm:',trim(datadir)
65         write(*,*)' is correct. You can change it in callphys.def with:'
66         write(*,*)' datadir = /absolute/path/to/datagcm'
67         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
68         call abort_physic("setspv", "File not found by setspi", 1)
69      endif
70
71!$OMP MASTER
72      nb=0
73      ierr=0
74      ! check that the file contains the right number of bands
75      open(131,file=file_path,form='formatted')
76      read(131,*,iostat=ierr) file_entries
77      do while (ierr==0)
78        read(131,*,iostat=ierr) dummy
79        if (ierr==0) nb=nb+1
80      enddo
81      close(131)
82
83      if (is_master) then
84         write(*,*) 'setspv: L_NSPECTV = ',L_NSPECTV, 'in the model '
85         write(*,*) '        there are   ',nb, 'entries in ',TRIM(file_path)
86      endif
87      if(nb.ne.L_NSPECTV) then
88         call abort_physic("setspv",'MISMATCH !! I stop here',1)
89      endif
90
91      ! load and display the data
92      open(111,file=file_path,form='formatted')
93      read(111,*)
94       do M=1,L_NSPECTV-1
95         read(111,*) BWNV(M)
96      end do
97      read(111,*) lastband
98      close(111)
99      BWNV(L_NSPECTV)  =lastband(1)
100      BWNV(L_NSPECTV+1)=lastband(2)
101!$OMP END MASTER
102!$OMP BARRIER
103
104      if (is_master) then
105         print*,'setspv: VI band limits:'
106         do M=1,L_NSPECTV+1
107            print*,m,'-->',BWNV(M),' cm^-1'
108         end do
109         print*,' '
110      endif
111
112!     Set up mean wavenumbers and wavenumber deltas.  Units of
113!     wavenumbers is cm^(-1); units of wavelengths is microns.
114
115      do M=1,L_NSPECTV
116         WNOV(M)  = 0.5*(BWNV(M+1)+BWNV(M))
117         DWNV(M)  = BWNV(M+1)-BWNV(M)
118         WAVEV(M) = 1.0E+4/WNOV(M)
119         BLAMV(M) = 0.01/BWNV(M)
120      end do
121      BLAMV(M) = 0.01/BWNV(M) ! wavelength in METERS for aerosol stuff
122!     note M=L_NSPECTV+1 after loop due to Fortran bizarreness
123
124!=======================================================================
125!     Set up stellar spectrum
126
127      if (is_master) write(*,*)'setspv: Interpolating stellar spectrum from the hires data...'
128      call ave_stelspec(STELLAR)
129
130!     Sum the stellar flux, and write out the result.
131      sum = 0.0
132      do N=1,L_NSPECTV
133         STELLARF(N) = STELLAR(N) * Fat1AU
134         sum         = sum+STELLARF(N)
135      end do
136      if (is_master)then
137         write(6,'("setspv: Stellar flux at 1 AU = ",f9.2," W m-2")') sum
138         print*,' '
139      endif
140
141
142!=======================================================================
143!     Set up the wavelength independent part of the Rayleigh scattering.
144!     The pressure dependent part will be computed elsewhere (OPTCV).
145!     WAVEV is in microns.  There is no Rayleigh scattering in the IR.
146
147      if(rayleigh) then
148         call calc_rayleigh
149      else
150         if (is_master) print*,'setspv: No Rayleigh scattering, check for NaN in output!'
151         do N=1,L_NSPECTV
152            TAURAY(N) = 1E-16
153         end do
154      endif
155
156      RETURN
157    END subroutine setspv
Note: See TracBrowser for help on using the repository browser.