source: LMDZ.3.3/branches/rel-LF/libf/phylmd/read_pstoke0.F @ 1006

Last change on this file since 1006 was 558, checked in by lmdzadmin, 20 years ago

Pour pouvoir compiler avec ifc AC
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.2 KB
RevLine 
[199]1c
[207]2c $Header$
[199]3c
4        subroutine read_pstoke0(irec,
5     .   zrec,zkon,zkev,airefi,phisfi,
6     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
7     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
8
9
10       IMPLICIT NONE
11
12#include "netcdf.inc"
13#include "dimensions.h"
14#include "paramet.h"
15#include "comconst.h"
16#include "comgeom.h"
17#include "temps.h"
18#include "ener.h"
19#include "logic.h"
20#include "description.h"
21#include "serre.h"
22#include "indicesol.h"
23#include "control.h"
24#include "dimphy.h"
25         
26          integer*4 kon,kev,zkon,zkev
27          parameter(kon=iim*(jjm-1)+2,kev=llm)
28          REAL*4 phisfi(kon)
29          REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
30
31          REAL*4 mfu(kon,kev), mfd(kon,kev)
32          REAL*4 en_u(kon,kev), de_u(kon,kev)
33          REAL*4 en_d(kon,kev), de_d(kon,kev)
34          REAL*4 coefh(kon,kev)
35                REAL*4 t(kon,kev)
36
37          REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
38          REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
39          REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
40          REAL*4 coefh2(iim,jjm+1,kev)
41                REAL*4 t2(iim,jjm+1,kev)
42
43          REAL*4 pl(kev)
44          integer irec
45          integer*4 xid,yid,zid,tid
46          integer*4 zrec,zim,zjm
47          integer*4 ncrec,nckon,nckev,ncim,ncjm
48
49          real*4 airefi(kon)
[558]50          character*30 namedim
[199]51
52c  !! attention !!
53c attention il y a aussi le pb de def kon
54c dim de phis??
55
56          REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev)
57          REAL*4 frac_impa2(iim,jjm+1,kev),
58     .     frac_nucl2(iim,jjm+1,kev)
59          REAL*4 pyu1(kon), pyv1(kon)
60          REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1)
61          REAL*4 ftsol(kon,nbsrf)
62          REAL*4 psrf(kon,nbsrf)
63          REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
64          REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
65          REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
66     .     ftsol32(iim,jjm+1),
67     .     ftsol42(iim,jjm+1)
68          REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
69     .     psrf42(iim,jjm+1)
70       
71          integer ncidp
72          save ncidp
73          integer varidmfu, varidmfd, varidps, varidenu, variddeu       
74                integer varidt
75          integer varidend,varidded,varidch,varidfi,varidfn
76          integer varidyu1,varidyv1,varidpl,varidai,varididvt
77          integer varidfts1,varidfts2,varidfts3,varidfts4
78          integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
79          save varidmfu, varidmfd, varidps, varidenu, variddeu
80                save varidt
81          save varidend,varidded,varidch,varidfi,varidfn
82          save varidyu1,varidyv1,varidpl,varidai,varididvt
83          save varidfts1,varidfts2,varidfts3,varidfts4
84          save varidpsr1,varidpsr2,varidpsr3,varidpsr4
85
86          integer l, i
87          integer start(4),count(4),status
88          real rcode
89          logical first
90          save first
91          data first/.true./
92
93
94
95c ---------------------------------------------
96c   Initialisation de la lecture des fichiers
97c ---------------------------------------------
98
99      if (irec .eq. 0) then
100
101            ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
102
103            varidps=NCVID(ncidp,'phis',rcode)
104            print*,'ncidp,varidps',ncidp,varidps
105
106            varidpl=NCVID(ncidp,'sig_s',rcode)
107            print*,'ncidp,varidpl',ncidp,varidpl
108
109            varidai=NCVID(ncidp,'aire',rcode)
110            print*,'ncidp,varidai',ncidp,varidai
111
112            varidmfu=NCVID(ncidp,'mfu',rcode)
113            print*,'ncidp,varidmfu',ncidp,varidmfu
114
115                varidt=NCVID(ncidp,'t',rcode)
116                print*,'ncidp,varidt',ncidp,varidt
117
118            varidmfd=NCVID(ncidp,'mfd',rcode)
119            print*,'ncidp,varidmfd',ncidp,varidmfd
120
121            varidenu=NCVID(ncidp,'en_u',rcode)
122            print*,'ncidp,varidenu',ncidp,varidenu
123
124            variddeu=NCVID(ncidp,'de_u',rcode)
125            print*,'ncidp,variddeu',ncidp,variddeu
126
127            varidend=NCVID(ncidp,'en_d',rcode)
128            print*,'ncidp,varidend',ncidp,varidend
129       
130            varidded=NCVID(ncidp,'de_d',rcode)
131            print*,'ncidp,varidded',ncidp,varidded
132       
133            varidch=NCVID(ncidp,'coefh',rcode)
134            print*,'ncidp,varidch',ncidp,varidch
135       
136            varidfi=NCVID(ncidp,'frac_impa',rcode)
137            print*,'ncidp,varidfi',ncidp,varidfi
138       
139            varidfn=NCVID(ncidp,'frac_nucl',rcode)
140            print*,'ncidp,varidfn',ncidp,varidfn
141       
142            varidyu1=NCVID(ncidp,'pyu1',rcode)
143            print*,'ncidp,varidyu1',ncidp,varidyu1
144       
145            varidyv1=NCVID(ncidp,'pyv1',rcode)
146            print*,'ncidp,varidyv1',ncidp,varidyv1
147       
148            varidfts1=NCVID(ncidp,'ftsol1',rcode)
149            print*,'ncidp,varidfts1',ncidp,varidfts1
150       
151            varidfts2=NCVID(ncidp,'ftsol2',rcode)
152            print*,'ncidp,varidfts2',ncidp,varidfts2
153         
154            varidfts3=NCVID(ncidp,'ftsol3',rcode)
155            print*,'ncidp,varidfts3',ncidp,varidfts3
156 
157            varidfts4=NCVID(ncidp,'ftsol4',rcode)
158            print*,'ncidp,varidfts4',ncidp,varidfts4
159       
160            varidpsr1=NCVID(ncidp,'psrf1',rcode)
161            print*,'ncidp,varidpsr1',ncidp,varidpsr1
162       
163            varidpsr2=NCVID(ncidp,'psrf2',rcode)
164            print*,'ncidp,varidpsr2',ncidp,varidpsr2
165       
166            varidpsr3=NCVID(ncidp,'psrf3',rcode)
167            print*,'ncidp,varidpsr3',ncidp,varidpsr3
168
169            varidpsr4=NCVID(ncidp,'psrf4',rcode)
170            print*,'ncidp,varidpsr4',ncidp,varidpsr4
171       
172c ID pour les dimensions
173
174            status = nf_inq_dimid(ncidp,'y',yid)
175            status = nf_inq_dimid(ncidp,'x',xid)
176            status = nf_inq_dimid(ncidp,'sig_s',zid)
177            status = nf_inq_dimid(ncidp,'time_counter',tid)
178
179c lecture des dimensions
180
181            status = nf_inq_dim(ncidp,yid,namedim,ncjm)
182            status = nf_inq_dim(ncidp,xid,namedim,ncim)
183            status = nf_inq_dim(ncidp,zid,namedim,nckev)
184            status = nf_inq_dim(ncidp,tid,namedim,ncrec)
185       
186            zrec=ncrec
187            zkev=nckev
188            zim=ncim
189            zjm=ncjm
190       
191            zkon=zim*(zjm-2)+2
192       
193            write(*,*) 'read_pstoke : zrec = ', zrec
194            write(*,*) 'read_pstoke : kev = ', zkev
195            write(*,*) 'read_pstoke : zim = ', zim
196            write(*,*) 'read_pstoke : zjm = ', zjm
197            write(*,*) 'read_pstoke : kon = ', zkon
198
199c niveaux de pression
200
201            status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl)
202
203c lecture de aire et phis
204       
205      start(1)=1
206      start(2)=1
207      start(3)=1
208      start(4)=0
209
210      count(1)=zim
211      count(2)=zjm
212      count(3)=1
213      count(4)=0
214
215c
216c phis
217      status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
218      call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
219
220c aire
221      status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
222      call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
223      else
224
225      print*,'ok1'
226
227c ---------------------
228c   lecture des champs
229c ---------------------
230       
231        print*,'WARNING!!! Il n y a pas de test de coherence'
232        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
233
234      start(1)=1
235      start(2)=1
236      start(3)=1
237      start(4)=irec
238
239      count(1)=zim
240      count(2)=zjm
241      count(3)=kev
242      count(4)=1
243
244c frac_impa
245
246      status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
247      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
248
249c frac_nucl
250
251      status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
252      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
253
254c abder t
255      status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
256      call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
257
258c mfu
259      status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
260      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
261
262c mfd
263      status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
264      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
265
266c en_u
267      status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
268      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
269
270c de_u
271      status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
272      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
273
274c en_d
275      status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
276      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
277
278c de_d
279      status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
280      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
281
282c coefh
283        print*,'LECTURE de coefh a irec =',irec
284       status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
285       call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
286
287      start(3)=irec
288      start(4)=0
289      count(3)=1
290      count(4)=0
291
292c pyu1
293        print*,'LECTURE de yu1 a irec =',irec
294      status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
295      call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
296
297c pyv1
298        print*,'LECTURE de yv1 a irec =',irec
299      status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
300      call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
301
302c ftsol1
303        print*,'LECTURE de ftsol1 a irec =',irec
304      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
305       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
306
307c ftsol2
308        print*,'LECTURE de ftsol2 a irec =',irec
309      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
310      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
311
312c ftsol3
313         print*,'LECTURE de ftsol3 a irec =',irec
314      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
315      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
316
317c ftsol4
318      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
319      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
320
321c psrf1
322      status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
323c      call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
324      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
325
326c psrf2
327      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
328c      call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
329      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
330
331c psrf3
332      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
333      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
334
335c psrf4
336      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
337      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
338       
339          do i = 1,kon
340       
341        psrf(i,1) = psrf1(i)
342        psrf(i,2) = psrf2(i)
343        psrf(i,3) = psrf3(i)
344        psrf(i,4) = psrf4(i)
345 
346        ftsol(i,1) = ftsol1(i)
347        ftsol(i,2) = ftsol2(i)
348        ftsol(i,3) = ftsol3(i)
349        ftsol(i,4) = ftsol4(i)
350       
351          enddo
352       
353        endif
354       
355        return
356       
357        end
358
Note: See TracBrowser for help on using the repository browser.