source: LMDZ4/trunk/libf/phylmd/read_pstoke0.F @ 1374

Last change on this file since 1374 was 1146, checked in by Laurent Fairhead, 15 years ago

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.1 KB
RevLine 
[524]1!
2! $Header$
3!
4c
5c
6        subroutine read_pstoke0(irec,
7     .   zrec,zkon,zkev,airefi,phisfi,
8     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
[541]9     .   fm_therm,en_therm,
[524]10     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
11
[541]12C******************************************************************************
13C  Frederic HOURDIN, Abderrahmane IDELKADI
14C Lecture des parametres physique stockes online necessaires pour
15C recalculer offline le transport des traceurs sur la meme grille que online
16C A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
17C******************************************************************************
[524]18
[1146]19        use netcdf
[940]20       USE dimphy
[524]21       IMPLICIT NONE
22
23#include "netcdf.inc"
24#include "dimensions.h"
25#include "paramet.h"
26#include "comconst.h"
27#include "comgeom.h"
28#include "temps.h"
29#include "ener.h"
30#include "logic.h"
31#include "description.h"
32#include "serre.h"
33#include "indicesol.h"
34#include "control.h"
[940]35cccc#include "dimphy.h"
[524]36         
[541]37          integer kon,kev,zkon,zkev
[524]38          parameter(kon=iim*(jjm-1)+2,kev=llm)
[541]39          REAL phisfi(kon)
40          REAL phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
[524]41
[541]42          REAL mfu(kon,kev), mfd(kon,kev)
43          REAL en_u(kon,kev), de_u(kon,kev)
44          REAL en_d(kon,kev), de_d(kon,kev)
45          REAL coefh(kon,kev)
[524]46
[541]47c abd 25 11 02
48c Thermiques
49         REAL fm_therm(kon,kev),en_therm(kon,kev)
50                REAL t(kon,kev)
[524]51
[541]52          REAL mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
53          REAL en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
54          REAL en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
55          REAL coefh2(iim,jjm+1,kev)
56                REAL t2(iim,jjm+1,kev)
57c Thermiques
58         REAL fm_therm2(iim,jjm+1,kev)
59         REAL en_therm2(iim,jjm+1,kev)       
60
61          REAL pl(kev)
[524]62          integer irec
[541]63          integer xid,yid,zid,tid
64          integer zrec,zim,zjm
65          integer ncrec,nckon,nckev,ncim,ncjm
[524]66
[541]67          real airefi(kon)
68          character*20 namedim
[524]69
70c  !! attention !!
71c attention il y a aussi le pb de def kon
72c dim de phis??
73
[541]74          REAL frac_impa(kon,kev), frac_nucl(kon,kev)
75          REAL frac_impa2(iim,jjm+1,kev),
[524]76     .     frac_nucl2(iim,jjm+1,kev)
[541]77          REAL pyu1(kon), pyv1(kon)
78          REAL pyu12(iim,jjm+1), pyv12(iim,jjm+1)
79          REAL ftsol(kon,nbsrf)
80          REAL psrf(kon,nbsrf)
81          REAL ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
82          REAL psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
83          REAL ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
[524]84     .     ftsol32(iim,jjm+1),
85     .     ftsol42(iim,jjm+1)
[541]86          REAL psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
[524]87     .     psrf42(iim,jjm+1)
88       
89          integer ncidp
90          save ncidp
91          integer varidmfu, varidmfd, varidps, varidenu, variddeu       
92                integer varidt
93          integer varidend,varidded,varidch,varidfi,varidfn
[541]94c therm
95          integer varidfmth,varidenth
[524]96          integer varidyu1,varidyv1,varidpl,varidai,varididvt
97          integer varidfts1,varidfts2,varidfts3,varidfts4
98          integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
99          save varidmfu, varidmfd, varidps, varidenu, variddeu
100                save varidt
101          save varidend,varidded,varidch,varidfi,varidfn
[541]102c therm
103           save varidfmth,varidenth
[524]104          save varidyu1,varidyv1,varidpl,varidai,varididvt
105          save varidfts1,varidfts2,varidfts3,varidfts4
106          save varidpsr1,varidpsr2,varidpsr3,varidpsr4
107
108          integer l, i
109          integer start(4),count(4),status
110          real rcode
111          logical first
112          save first
113          data first/.true./
114
115
116
117c ---------------------------------------------
118c   Initialisation de la lecture des fichiers
119c ---------------------------------------------
120
121      if (irec .eq. 0) then
122
[1146]123            rcode=nf90_open('phystoke.nc',nf90_nowrite,ncidp)
[524]124
[1146]125            rcode = nf90_inq_varid(ncidp, 'phis', varidps)
[524]126            print*,'ncidp,varidps',ncidp,varidps
127
[1146]128            rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
[524]129            print*,'ncidp,varidpl',ncidp,varidpl
130
[1146]131            rcode = nf90_inq_varid(ncidp, 'aire', varidai)
[524]132            print*,'ncidp,varidai',ncidp,varidai
133
[1146]134                rcode = nf90_inq_varid(ncidp, 't', varidt)
[541]135                print*,'ncidp,varidt',ncidp,varidt
136
[1146]137            rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
[524]138            print*,'ncidp,varidmfu',ncidp,varidmfu
139
[1146]140            rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
[524]141            print*,'ncidp,varidmfd',ncidp,varidmfd
142
[1146]143            rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
[524]144            print*,'ncidp,varidenu',ncidp,varidenu
145
[1146]146            rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
[524]147            print*,'ncidp,variddeu',ncidp,variddeu
148
[1146]149            rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
[524]150            print*,'ncidp,varidend',ncidp,varidend
151       
[1146]152            rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
[524]153            print*,'ncidp,varidded',ncidp,varidded
154       
[1146]155            rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
[524]156            print*,'ncidp,varidch',ncidp,varidch
[541]157
158c Thermiques
[1146]159            rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
[541]160            print*,'ncidp,varidfmth',ncidp,varidfmth
161
[1146]162            rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
[541]163            print*,'ncidp,varidenth',ncidp,varidenth
[524]164       
[1146]165            rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
[524]166            print*,'ncidp,varidfi',ncidp,varidfi
167       
[1146]168            rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
[524]169            print*,'ncidp,varidfn',ncidp,varidfn
170       
[1146]171            rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
[524]172            print*,'ncidp,varidyu1',ncidp,varidyu1
173       
[1146]174            rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
[524]175            print*,'ncidp,varidyv1',ncidp,varidyv1
176       
[1146]177            rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
[524]178            print*,'ncidp,varidfts1',ncidp,varidfts1
179       
[1146]180            rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
[524]181            print*,'ncidp,varidfts2',ncidp,varidfts2
182         
[1146]183            rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
[524]184            print*,'ncidp,varidfts3',ncidp,varidfts3
185 
[1146]186            rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
[524]187            print*,'ncidp,varidfts4',ncidp,varidfts4
188       
[1146]189            rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
[524]190            print*,'ncidp,varidpsr1',ncidp,varidpsr1
191       
[1146]192            rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
[524]193            print*,'ncidp,varidpsr2',ncidp,varidpsr2
194       
[1146]195            rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
[524]196            print*,'ncidp,varidpsr3',ncidp,varidpsr3
197
[1146]198            rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
[524]199            print*,'ncidp,varidpsr4',ncidp,varidpsr4
200       
201c ID pour les dimensions
202
203            status = nf_inq_dimid(ncidp,'y',yid)
204            status = nf_inq_dimid(ncidp,'x',xid)
205            status = nf_inq_dimid(ncidp,'sig_s',zid)
206            status = nf_inq_dimid(ncidp,'time_counter',tid)
207
208c lecture des dimensions
209
210            status = nf_inq_dim(ncidp,yid,namedim,ncjm)
211            status = nf_inq_dim(ncidp,xid,namedim,ncim)
212            status = nf_inq_dim(ncidp,zid,namedim,nckev)
213            status = nf_inq_dim(ncidp,tid,namedim,ncrec)
214       
215            zrec=ncrec
216            zkev=nckev
217            zim=ncim
218            zjm=ncjm
219       
220            zkon=zim*(zjm-2)+2
221       
222            write(*,*) 'read_pstoke : zrec = ', zrec
223            write(*,*) 'read_pstoke : kev = ', zkev
224            write(*,*) 'read_pstoke : zim = ', zim
225            write(*,*) 'read_pstoke : zjm = ', zjm
226            write(*,*) 'read_pstoke : kon = ', zkon
227
228c niveaux de pression
229
230            status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl)
231
232c lecture de aire et phis
233       
234      start(1)=1
235      start(2)=1
236      start(3)=1
237      start(4)=0
238
239      count(1)=zim
240      count(2)=zjm
241      count(3)=1
242      count(4)=0
243
244c
[541]245C**** Geopotentiel au sol ***************************************
[524]246c phis
[541]247#ifdef NC_DOUBLE
248      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
249#else
250        status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
251#endif
[524]252      call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
253
[541]254C**** Aires des mails aux sol ************************************
[524]255c aire
[541]256#ifdef NC_DOUBLE
257      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
258#else
259        status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
260#endif
[524]261      call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
262      else
263
264      print*,'ok1'
265
266c ---------------------
267c   lecture des champs
268c ---------------------
269       
270        print*,'WARNING!!! Il n y a pas de test de coherence'
271        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
272
273      start(1)=1
274      start(2)=1
275      start(3)=1
276      start(4)=irec
277
278      count(1)=zim
279      count(2)=zjm
280      count(3)=kev
281      count(4)=1
282
[541]283C**** Temperature ********************************************
284cA FAIRE : Es-ce necessaire ?
[524]285
286c abder t
[541]287#ifdef NC_DOUBLE
288      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
289#else
290        status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
291#endif
[524]292      call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
293
[541]294C**** Flux pour la convection (Tiedtk) ********************************************
[524]295c mfu
[541]296#ifdef NC_DOUBLE
297      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
298#else
299        status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
300#endif
[524]301      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
302
303c mfd
[541]304#ifdef NC_DOUBLE
305      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
306#else
307        status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
308#endif
[524]309      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
310
311c en_u
[541]312#ifdef NC_DOUBLE
313      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
314#else
315        status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
316#endif
[524]317      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
318
319c de_u
[541]320#ifdef NC_DOUBLE
321      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
322#else
323        status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
324#endif
[524]325      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
326
327c en_d
[541]328#ifdef NC_DOUBLE
329      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
330#else
331        status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
332#endif
[524]333      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
334
335c de_d
[541]336#ifdef NC_DOUBLE
337      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
338#else
339        status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
340#endif
[524]341      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
342
[541]343C**** Coefficient de mellange turbulent *******************************************
[524]344c coefh
345        print*,'LECTURE de coefh a irec =',irec
[541]346#ifdef NC_DOUBLE
347      status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
348#else
349        status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
350#endif
[524]351       call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
[541]352c      call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ   ')
353c      call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ   ')
[524]354
[541]355C**** Flux ascendants et entrant dans le thermique **********************************
356cThermiques
357       print*,'LECTURE de fm_therm a irec =',irec
358#ifdef NC_DOUBLE
359      status=NF_GET_VARA_DOUBLE(ncidp,varidfmth,start,
360     .                         count,fm_therm2)
361#else
362       status=NF_GET_VARA_REAL(ncidp,varidfmth,start,
363     .                         count,fm_therm2)
364#endif
365       call gr_ecrit_fi(kev,kon,iim,jjm+1,fm_therm2,fm_therm)
366       print*,'LECTURE de en_therm a irec =',irec
367#ifdef NC_DOUBLE
368      status=NF_GET_VARA_DOUBLE(ncidp,varidenth,start,
369     .                          count,en_therm2)
370#else
371       status=NF_GET_VARA_REAL(ncidp,varidenth,start,
372     .                          count,en_therm2)
373#endif
374       call gr_ecrit_fi(kev,kon,iim,jjm+1,en_therm2,en_therm)
375
376C**** Coefficients de lessivage *******************************************
377c frac_impa
378#ifdef NC_DOUBLE
379      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
380#else
381        status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
382#endif
383      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
384
385c frac_nucl
386
387#ifdef NC_DOUBLE
388      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
389#else
390        status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
391#endif
392      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
393
394C**** Vents aux sol ********************************************
395
[524]396      start(3)=irec
397      start(4)=0
398      count(3)=1
399      count(4)=0
400
401c pyu1
402        print*,'LECTURE de yu1 a irec =',irec
[541]403#ifdef NC_DOUBLE
404      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
405#else
406        status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
407#endif
[524]408      call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
409
410c pyv1
411        print*,'LECTURE de yv1 a irec =',irec
[541]412#ifdef NC_DOUBLE
413      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
414#else
415        status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
416#endif
[524]417      call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
418
[541]419C**** Temerature au sol ********************************************
[524]420c ftsol1
421        print*,'LECTURE de ftsol1 a irec =',irec
[541]422#ifdef NC_DOUBLE
423      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
424#else
[524]425      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
[541]426#endif
[524]427       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
428
429c ftsol2
430        print*,'LECTURE de ftsol2 a irec =',irec
[541]431#ifdef NC_DOUBLE
432      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
433#else
[524]434      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
[541]435#endif
[524]436      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
437
438c ftsol3
439         print*,'LECTURE de ftsol3 a irec =',irec
[541]440#ifdef NC_DOUBLE
441      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
442#else
[524]443      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
[541]444#endif
[524]445      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
446
447c ftsol4
[541]448#ifdef NC_DOUBLE
449      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
450#else
[524]451      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
[541]452#endif
[524]453      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
454
[541]455C**** Nature sol ********************************************
[524]456c psrf1
[541]457#ifdef NC_DOUBLE
458      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
459#else
[524]460      status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
[541]461#endif
[524]462c      call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
463      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
464
465c psrf2
[541]466#ifdef NC_DOUBLE
467      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
468#else
[524]469      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
[541]470#endif
[524]471c      call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
472      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
473
474c psrf3
[541]475#ifdef NC_DOUBLE
476      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
477#else
[524]478      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
[541]479#endif
[524]480      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
481
482c psrf4
[541]483#ifdef NC_DOUBLE
484      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
485#else
[524]486      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
[541]487#endif
[524]488      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
489       
490          do i = 1,kon
491       
492        psrf(i,1) = psrf1(i)
493        psrf(i,2) = psrf2(i)
494        psrf(i,3) = psrf3(i)
[541]495c test abderr
496c       print*,'Dans read_pstoke psrf3 =',psrf3(i),i
[524]497        psrf(i,4) = psrf4(i)
498 
499        ftsol(i,1) = ftsol1(i)
500        ftsol(i,2) = ftsol2(i)
501        ftsol(i,3) = ftsol3(i)
502        ftsol(i,4) = ftsol4(i)
503       
504          enddo
505       
506        endif
507       
508        return
509       
510        end
511
Note: See TracBrowser for help on using the repository browser.