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

Last change on this file was 313, checked in by ymipsl, 10 years ago
  • implement splitting of XIOS file for lmdz physics
  • Termination is done properly in parallel by calling MPI_ABORT instead of abort or stop

YM

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