source: IOIPSL/trunk/example/testrest.f90 @ 3510

Last change on this file since 3510 was 386, checked in by bellier, 16 years ago

Added CeCILL License information

  • Property svn:keywords set to Id
File size: 3.6 KB
Line 
1PROGRAM testrest
2!-
3!$Id$
4!-
5! This software is governed by the CeCILL license
6! See IOIPSL/IOIPSL_License_CeCILL.txt
7!---------------------------------------------------------------------
8!- This program provide a an example of the basic usage of REST.
9!- Here the test the time sampling and averaging. Thus a long
10!- time-series is produced and sampled in different ways.
11!---------------------------------------------------------------------
12  USE ioipsl
13!
14  IMPLICIT NONE
15!
16  INTEGER :: iim,jjm,llm
17  PARAMETER (iim=12,jjm=10,llm=2)
18!
19  REAL :: champ1(iim,jjm,llm),champ2(iim,jjm,llm+1),champ3(iim,jjm,llm)
20  REAL :: champ4(iim,jjm)
21  REAL :: champ_read(iim,jjm,llm)
22  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
23!
24  INTEGER :: i,j,l,fid
25  INTEGER :: day=1,month=1,year=1997,itau=1
26!
27  REAL :: julday,un_mois,un_an
28  REAL :: deltat=86400,dt_wrt,dt_op,dt_wrt2,dt_op2
29  CHARACTER*20 :: fnamein,fnameout
30!
31  REAL :: pi=3.1415
32!---------------------------------------------------------------------
33!-
34! 0.0 Choose a  gregorian calendar
35!-
36  CALL ioconf_calendar ('gregorian')
37!-
38! 1.0 Define a few variables we will need.
39!     These are the coordinates the file name and the date.
40!-
41  DO i=1,iim
42    DO j=1,jjm
43      lon(i,j) = &
44 &     ((float(iim/2)+0.5)-float(i))*pi/float(iim/2)*(-1.)*180./pi
45      lat(i,j) = &
46 &     (180./pi)*ASIN(((float(jjm/2)+0.5)-float(j))/float(jjm/2))
47    ENDDO
48  ENDDO
49!-
50  DO l=1,llm
51    lev(l) = float(l)/llm
52  ENDDO
53!-
54! 1.1 The chosen date is 15 Feb. 1997 as stated above. It has to be
55!     transformed into julian days using the calendar provided by
56!     IOIPSL.
57!-
58  CALL ymds2ju (year,month,day,0.,julday)
59  CALL ioget_calendar (un_an)
60  un_mois = un_an/12.
61  dt_wrt = un_mois*deltat
62  dt_op = deltat
63  dt_wrt2 = -1.
64  dt_op2 = deltat
65!-
66  fnamein = 'NONE'
67  fnameout = 'restfile'
68!-
69! 2.0 Create a restart file from nothing !
70!-
71  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, &
72 &              itau,julday,deltat,fid)
73!-
74  champ1(:,:,:) = ASIN(1.0)
75  champ2(:,:,:) = EXP(ASIN(1.0))
76!-
77  CALL ioconf_setatt ('units','1')
78  CALL ioconf_setatt ('long_name','Tests 1 for a real variable')
79  CALL restput (fid,'test1',iim,jjm,llm,itau,champ1)
80!-
81  CALL ioconf_setatt ('units','1')
82  CALL ioconf_setatt ('long_name','Tests 2 for a real variable')
83  CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2)
84!-
85  CALL restclo ()
86!-
87  WRITE(*,*) '============== FIRST FILE CLOSED =============='
88!-
89!  3.0 Reopen the restart file and check that the values read are correct
90!-
91  fnamein = 'restfile'
92  fnameout = 'restfilebis'
93!-
94  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, &
95 &              itau,julday,deltat,fid)
96!-
97  CALL restget (fid,'test1',iim,jjm,llm,itau,.FALSE.,champ_read)
98!-
99  itau = itau+10
100  CALL restput (fid,'test1',iim,jjm,llm,itau,champ_read)
101  CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2)
102!-
103  itau = itau+10
104  champ3(:,:,:) = champ_read(:,:,:)+champ2(:,:,1:llm) 
105  CALL restput (fid,'test1',iim,jjm,llm,itau,champ3)
106!-
107  CALL restclo ()
108!-
109  WRITE(*,'(a25,e36.30)') 'The input data : ',champ1(1,1,1)
110  WRITE(*,'(a25,e36.30)') 'The restart data : ',champ_read(1,1,1)
111!-
112!  4.0 Reopen the restart file and add another time step
113!-
114  fnamein = 'restfilebis'
115  fnameout = 'restfilebis'
116!-
117  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, &
118 &              itau,julday,deltat,fid)
119!-
120  itau = itau+10
121  CALL restput (fid,'test1',iim,jjm,llm,itau,champ1)
122  CALL ioconf_setatt ('units','1')
123  CALL ioconf_setatt ('long_name', &
124 &                    'Test a variable with another dimension')
125  CALL restput (fid,'test4',iim,jjm,0,itau,champ4)
126!-
127  CALL restclo ()
128!-------------------
129END PROGRAM testrest
Note: See TracBrowser for help on using the repository browser.