source: LMDZ5/trunk/libf/phylmd/read_pstoke0.F90 @ 3373

Last change on this file since 3373 was 2345, checked in by Ehouarn Millour, 9 years ago

Physics/dynamics separation:

  • move test_disvert_m to dynlonlat_phylonlat/phylmd since it is only used by ce0l and relies on dynamics.
  • put "config_inca" in tracinca_mod so physics routines can get the info from there rather than from control_mod.
  • get rid of references to "control_mod" from within the physics.

EM

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