source: trunk/LMDZ.VENUS/libf/phyvenus/load_ksi.F @ 3137

Last change on this file since 3137 was 2464, checked in by slebonnois, 4 years ago

SL: major update related to extension to 250 km. New EUV heating as used in Martian GCM, debug of a few routines, adding He, clean up, updating mmean regularly, modification of the order of processes, add the possibility to use Hedin composition in rad transfer

File size: 5.3 KB
Line 
1      SUBROUTINE load_ksi(ksive)
2     
3      use dimphy
4      IMPLICIT none
5
6#include "YOMCST.h"
7#include "comcstVE.h"
8C
9C     ------------------------------------------------------------------
10C
11C     PURPOSE.
12C     --------
13C
14c     This routine loads the longwave matrix of factors Ksi
15c     
16c     The Ksi matrixes have been computed by Vincent Eymet
17C
18C     AUTHOR.
19C     -------
20C        Sebastien Lebonnois
21C
22C     MODIFICATIONS.
23C     --------------
24C       
25c   New ksi matrix: possibility of different cloud model fct of lat   05/2014
26C     ------------------------------------------------------------------
27C
28C* ARGUMENTS:
29C
30c inputs
31      real   psurf(klon)           ! Surface pressure
32c outputs
33      real   ksive(0:klev+1,0:klev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
34
35c local variables
36      integer i,j,isza,ips,band,pve,sve,nlve
37      integer lat,Nb,m,mat
38      character*9 tmp1
39      character*100 file
40      CHARACTER*2 str2
41      CHARACTER*3 str3
42      CHARACTER*10 format_lect
43      real   lambda(nnuve)            ! wavelenght in table (mu->m, middle of interval)
44      real   lambdamin(nnuve),lambdamax(nnuve) ! in microns
45      real   dlambda                  ! in microns
46      logical upper
47
48      nlve = klev
49
50cc      GG modif below
51c----------------------------------
52c   Initialisation of values to 0
53c     (for all vertical levels)
54c----------------------------------
55
56      ksive(0:klev+1,0:klev+1,1:nnuve,1:nbmat) = 0.0
57
58c ------------------------
59c Loading the ksi file
60c ------------------------
61
62      file = "ksi_global.txt"
63      open(10,file=file)
64     
65      read(10,*)
66      read(10,*) nlatve
67      read(10,*)
68
69      write(*,*) 'This is subroutine load_ksi'
70      write(*,*) 'Nb of lat bands:',nlatve
71     
72      do lat=1,nlatve
73        read(10,*) !line for lat range
74        read(10,*) indexve(lat)
75        read(10,*) nbpsve(lat)
76        read(10,*)
77        read(10,*) nbszave(lat)
78        read(10,*)
79       
80        do isza=1,nbszave(lat)
81          do ips=1,nbpsve(lat)
82         
83        read(10,*) (tmp1,j=1,3),mat    !line for matrix number
84        read(10,*) (tmp1,j=1,2),pve
85        psurfve(ips,lat) = pve*1.e5    ! pve in bar, psurfve in Pa
86        read(10,*) (tmp1,j=1,3),sve
87        szave(isza,lat) = cos(sve*RPI/180.) ! conversion in mu0
88        read(10,*)
89        read(10,*) m,Nb
90CC vertical axis check
91        upper=.false.
92cc the number of levels read for the matrix (m) should be the number of levels of the GCM (nlve=klev)
93        if (m.ne.nlve) then
94CC When GCM axis has more levels than the matrix, we must be in the case
95cc with upper atmosphere, ie matrix limited to 78 levels and upper levels set to zero
96cc otherwise there is a problem
97         if ((m.eq.78).and.(nlve.gt.78)) then
98          upper=.true.
99         else
100          write(*,*) 'This is subroutine load_ksi'
101          print*,'Dimension problem between ksi.txt and nlve'
102          print*,'N levels = ',m,nlve
103          stop
104         endif
105        endif
106cc wavelength check
107        if (Nb.ne.nnuve) then
108         write(*,*) 'This is subroutine load_ksi'
109         print*,'Dimension problem between ksi.txt and nnuve'
110         print*,'N freq = ',Nb,nnuve
111         stop
112        endif
113c     Now reading ksi matrix index "mat"
114        if ((m+2).ge.100) then
115          write(str3,'(i3.3)') m+2
116          format_lect='('//str3//'e17.9)'
117        else
118          write(str2,'(i2.2)') m+2
119          format_lect='('//str2//'e17.9)'
120        endif
121        do band=1,Nb
122         read(10,*) lambdamin(band),lambdamax(band)
123         do i=0,m+1
124            read(10,format_lect) (ksive(i,j,band,mat),j=0,m+1) ! no unit
125         enddo                  ! i
126cc case upper atmosphere: the level for space (m+1) should be raised to nlve+1
127         if (upper) then
128           do i=0,m
129             ksive(i,klev+1,band,mat)=ksive(i,m+1,band,mat)
130             ksive(i,m+1,band,mat)=0.
131           enddo
132             ksive(klev+1,:,band,mat)=ksive(m+1,:,band,mat)
133             ksive(m+1,:,band,mat)=0.
134         endif
135        enddo                     ! band
136c       print*,"Matrice ",mat," lue"
137c       print*,"   psurf=",psurfve(ips,lat)," bars"
138        if (mat+1.gt.nbmat) then
139         write(*,*) 'This is subroutine load_ksi'
140         print*,'Dimension problem between ksi.txt and nbmat'
141         print*,'(max number of matrixes)'
142         print*,'nbmat (in comcstVE.h) should be raised'
143         stop
144        endif
145
146          enddo    ! ips
147        enddo      ! isza
148      enddo        ! lat
149     
150      write(*,*) 'Total nb of matrixes:',mat
151     
152      close(10)
153
154c central wavelength and wavelength width
155      do band=1,nnuve
156         lambda(band)=(lambdamin(band)+lambdamax(band))/2.*1.e-6   ! in m
157         dlambda     =(lambdamax(band)-lambdamin(band))            ! in microns
158c        print*,band,lambdamin(band),dlambda,lambdamax(band)
159
160c sign convention for ksi,
161c and taking into account the wavelength width (in microns):
162         do mat=1,nbmat
163         do i=0,nlve+1
164           do j=0,nlve+1
165              ksive(i,j,band,mat) = +ksive(i,j,band,mat)*dlambda    ! in µm
166           enddo
167         enddo
168         enddo
169c computing coeff al and bl for Planck luminance
170         al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5.
171c in W/m²/m
172c We need W/m²/µm :
173     .                * 1.e-6
174         bl(band) = RHPLA*RCLUM/(RKBOL*lambda(band))
175      enddo
176     
177      print*,"LOAD_KSI OK"
178
179      return
180      end
181
Note: See TracBrowser for help on using the repository browser.