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

Last change on this file since 3556 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
RevLine 
[3]1      SUBROUTINE load_ksi(ksive)
2     
[101]3      use dimphy
[3]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     --------------
[1301]24C       
25c   New ksi matrix: possibility of different cloud model fct of lat   05/2014
[3]26C     ------------------------------------------------------------------
27C
28C* ARGUMENTS:
29C
30c inputs
31      real   psurf(klon)           ! Surface pressure
32c outputs
[892]33      real   ksive(0:klev+1,0:klev+1,nnuve,nbmat)  ! ksi matrixes in Vincent's file
[3]34
35c local variables
[1301]36      integer i,j,isza,ips,band,pve,sve,nlve
37      integer lat,Nb,m,mat
[3]38      character*9 tmp1
39      character*100 file
[1726]40      CHARACTER*2 str2
41      CHARACTER*3 str3
42      CHARACTER*10 format_lect
[3]43      real   lambda(nnuve)            ! wavelenght in table (mu->m, middle of interval)
44      real   lambdamin(nnuve),lambdamax(nnuve) ! in microns
[1301]45      real   dlambda                  ! in microns
[2464]46      logical upper
[3]47
[892]48      nlve = klev
[101]49
[1675]50cc      GG modif below
51c----------------------------------
52c   Initialisation of values to 0
53c     (for all vertical levels)
54c----------------------------------
55
[2036]56      ksive(0:klev+1,0:klev+1,1:nnuve,1:nbmat) = 0.0
[1675]57
[3]58c ------------------------
59c Loading the ksi file
60c ------------------------
[101]61
62      file = "ksi_global.txt"
[3]63      open(10,file=file)
64     
[1301]65      read(10,*)
66      read(10,*) nlatve
67      read(10,*)
[3]68
[1301]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)
[3]76        read(10,*)
[1301]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
[3]84        read(10,*) (tmp1,j=1,2),pve
[1301]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
[3]88        read(10,*)
89        read(10,*) m,Nb
[2464]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
[3]105        endif
[2464]106cc wavelength check
[3]107        if (Nb.ne.nnuve) then
108         write(*,*) 'This is subroutine load_ksi'
[1301]109         print*,'Dimension problem between ksi.txt and nnuve'
[3]110         print*,'N freq = ',Nb,nnuve
111         stop
112        endif
113c     Now reading ksi matrix index "mat"
[1726]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
[3]121        do band=1,Nb
122         read(10,*) lambdamin(band),lambdamax(band)
123         do i=0,m+1
[1726]124            read(10,format_lect) (ksive(i,j,band,mat),j=0,m+1) ! no unit
[3]125         enddo                  ! i
[2464]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
[3]135        enddo                     ! band
136c       print*,"Matrice ",mat," lue"
[1301]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
[3]149     
[1301]150      write(*,*) 'Total nb of matrixes:',mat
151     
[3]152      close(10)
153
[1301]154c central wavelength and wavelength width
[3]155      do band=1,nnuve
[1301]156         lambda(band)=(lambdamin(band)+lambdamax(band))/2.*1.e-6   ! in m
157         dlambda     =(lambdamax(band)-lambdamin(band))            ! in microns
[3]158c        print*,band,lambdamin(band),dlambda,lambdamax(band)
159
[1301]160c sign convention for ksi,
161c and taking into account the wavelength width (in microns):
[3]162         do mat=1,nbmat
163         do i=0,nlve+1
164           do j=0,nlve+1
[1301]165              ksive(i,j,band,mat) = +ksive(i,j,band,mat)*dlambda    ! in µm
[3]166           enddo
167         enddo
168         enddo
[1301]169c computing coeff al and bl for Planck luminance
[3]170         al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5.
[1301]171c in W/m²/m
172c We need W/m²/µm :
[3]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.