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

Last change on this file since 5442 was 1403, checked in by Laurent Fairhead, 14 years ago

Merged LMDZ4V5.0-dev branch changes r1292:r1399 to trunk.

Validation:
Validation consisted in compiling the HEAD revision of the trunk,
LMDZ4V5.0-dev branch and the merged sources and running different
configurations on local and SX8 machines comparing results.

Local machine: bench configuration, 32x24x11, gfortran

  • IPSLCM5A configuration (comparison between trunk and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent
  • MH07 configuration, new physics package (comparison between LMDZ4V5.0-dev branch and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent

SX8 machine (brodie), 96x95x39 on 4 processors:

  • IPSLCM5A configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent
  • MH07 configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent

Changes to the makegcm and create_make_gcm scripts to take into account
main programs in F90 files


Fusion de la branche LMDZ4V5.0-dev (r1292:r1399) au tronc principal

Validation:
La validation a consisté à compiler la HEAD de le trunk et de la banche
LMDZ4V5.0-dev et les sources fusionnées et de faire tourner le modéle selon
différentes configurations en local et sur SX8 et de comparer les résultats

En local: 32x24x11, config bench/gfortran

  • pour une config IPSLCM5A (comparaison tronc/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux (à part sur RN et Pb)
    • fichiers histoire égaux
  • pour une config nlle physique (MH07) (comparaison LMDZ4v5.0-dev/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux
    • fichiers histoire équivalents

Sur brodie, 96x95x39 sur 4 proc:

  • pour une config IPSLCM5A:
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc
  • pour une config MH07
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc

Changement sur makegcm et create_make-gcm pour pouvoir prendre en compte des
programmes principaux en *F90

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