1 | SUBROUTINE load_ksi(ksive) |
---|
2 | |
---|
3 | use dimphy |
---|
4 | IMPLICIT none |
---|
5 | |
---|
6 | #include "YOMCST.h" |
---|
7 | #include "comcstVE.h" |
---|
8 | C |
---|
9 | C ------------------------------------------------------------------ |
---|
10 | C |
---|
11 | C PURPOSE. |
---|
12 | C -------- |
---|
13 | C |
---|
14 | c This routine loads the longwave matrix of factors Ksi |
---|
15 | c |
---|
16 | c The Ksi matrixes have been computed by Vincent Eymet |
---|
17 | C |
---|
18 | C AUTHOR. |
---|
19 | C ------- |
---|
20 | C Sebastien Lebonnois |
---|
21 | C |
---|
22 | C MODIFICATIONS. |
---|
23 | C -------------- |
---|
24 | C |
---|
25 | c New ksi matrix: possibility of different cloud model fct of lat 05/2014 |
---|
26 | C ------------------------------------------------------------------ |
---|
27 | C |
---|
28 | C* ARGUMENTS: |
---|
29 | C |
---|
30 | c inputs |
---|
31 | real psurf(klon) ! Surface pressure |
---|
32 | c outputs |
---|
33 | real ksive(0:klev+1,0:klev+1,nnuve,nbmat) ! ksi matrixes in Vincent's file |
---|
34 | |
---|
35 | c 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 | |
---|
50 | cc GG modif below |
---|
51 | c---------------------------------- |
---|
52 | c Initialisation of values to 0 |
---|
53 | c (for all vertical levels) |
---|
54 | c---------------------------------- |
---|
55 | |
---|
56 | ksive(0:klev+1,0:klev+1,1:nnuve,1:nbmat) = 0.0 |
---|
57 | |
---|
58 | c ------------------------ |
---|
59 | c Loading the ksi file |
---|
60 | c ------------------------ |
---|
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 |
---|
90 | CC vertical axis check |
---|
91 | upper=.false. |
---|
92 | cc 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 |
---|
94 | CC When GCM axis has more levels than the matrix, we must be in the case |
---|
95 | cc with upper atmosphere, ie matrix limited to 78 levels and upper levels set to zero |
---|
96 | cc 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 |
---|
106 | cc 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 |
---|
113 | c 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 |
---|
126 | cc 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 |
---|
136 | c print*,"Matrice ",mat," lue" |
---|
137 | c 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 | |
---|
154 | c 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 |
---|
158 | c print*,band,lambdamin(band),dlambda,lambdamax(band) |
---|
159 | |
---|
160 | c sign convention for ksi, |
---|
161 | c 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 |
---|
169 | c computing coeff al and bl for Planck luminance |
---|
170 | al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5. |
---|
171 | c in W/m²/m |
---|
172 | c 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 | |
---|