source: IOIPSL/trunk/example/testhist2.f90 @ 386

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

Added CeCILL License information

  • Property svn:keywords set to Id
File size: 3.8 KB
Line 
1PROGRAM testhist2
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 HIST.
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,PARAMETER :: iim=12,jjm=10,llm=2
17!
18  REAL :: champ1(iim,jjm), champ(iim,jjm), champ2(iim,jjm)
19  REAL :: lon(iim,jjm),lat(iim,jjm), lev(llm)
20  REAL :: x
21!
22  INTEGER :: i, j, l, id, id2, sig_id, hori_id, it
23  INTEGER :: day=1, month=1, year=1997
24  INTEGER :: itau=0, start, index(1)
25!
26  REAL :: julday, un_mois, un_an
27  REAL :: deltat=86400, dt_wrt, dt_op, dt_wrt2, dt_op2
28  CHARACTER(LEN=20) :: histname
29!
30  REAL :: pi=3.1415
31!---------------------------------------------------------------------
32!-
33! 0.0 Choose a 360 days calendar
34!-
35  CALL ioconf_calendar('gregorian')
36!-
37! 1.0 Define a few variables we will need.
38!     These are the coordinates the file name and the date.
39!-
40  DO i=1,iim
41    DO j=1,jjm
42      lon(i,j) = ((float(iim/2)+0.5)-float(i))*pi/float(iim/2) &
43 &              *(-1.)*180./pi
44      lat(i,j) = 180./pi * ASIN(((float(jjm/2)+0.5)-float(j)) &
45 &              /float(jjm/2))
46    ENDDO
47  ENDDO
48!-
49  DO l=1,llm
50    lev(l) = float(l)/llm
51  ENDDO
52!-
53  histname = 'testhist2.nc'
54!-
55! 1.1 The chosen date is 15 Feb. 1997 as stated above.
56!     It has to be transformed into julian days using
57!     the calendar provided by IOIPSL.
58!-
59  CALL ymds2ju(year, month, day, 0.,julday)
60  CALL ioget_calendar(un_an)
61  un_mois = un_an/12.
62  dt_wrt = un_mois*deltat
63  dt_op = deltat
64  dt_wrt2 = -1.
65  dt_op2 = deltat
66!-
67! 2.0 Do all the declarations for hist. That is define the file,
68!     the vertical coordinate and the variables in the file.
69!     Monthly means are written to test this feature
70!-
71  CALL ioconf_modname ('testhist2 produced this file')
72!-
73  CALL histbeg (histname,iim,lon,jjm,lat, &
74 &       1,iim,1,jjm,itau,julday,deltat,hori_id,id)
75!-
76  CALL histvert (id,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
77!-
78  CALL histdef (id,"champ1","Some field","m", &
79 &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt)
80!-
81  CALL histdef (id,"champ2","summed field","m", &
82 &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt)
83!-
84  CALL histend (id)
85!-
86! Open a second file which will do monthly means using the -1 notation.
87!-
88  histname = 'testhist2_bis.nc'
89  CALL histbeg (histname,iim,lon,jjm,lat, &
90 &       1,iim,1,jjm,itau,julday,deltat,hori_id,id2)
91!-
92  CALL histvert (id2,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
93!-
94  CALL histdef (id2,"champ1","Some field","m", &
95 &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2)
96!-
97  CALL histdef (id2,"champ2","summed field","m", &
98 &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2)
99!-
100  CALL histend (id2)
101!-
102! 2.1 The filed we are going to write are computes
103!-
104  CALL RANDOM_NUMBER(HARVEST=x)
105  CALL RANDOM_NUMBER(champ)
106  champ = champ*2*pi
107  champ1 = sin(champ)
108  champ2(:,:) = 1.
109!-
110! 3.0 Start the time steping and write the data as we go along.
111!-
112  start = 1
113!-
114  DO it=1,730
115!---
116!   3.1 In the 2D filed we will have a set of random numbers
117!       which move through the map.
118!---
119    itau = itau+1
120!---
121!   3.2 Pass the data to HIST for operation and writing.
122!---
123    CALL histwrite (id, "champ1",itau,champ1,iim*jjm,index)
124    CALL histwrite (id2,"champ1",itau,champ1,iim*jjm,index)
125    CALL histwrite (id, "champ2",itau,champ2,iim*jjm,index)
126    CALL histwrite (id2,"champ2",itau,champ2,iim*jjm,index)
127!---
128    champ1 = sin((it+1)*champ)
129  ENDDO
130!-
131! 4.0 The HIST routines are ended and netCDF is closed
132!-
133  CALL histclo ()
134!--------------------
135END PROGRAM testhist2
Note: See TracBrowser for help on using the repository browser.