source: LMDZ6/branches/Amaury_dev/libf/phylmd/read_pstoke.F90 @ 5218

Last change on this file since 5218 was 5110, checked in by abarral, 5 months ago

Rename modules properly (mod_* -> lmdz_*) in phy_common

  • 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: 14.2 KB
RevLine 
[1992]1
[1403]2! $Id: read_pstoke.F90 5110 2024-07-24 09:19:08Z abarral $
[524]3
4
[1403]5
[1992]6SUBROUTINE read_pstoke(irec, zrec, zklono, zklevo, airefi, phisfi, t, mfu, &
7    mfd, en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, &
8    frac_nucl, 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 de traceurs sur une grille 2x plus fine
14  ! que
15  ! celle online
16  ! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
17  ! ******************************************************************************
[524]18
[5088]19  USE netcdf, ONLY: nf90_open,nf90_inq_varid,nf90_nowrite,nf90_get_var,nf90_inquire_dimension,&
20          nf90_inq_dimid
[1992]21  USE dimphy
22  USE indice_sol_mod
[5110]23  USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev
[524]24
[1992]25  IMPLICIT NONE
[524]26
[1992]27  INTEGER klono, klevo, imo, jmo
[2343]28!  PARAMETER (imo=iim/2, jmo=(jjm+1)/2)
29!  PARAMETER (klono=(jmo-1)*imo+2, klevo=llm)
30  REAL :: phisfi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !phisfi(klono)
31  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(imo,jmo+1)
32  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(imo, jmo+1)
[524]33
[2343]34  REAL :: mfu(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfu(klono, klevo)
35  REAL :: mfd(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfd(klono, klevo)
36  REAL :: en_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_u(klono, klevo)
37  REAL :: de_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_u(klono, klevo)
38  REAL :: en_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_d(klono, klevo)
39  REAL :: de_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_d(klono, klevo)
40  REAL :: coefh(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !coefh(klono, klevo)
41  REAL :: fm_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !fm_therm(klono, klevo)
42  REAL :: en_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_therm(klono, klevo)
[524]43
[2343]44  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(imo, jmo+1, klevo)
45  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(imo, jmo+1, klevo)
46  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(imo, jmo+1, klevo)
47  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(imo, jmo+1, klevo)
48  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(imo, jmo+1, klevo)
49  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(imo, jmo+1, klevo)
50  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(imo, jmo+1, klevo)
51  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(imo, jmo+1, klevo)
52  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(imo, jmo+1, klevo)
[524]53
[2343]54  REAL,ALLOCATABLE :: pl(:) !pl(klevo)
[1992]55  INTEGER irec
56  INTEGER xid, yid, zid, tid
57  REAL zrec, zklono, zklevo, zim, zjm
58  INTEGER ncrec, ncklono, ncklevo, ncim, ncjm
[524]59
[2343]60  REAL :: airefi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !airefi(klono)
[1992]61  CHARACTER *20 namedim
[524]62
[1992]63  ! !! attention !!
64  ! attention il y a aussi le pb de def klono
65  ! dim de phis??
[524]66
67
[2343]68  REAL :: frac_impa(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_impa(klono, klevo)
69  REAL :: frac_nucl(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_nucl(klono, klevo)
70  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(imo, jmo+1, klevo)
71  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(imo, jmo+1, klevo)
72  REAL :: pyu1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyu1(klono)
73  REAL :: pyv1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyv1(klono)
74  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(imo, jmo+1), pyv12(imo, jmo+1)
75  REAL :: ftsol(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !ftsol(klono, nbsrf)
76  REAL :: psrf(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !psrf(klono, nbsrf)
77  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(klono), ftsol2(klono)
78  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(klono), ftsol4(klono)
79  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(klono), psrf2(klono)
80  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(klono), psrf4(klono)
81  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(imo, jmo+1)
82  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(imo, jmo+1)
83  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(imo, jmo+1)
84  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(imo, jmo+1)
85  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(imo, jmo+1)
86  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(imo, jmo+1)
87  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(imo, jmo+1)
88  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(imo, jmo+1)
89  REAL :: t(((nbp_lon/2)-1)*(nbp_lat/2)+2,nbp_lev) !t(klono, klevo)
90  REAL,ALLOCATABLE :: t2(:,:,:) !t2(imo, jmo+1, klevo)
91  INTEGER,SAVE :: ncidp
92  INTEGER,SAVE :: varidt
93  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
94  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
95  INTEGER,SAVE :: varidfmth, varidenth
96  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
97  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
98  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
[524]99
[1992]100  INTEGER l, i
101  INTEGER start(4), count(4), status
102  REAL rcode
[2343]103  LOGICAL,SAVE :: first=.TRUE.
[524]104
[2343]105  ! Allocate arrays
106  imo=nbp_lon/2
107  jmo=nbp_lat/2
108  klono=(jmo-1)*imo+2
109  klevo=nbp_lev
110 
111  ALLOCATE(phisfi2(imo,jmo+1))
112  ALLOCATE(airefi2(imo, jmo+1))
113  ALLOCATE(mfu2(imo, jmo+1, klevo))
114  ALLOCATE(mfd2(imo, jmo+1, klevo))
115  ALLOCATE(en_u2(imo, jmo+1, klevo))
116  ALLOCATE(de_u2(imo, jmo+1, klevo))
117  ALLOCATE(en_d2(imo, jmo+1, klevo))
118  ALLOCATE(de_d2(imo, jmo+1, klevo))
119  ALLOCATE(coefh2(imo, jmo+1, klevo))
120  ALLOCATE(fm_therm2(imo, jmo+1, klevo))
121  ALLOCATE(en_therm2(imo, jmo+1, klevo))
122  ALLOCATE(pl(klevo))
123  ALLOCATE(frac_impa2(imo, jmo+1, klevo))
124  ALLOCATE(frac_nucl2(imo, jmo+1, klevo))
125  ALLOCATE(pyu12(imo, jmo+1), pyv12(imo, jmo+1))
126  ALLOCATE(ftsol1(klono), ftsol2(klono))
127  ALLOCATE(ftsol3(klono), ftsol4(klono))
128  ALLOCATE(psrf1(klono), psrf2(klono))
129  ALLOCATE(psrf3(klono), psrf4(klono))
130  ALLOCATE(ftsol12(imo, jmo+1))
131  ALLOCATE(ftsol22(imo, jmo+1))
132  ALLOCATE(ftsol32(imo, jmo+1))
133  ALLOCATE(ftsol42(imo, jmo+1))
134  ALLOCATE(psrf12(imo, jmo+1))
135  ALLOCATE(psrf22(imo, jmo+1))
136  ALLOCATE(psrf32(imo, jmo+1))
137  ALLOCATE(psrf42(imo, jmo+1))
138  ALLOCATE(t2(imo, jmo+1, klevo))
[524]139
[1992]140  ! ---------------------------------------------
141  ! Initialisation de la lecture des fichiers
142  ! ---------------------------------------------
[541]143
[1992]144  IF (irec==0) THEN
[524]145
[1992]146    rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp)
[524]147
[1992]148    rcode = nf90_inq_varid(ncidp, 'phis', varidps)
149    PRINT *, 'ncidp,varidps', ncidp, varidps
[524]150
[1992]151    rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
152    PRINT *, 'ncidp,varidpl', ncidp, varidpl
[524]153
[1992]154    rcode = nf90_inq_varid(ncidp, 'aire', varidai)
155    PRINT *, 'ncidp,varidai', ncidp, varidai
[541]156
[1992]157    ! A FAIRE: Es-il necessaire de stocke t?
158    rcode = nf90_inq_varid(ncidp, 't', varidt)
159    PRINT *, 'ncidp,varidt', ncidp, varidt
[541]160
[1992]161    rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
162    PRINT *, 'ncidp,varidmfu', ncidp, varidmfu
[524]163
[1992]164    rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
165    PRINT *, 'ncidp,varidmfd', ncidp, varidmfd
[524]166
[1992]167    rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
168    PRINT *, 'ncidp,varidenu', ncidp, varidenu
[524]169
[1992]170    rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
171    PRINT *, 'ncidp,variddeu', ncidp, variddeu
[524]172
[1992]173    rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
174    PRINT *, 'ncidp,varidend', ncidp, varidend
[524]175
[1992]176    rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
177    PRINT *, 'ncidp,varidded', ncidp, varidded
178
179    rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
180    PRINT *, 'ncidp,varidch', ncidp, varidch
181
182    ! abder (pour thermiques)
183    rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
184    PRINT *, 'ncidp,varidfmth', ncidp, varidfmth
185
186    rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
187    PRINT *, 'ncidp,varidenth', ncidp, varidenth
188
189    rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
190    PRINT *, 'ncidp,varidfi', ncidp, varidfi
191
192    rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
193    PRINT *, 'ncidp,varidfn', ncidp, varidfn
194
195    rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
196    PRINT *, 'ncidp,varidyu1', ncidp, varidyu1
197
198    rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
199    PRINT *, 'ncidp,varidyv1', ncidp, varidyv1
200
201    rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
202    PRINT *, 'ncidp,varidfts1', ncidp, varidfts1
203
204    rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
205    PRINT *, 'ncidp,varidfts2', ncidp, varidfts2
206
207    rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
208    PRINT *, 'ncidp,varidfts3', ncidp, varidfts3
209
210    rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
211    PRINT *, 'ncidp,varidfts4', ncidp, varidfts4
212
213    rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
214    PRINT *, 'ncidp,varidpsr1', ncidp, varidpsr1
215
216    rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
217    PRINT *, 'ncidp,varidpsr2', ncidp, varidpsr2
218
219    rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
220    PRINT *, 'ncidp,varidpsr3', ncidp, varidpsr3
221
222    rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
223    PRINT *, 'ncidp,varidpsr4', ncidp, varidpsr4
224
225    ! ID pour les dimensions
226
[5088]227    status = nf90_inq_dimid(ncidp, 'y', yid)
228    status = nf90_inq_dimid(ncidp, 'x', xid)
229    status = nf90_inq_dimid(ncidp, 'sig_s', zid)
230    status = nf90_inq_dimid(ncidp, 'time_counter', tid)
[1992]231
232    ! lecture des dimensions
233
[5088]234    status = nf90_inquire_dimension(ncidp, yid, namedim, ncjm)
235    status = nf90_inquire_dimension(ncidp, xid, namedim, ncim)
236    status = nf90_inquire_dimension(ncidp, zid, namedim, ncklevo)
237    status = nf90_inquire_dimension(ncidp, tid, namedim, ncrec)
[1992]238
239    zrec = ncrec
240    zklevo = ncklevo
241    zim = ncim
242    zjm = ncjm
243
244    zklono = zim*(zjm-2) + 2
245
246    WRITE (*, *) 'read_pstoke : zrec = ', zrec
247    WRITE (*, *) 'read_pstoke : zklevo = ', zklevo
248    WRITE (*, *) 'read_pstoke : zim = ', zim
249    WRITE (*, *) 'read_pstoke : zjm = ', zjm
250    WRITE (*, *) 'read_pstoke : zklono = ', zklono
251
252    ! niveaux de pression
[4262]253    status = nf90_get_var(ncidp, varidpl, pl, [1], [ncklevo])
[524]254
[1992]255    ! lecture de aire et phis
[524]256
[1992]257    start(1) = 1
258    start(2) = 1
259    start(3) = 1
260    start(4) = 0
[524]261
[1992]262    count(1) = zim
263    count(2) = zjm
264    count(3) = 1
265    count(4) = 0
266
267    ! phis
[4254]268    status = nf90_get_var(ncidp, varidps, phisfi2, start, count)
[1992]269    CALL gr_ecrit_fi(1, klono, imo, jmo+1, phisfi2, phisfi)
[524]270
[1992]271    ! aire
[4254]272    status = nf90_get_var(ncidp, varidai, airefi2, start, count)
[1992]273    CALL gr_ecrit_fi(1, klono, imo, jmo+1, airefi2, airefi)
274  ELSE
[524]275
[1992]276    PRINT *, 'ok1'
[524]277
[1992]278    ! ---------------------
279    ! lecture des champs
280    ! ---------------------
[524]281
[1992]282    PRINT *, 'WARNING!!! Il n y a pas de test de coherence'
283    PRINT *, 'sur le nombre de niveaux verticaux dans le fichier nc'
[524]284
[1992]285    start(1) = 1
286    start(2) = 1
287    start(3) = 1
288    start(4) = irec
[524]289
[1992]290    count(1) = zim
291    count(2) = zjm
292    count(3) = zklevo
293    count(4) = 1
[541]294
[1992]295
296    ! *** Lessivage******************************************************
297    ! frac_impa
[4254]298    status = nf90_get_var(ncidp, varidfi, frac_impa2, start, count)
[1992]299    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, frac_impa2, frac_impa)
[524]300
[1992]301    ! frac_nucl
[4254]302    status = nf90_get_var(ncidp, varidfn, frac_nucl2, start, count)
[1992]303    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, frac_nucl2, frac_nucl)
[524]304
[1992]305    ! *** Temperature ******************************************************
306    ! abder t
[4254]307    status = nf90_get_var(ncidp, varidt, t2, start, count)
[1992]308    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, t2, t)
[524]309
[1992]310    ! *** Flux pour le calcul de la convection TIEDTK ***********************
311    ! mfu
[4254]312    status = nf90_get_var(ncidp, varidmfu, mfu2, start, count)
[1992]313    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, mfu2, mfu)
[524]314
[1992]315    ! mfd
[4254]316    status = nf90_get_var(ncidp, varidmfd, mfd2, start, count)
[1992]317    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, mfd2, mfd)
[524]318
[1992]319    ! en_u
[4254]320    status = nf90_get_var(ncidp, varidenu, en_u2, start, count)
[1992]321    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_u2, en_u)
[524]322
[1992]323    ! de_u
[4254]324    status = nf90_get_var(ncidp, variddeu, de_u2, start, count)
[1992]325    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, de_u2, de_u)
[524]326
[1992]327    ! en_d
[4254]328    status = nf90_get_var(ncidp, varidend, en_d2, start, count)
[1992]329    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_d2, en_d)
[524]330
[1992]331    ! de_d
[4254]332    status = nf90_get_var(ncidp, varidded, de_d2, start, count)
[1992]333    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, de_d2, de_d)
[524]334
[1992]335    ! **** Coeffecient du mellange
336    ! turbulent**********************************
337    ! coefh
[4254]338    status = nf90_get_var(ncidp, varidch, coefh2, start, count)
[1992]339    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, coefh2, coefh)
[524]340
[1992]341    ! *** Flux ascendant et entrant pour les
342    ! Thermiques************************
343    ! abder thermiques
[4254]344    status = nf90_get_var(ncidp, varidfmth, fm_therm2, start, count)
[1992]345    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, fm_therm2, fm_therm)
[541]346
[4254]347    status = nf90_get_var(ncidp, varidenth, en_therm2, start, count)
[1992]348    CALL gr_ecrit_fi(klevo, klono, imo, jmo+1, en_therm2, en_therm)
[541]349
[1992]350    ! *** Vitesses aux sol
351    ! ******************************************************
352    start(3) = irec
353    start(4) = 0
354    count(3) = 1
355    count(4) = 0
356    ! pyu1
[4254]357    status = nf90_get_var(ncidp, varidyu1, pyu12, start, count)
[1992]358    CALL gr_ecrit_fi(1, klono, imo, jmo+1, pyu12, pyu1)
[524]359
[1992]360    ! pyv1
[4254]361    status = nf90_get_var(ncidp, varidyv1, pyv12, start, count)
[1992]362    CALL gr_ecrit_fi(1, klono, imo, jmo+1, pyv12, pyv1)
[524]363
[1992]364    ! *** Temperature au sol ********************************************
365    ! ftsol1
[4254]366    status = nf90_get_var(ncidp, varidfts1, ftsol12, start, count)
[1992]367    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol12, ftsol1)
[524]368
[1992]369    ! ftsol2
[4254]370    status = nf90_get_var(ncidp, varidfts2, ftsol22, start, count)
[1992]371    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol22, ftsol2)
[524]372
[1992]373    ! ftsol3
[4254]374    status = nf90_get_var(ncidp, varidfts3, ftsol32, start, count)
[1992]375    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol32, ftsol3)
[524]376
[1992]377    ! ftsol4
[4254]378    status = nf90_get_var(ncidp, varidfts4, ftsol42, start, count)
[1992]379    CALL gr_ecrit_fi(1, klono, imo, jmo+1, ftsol42, ftsol4)
[524]380
[1992]381    ! *** Nature du sol **************************************************
382    ! psrf1
[4254]383    status = nf90_get_var(ncidp, varidpsr1, psrf12, start, count)
[1992]384    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf12, psrf1)
[524]385
[1992]386    ! psrf2
[4254]387    status = nf90_get_var(ncidp, varidpsr2, psrf22, start, count)
[1992]388    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf22, psrf2)
[524]389
[1992]390    ! psrf3
[4254]391    status = nf90_get_var(ncidp, varidpsr3, psrf32, start, count)
[1992]392    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf32, psrf3)
[524]393
[1992]394    ! psrf4
[4254]395    status = nf90_get_var(ncidp, varidpsr4, psrf42, start, count)
[1992]396    CALL gr_ecrit_fi(1, klono, imo, jmo+1, psrf42, psrf4)
[524]397
[1992]398    DO i = 1, klono
399
400      psrf(i, 1) = psrf1(i)
401      psrf(i, 2) = psrf2(i)
402      psrf(i, 3) = psrf3(i)
403      psrf(i, 4) = psrf4(i)
404
405      ftsol(i, 1) = ftsol1(i)
406      ftsol(i, 2) = ftsol2(i)
407      ftsol(i, 3) = ftsol3(i)
408      ftsol(i, 4) = ftsol4(i)
409
410    END DO
411
412  END IF
413
414
[5105]415
[1992]416END SUBROUTINE read_pstoke
417
Note: See TracBrowser for help on using the repository browser.