source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspv.F90 @ 263

Last change on this file since 263 was 227, checked in by milmd, 10 years ago

Last LMDZ version (1315) with OpenMP directives and other stuff

File size: 4.4 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
30      implicit none
31
32#include "comcstfi.h"
33#include "callkeys.h"
34
35      logical file_ok
36
37      integer N, M, file_entries
38
39      character(len=30)  :: temp1
40      character(len=200) :: file_id
41      character(len=200) :: file_path
42
43      real*8 :: lastband(2)
44
45      real*8 STELLAR(L_NSPECTV)
46      real*8 sum, dummy
47
48      !! used to count lines
49      integer :: nb
50      integer :: ierr
51
52!=======================================================================
53!     Set up spectral bands - wavenumber [cm^(-1)]. Go from smaller to
54!     larger wavenumbers, the same as in the IR.
55
56      write(temp1,'(i2.2)') L_NSPECTV
57      file_id='/corrk_data/'//trim(adjustl(banddir))//'/narrowbands_VI.in' 
58      file_path=TRIM(datadir)//TRIM(file_id)
59
60      ! check that the file exists
61      inquire(FILE=file_path,EXIST=file_ok)
62      if(.not.file_ok) then
63         write(*,*)'The file ',TRIM(file_path)
64         write(*,*)'was not found by setspv.F90, exiting.'
65         write(*,*)'Check that your path to datagcm:',trim(datadir)
66         write(*,*)' is correct. You can change it in callphys.def with:'
67         write(*,*)' datadir = /absolute/path/to/datagcm'
68         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
69         call abort
70      endif
71       
72!$OMP MASTER       
73      nb=0
74      ierr=0
75      ! check that the file contains the right number of bands
76      open(131,file=file_path,form='formatted')
77      read(131,*,iostat=ierr) file_entries
78      do while (ierr==0)
79        read(131,*,iostat=ierr) dummy
80        if (ierr==0) nb=nb+1
81      enddo
82      close(131)
83
84      write(*,*) 'setspv: L_NSPECTV = ',L_NSPECTV, 'in the model '
85      write(*,*) '        there are   ',nb, 'entries in ',TRIM(file_path)
86      if(nb.ne.L_NSPECTV) then
87         write(*,*) 'MISMATCH !! I stop here'
88         call abort
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      print*,'setspv: VI band limits:'
105      do M=1,L_NSPECTV+1
106         print*,m,'-->',BWNV(M),' cm^-1'
107      end do
108      print*,' '
109
110!     Set up mean wavenumbers and wavenumber deltas.  Units of
111!     wavenumbers is cm^(-1); units of wavelengths is microns.
112
113      do M=1,L_NSPECTV
114         WNOV(M)  = 0.5*(BWNV(M+1)+BWNV(M))
115         DWNV(M)  = BWNV(M+1)-BWNV(M)
116         WAVEV(M) = 1.0E+4/WNOV(M)
117         BLAMV(M) = 0.01/BWNV(M)
118      end do
119      BLAMV(M) = 0.01/BWNV(M) ! wavelength in METERS for aerosol stuff
120!     note M=L_NSPECTV+1 after loop due to Fortran bizarreness
121
122!=======================================================================
123!     Set up stellar spectrum
124
125      write(*,*)'setspv: Interpolating stellar spectrum from the hires data...'
126      call ave_stelspec(STELLAR)
127
128!     Sum the stellar flux, and write out the result. 
129      sum = 0.0 
130      do N=1,L_NSPECTV
131         STELLARF(N) = STELLAR(N) * Fat1AU
132         sum         = sum+STELLARF(N)
133      end do
134      write(6,'("setspv: Stellar flux at 1 AU = ",f7.2," W m-2")') sum
135      print*,' '
136
137
138!=======================================================================
139!     Set up the wavelength independent part of the Rayleigh scattering.
140!     The pressure dependent part will be computed elsewhere (OPTCV).
141!     WAVEV is in microns.  There is no Rayleigh scattering in the IR.
142
143      if(rayleigh) then
144         call calc_rayleigh
145      else
146         print*,'setspv: No Rayleigh scattering, check for NaN in output!'
147         do N=1,L_NSPECTV
148            TAURAY(N) = 1E-16
149         end do
150      endif
151
152      RETURN
153    END subroutine setspv
Note: See TracBrowser for help on using the repository browser.