source: trunk/SRC/ReadWrite/readoldoparestart.pro @ 226

Last change on this file since 226 was 226, checked in by pinsard, 17 years ago

corrections of some misspellings in some *.pro
  • Property svn:keywords set to Id
File size: 12.2 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5;
6; @categories
7; For OPA
8;
9; @param UNIT
10;
11;
12; @param PARAMS
13;
14; @param NUM
15;
16; @restrictions
17; bug for etab and etan written on the same record???
18;
19; @history
20; Sebastien Masson (smasson\@lodyc.jussieu.fr)
21;                      June 2002
22;
23; @version
24; $Id$
25;-
26;------------------------------------------------------------
27;------------------------------------------------------------
28;------------------------------------------------------------
29
30
31FUNCTION read2fromopa, unit, params, num
32;
33  compile_opt idl2, strictarrsubs
34;
35   offset=params.reclen*params.jpk*(num-1L)
36   a=assoc(unit,dblarr(params.jpiglo,params.jpjglo,/nozero),offset)
37   return, a[0]
38end
39;+
40; @categories
41; For OPA
42;
43; @param UNIT
44;
45;
46; @param PARAMS
47;
48; @param NUM
49;
50; @history
51; Sebastien Masson (smasson\@lodyc.jussieu.fr)
52;                      June 2002
53;-
54FUNCTION read3fromopa, unit, params, num
55;
56  compile_opt idl2, strictarrsubs
57;
58   offset=params.reclen*params.jpk*(num-1L)
59   a=assoc(unit,dblarr(params.jpiglo,params.jpjglo,params.jpk,/nozero),offset)
60   return, a[0]
61end
62
63;+
64; @file_comments
65; read the old restart files of OPA (before NetCDF)
66; based on the OPA subroutine dtrlec included at the end of the file.
67;
68; @categories
69; For OPA
70;
71; @param FILENAME {in}{required}
72; with the whole path if necessary
73;
74; @param JPIGLO {in}{required}
75;
76; @param JPJGLO {in}{required}
77;
78; @param JPK {in}{required}
79; dimensions of the opa grid
80;
81; @keyword IBLOC {default=4096L}
82; Ibloc size
83;
84; @keyword JPBYT {default=8L}
85; Jpbyt size
86;
87; @keyword NUMREC {default=19L*jpk}
88; Number of records in the file
89;
90; @keyword UB
91;
92;
93; @keyword VB
94;
95;
96; @keyword TB
97;
98; @keyword SB
99;
100; @keyword ROTB
101;
102; @keyword HDIVB
103;
104; @keyword UN
105;
106; @keyword VN
107;
108; @keyword TN
109;
110; @keyword SN
111;
112; @keyword ROTN
113;
114; @keyword HDIVN
115;
116; @keyword GCX
117;
118; @keyword GCXB
119;
120; @keyword ETAB
121;
122; @keyword ETAN
123;
124; @keyword BSFB
125;
126; @keyword BSFN
127;
128; @keyword BSFD
129;
130; @keyword EN
131; the variable we want to read.
132;
133; @returns
134; According to the given keywords.
135;
136; @restrictions
137; Bug for etab and etan written on the same record???
138;
139; @history
140; Sebastien Masson (smasson\@lodyc.jussieu.fr)
141;                      June 2002
142;
143; @version
144; $Id$
145;-
146
147PRO readoldoparestart, filename, jpiglo, jpjglo, jpk, IBLOC = ibloc, JPBYT = jpbyt, NUMREC = numrec, ub = ub, vb = vb, tb = tb, sb = sb, rotb = rotb, hdivb = hdivb, un = un, vn = vn, tn = tn, sn = sn, rotn = rotn, hdivn = hdivn, gcx = gcx, gcxb = gcxb, etab = etab, etan = etan, bsfb = bsfb, bsfn = bsfn, bsfd = bsfd, en = en
148;
149;
150  compile_opt idl2, strictarrsubs
151;
152   iname_file = findfile(filename)
153   if iname_file[0] EQ '' then begin
154      print, 'Bad file name'
155      return
156   ENDIF ELSE iname_file = iname_file[0]
157; open the file
158   openr,numrst , iname_file, /get_lun, /swap_if_little_endian
159; check the size of the file
160   filepamameters = fstat(numrst)
161; parameter definition
162   IF keyword_set(ibloc) THEN ibloc = long(ibloc) ELSE ibloc = 4096L
163   jpiglo = long(jpiglo)
164   jpjglo = long(jpjglo)
165   jpk = long(jpk)
166   IF keyword_set(jpbyt) THEN jpbyt = long(jpbyt) ELSE jpbyt = 8L
167; record length computation
168   reclen = ibloc*((jpiglo*jpjglo*jpbyt-1 )/ibloc+1)
169   IF keyword_set(numrec) THEN numrec = long(numrec) ELSE numrec = 19L*jpk
170   toomuch = reclen-jpiglo*jpjglo*jpbyt
171; expected size computation
172   size = numrec*reclen-toomuch
173   if size NE filepamameters.size then begin
174      print, 'The size of the file is not the expected one!'
175      print, 'Check your file or the values of ibloc, jpiglo,'
176      print, 'jpjglo, jpk, jpbyt, numrec in this program'
177      return
178   endif
179; first record: six 64-bit integer to read.
180; default definition
181   ino1 = long64(9999)
182   it1 = long64(9999)
183   isor1 = long64(9999)
184   ipcg1 = long64(9999)
185   itke1 = long64(9999)
186   idast1 = long64(9999)
187; read
188   readu, numrst, ino1, it1, isor1, ipcg1, itke1, idast1
189   print, ino1, it1, isor1, ipcg1, itke1, idast1
190; other records
191   params = {jpiglo:jpiglo, jpjglo:jpjglo, jpk:jpk, reclen:reclen}
192;      CALL read3(numrst,ub   ,2 )
193   IF arg_present(ub) THEN ub = read3fromopa(numrst, params, 2)
194;      CALL read3(numrst,vb   ,3 )
195   IF arg_present(vb) THEN vb = read3fromopa(numrst, params, 3)
196;      CALL read3(numrst,tb   ,5 )
197   IF arg_present(tb) THEN tb = read3fromopa(numrst, params, 5)
198;      CALL read3(numrst,sb   ,6 )
199   IF arg_present(sb) THEN sb = read3fromopa(numrst, params, 6)
200;      CALL read3(numrst,rotb ,7 )
201   IF arg_present(rotb) THEN rotb = read3fromopa(numrst, params, 7)
202;      CALL read3(numrst,hdivb,8 )
203   IF arg_present(hdivb) THEN hdivb = read3fromopa(numrst, params, 8)
204;      CALL read3(numrst,un   ,9 )
205   IF arg_present(un) THEN un = read3fromopa(numrst, params, 9)
206;      CALL read3(numrst,vn   ,10)
207   IF arg_present(vn) THEN vn = read3fromopa(numrst, params, 10)
208;      CALL read3(numrst,tn   ,12)
209   IF arg_present(tn) THEN tn = read3fromopa(numrst, params, 12)
210;      CALL read3(numrst,sn   ,13)
211   IF arg_present(sn) THEN sn = read3fromopa(numrst, params, 13)
212;      CALL read3(numrst,rotn ,14)
213   IF arg_present(rotn) THEN rotn = read3fromopa(numrst, params, 14)
214;      CALL read3(numrst,hdivn,15)
215   IF arg_present(hdivn) THEN hdivn = read3fromopa(numrst, params, 15)
216;C
217;C ... Read elliptic solver arrays
218;C
219;      CALL read2(numrst,gcx ,jpk,17)
220   IF arg_present(gcx) THEN gcx = read2fromopa(numrst, params, 17)
221;      CALL read2(numrst,gcxb,jpk,18)
222   IF arg_present(gcxb) THEN gcxb = read2fromopa(numrst, params, 18)
223;C
224;#ifdef key_freesurf_cstvol
225;C
226;C ... free surface formulation (eta)
227;C
228;      CALL read2(numrst,etab ,jpk,4 )
229   IF arg_present(etab) THEN etab = read2fromopa(numrst, params, 4)
230;      CALL read2(numrst,etan ,jpk,4 )
231   IF arg_present(etan) THEN etan = read2fromopa(numrst, params, 4)
232;#  else
233;C
234;C ... Rigid-lid formulation (bsf)
235;C
236;      CALL read2(numrst,bsfb ,jpk,4 )
237   IF arg_present(bsfb) THEN bsfb = read2fromopa(numrst, params, 4)
238;      CALL read2(numrst,bsfn ,jpk,11)
239   IF arg_present(bsfn) THEN bsfn = read2fromopa(numrst, params, 11)
240;      CALL read2(numrst,bsfd ,jpk,16)
241   IF arg_present(bsfd) THEN bsfd  = read2fromopa(numrst, params, 16)
242;#endif
243;#ifdef key_zdftke
244;          CALL read3(numrst,en,19)
245   IF arg_present(en) THEN en = read3fromopa(numrst, params, 19)
246
247
248
249   close, numrst
250   free_lun, numrst
251
252   return
253end
254
255
256
257;CDIR$ LIST
258;      SUBROUTINE dtrlec
259;CCC---------------------------------------------------------------------
260;CCC
261;CCC                       ROUTINE dtrlec
262;CCC                     ******************
263;CCC
264;CCC  Purpose :
265;CCC  --------
266;CCC     Read files for restart
267;CCC
268;CC   Method :
269;CC   -------
270;CC      Read the previous fields on the file numrst
271;CC      the first record indicates previous characteristics
272;CC      after control with the present run, we read :
273;CC      - prognostic variables on the second record
274;CC      - elliptic solver arrays
275;CC     - barotropic stream function arrays (default option)
276;CC       or free surface arrays ("key_freesurf_cstvol" defined)
277;CC      - tke arrays ("key_zdftke" defined)
278;CC      for this last three records,  the previous characteristics
279;CC      could be different with those used in the present run.
280;CC
281;CC   Input :
282;CC   ------
283;CC      common
284;CC            /comrst/          : restart parameter
285;CC            /comctl/          : parameters for the control
286;CC
287;CC   Output :
288;CC   -------
289;CC      common
290;CC            /combef/          : previous fields (before)
291;CC            /comnow/          : present fields (now)
292;CC            /combsf/          : barotropic stream function
293;CC            /comspg/          : surface pressure
294;CC            /comsol/          : diagonal preconditioned conjugate
295;CC
296;CC   Modifications :
297;CC   --------------
298;CC      original  : 91-03 ()
299;CC      additions : 92-01 (M. Imbard)
300;CC                : 92-06 correction restart file (M. Imbard)
301;CC                : 98-02 (M. Guyon) FETI method
302;CC      addition  : 98-05 (G. Roullet) free surface
303;CC----------------------------------------------------------------------
304;CC parameters and commons
305;CC ======================
306;CDIR$ NOLIST
307;#include "parameter.h"
308;#include "common.h"
309;CDIR$ LIST
310;CC----------------------------------------------------------------------
311;CC local declarations
312;CC ==================
313;      INTEGER ji, jj, jk, jl
314;      INTEGER ino0, it0, ipcg0, isor0, itke0
315;      INTEGER ino1, it1, isor1, ipcg1, itke1, idast1
316;CC----------------------------------------------------------------------
317;CC statement functions
318;CC ===================
319;CDIR$ NOLIST
320;#include "stafun.h"
321;CDIR$ LIST
322;CCC---------------------------------------------------------------------
323;CCC  OPA8, LODYC (1997)
324;CCC---------------------------------------------------------------------
325;C
326;C
327;C 0. Initialisations
328;C ------------------
329;C
330;      ino0  = no
331;      it0   = nit000
332;      ipcg0 = 0
333;      isor0 = 0
334;      itke0 = 0
335;      isor0 = nsolv-1
336;      ipcg0 = 2-nsolv
337;#ifdef key_zdftke
338;      itke0 = 1
339;#endif
340;C FETI method
341;      IF (nsolv .EQ. 3) THEN
342;          isor0=2
343;          ipcg0=2
344;      ENDIF
345;C
346;      IF(lwp) THEN
347;          WRITE(numout,*) ' '
348;          WRITE(numout,*) ' *** dtrlec:  beginning of restart'
349;          WRITE(numout,*) ' '
350;          WRITE(numout,*) ' the present run :'
351;          WRITE(numout,*) '   job number : ', no
352;          WRITE(numout,*) '   with nit000 : ', nit000
353;          WRITE(numout,*) '   with pcg option ipcg0 : ', ipcg0
354;          WRITE(numout,*) '   with sor option isor0 : ', isor0
355;          WRITE(numout,*) '   with FETI solver option ipcg0 & isor0 : ',
356;     $        ipcg0,' & ',isor0
357;          WRITE(numout,*) '   with tke option itke0 : ', itke0
358;      ENDIF
359;C
360;C 1. Read numrst
361;C --------------
362;C
363;C ... First record
364;C
365;      READ(numrst,REC=1) ino1, it1, isor1, ipcg1, itke1, idast1
366;C
367;      IF(lwp) THEN
368;          WRITE(numout,*) ' '
369;          WRITE(numout,*) ' READ numrst with '
370;          WRITE(numout,*) '   job number : ', ino1
371;          WRITE(numout,*) '   with time step it : ', it1
372;          WRITE(numout,*) '   with pcg option ipcg1 : ', ipcg1
373;          WRITE(numout,*) '   with sor option isor1 : ', isor1
374;          WRITE(numout,*) '   with tke option itke1 : ', itke1
375;          WRITE(numout,*) '   with FETI solver option ipcg1 + isor1 : ',
376;     $        ipcg1 + isor1
377;          WRITE(numout,*) ' '
378;      ENDIF
379;C
380;C ... Control of date
381;C
382;      IF ( (it0-it1).NE.1 .AND. abs(nrstdt).EQ.1 ) THEN
383;          IF(lwp) THEN
384;              WRITE(numout,*) ' ===>>>> : problem with nit000 for the',
385;     $            ' restart'
386;              WRITE(numout,*) ' =======                              ',
387;     $            ' ======='
388;              WRITE(numout,*) ' we stop. verify the file'
389;              WRITE(numout,*) ' or rerun with the value  0 for the'
390;              WRITE(numout,*) ' control of time parameter  nrstdt'
391;              WRITE(numout,*) ' '
392;          ENDIF
393;          STOP 'dtrlec'
394;      ENDIF
395;      IF ( nrstdt.EQ.1 ) ndate0 = idast1
396;C
397;C ... Read prognostic variables
398;C
399;      CALL read3(numrst,ub   ,2 )
400;      CALL read3(numrst,vb   ,3 )
401;      CALL read3(numrst,tb   ,5 )
402;      CALL read3(numrst,sb   ,6 )
403;      CALL read3(numrst,rotb ,7 )
404;      CALL read3(numrst,hdivb,8 )
405;      CALL read3(numrst,un   ,9 )
406;      CALL read3(numrst,vn   ,10)
407;      CALL read3(numrst,tn   ,12)
408;      CALL read3(numrst,sn   ,13)
409;      CALL read3(numrst,rotn ,14)
410;      CALL read3(numrst,hdivn,15)
411;C
412;C ... Read elliptic solver arrays
413;C
414;      CALL read2(numrst,gcx ,jpk,17)
415;      CALL read2(numrst,gcxb,jpk,18)
416;C
417;#ifdef key_freesurf_cstvol
418;C
419;C ... free surface formulation (eta)
420;C
421;      CALL read2(numrst,etab ,jpk,4 )
422;      CALL read2(numrst,etan ,jpk,4 )
423;#  else
424;C
425;C ... Rigid-lid formulation (bsf)
426;C
427;      CALL read2(numrst,bsfb ,jpk,4 )
428;      CALL read2(numrst,bsfn ,jpk,11)
429;      CALL read2(numrst,bsfd ,jpk,16)
430;#endif
431;C
432;#ifdef key_zdftke
433;C
434;C ... Read tke arrays
435;C
436;      IF(itke1.eq.1) THEN
437;          CALL read3(numrst,en,19)
438;      ELSE
439;          IF(lwp) THEN
440;              WRITE(numout,*) ' ===>>>> : the previous restart file',
441;     $            ' did''nt used  tke scheme'
442;              WRITE(numout,*) ' =======                ======='
443;          ENDIF
444;          nrstdt=2
445;      ENDIF
446;#endif
447;C
448;C
449;      RETURN
450;      END
Note: See TracBrowser for help on using the repository browser.