# Changeset 122 for IOIPSL/trunk/example/testrest.f90

Ignore:
Timestamp:
08/03/07 15:42:20 (15 years ago)
Message:

JB: some cleaning (-> fortran 90)

File:
1 edited

Unmodified
Added
Removed
• ## IOIPSL/trunk/example/testrest.f90

 r16 !- !\$Id\$ ! !--------------------------------------------------------------------- !- This program provide a an example of the basic usage of REST. !- Here the test the time sampling and averaging. Thus a long !- time-series is produced and sampled in different ways. !--------------------------------------------------------------------- USE ioipsl ! !     This program provide a an example of the basic usage of REST. !     Here the test the time sampling and averaging. Thus a long !     time-series is produced and sampled in different ways. ! ! IMPLICIT NONE ! INTEGER :: iim, jjm, llm ! INTEGER :: iim,jjm,llm PARAMETER (iim=12,jjm=10,llm=2) ! REAL :: champ1(iim,jjm,llm), champ2(iim,jjm,llm+1), champ3(iim,jjm,llm) ! REAL :: champ1(iim,jjm,llm),champ2(iim,jjm,llm+1),champ3(iim,jjm,llm) REAL :: champ4(iim,jjm) REAL :: champ_read(iim,jjm,llm) REAL :: lon(iim,jjm),lat(iim,jjm), lev(llm) REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm) REAL :: x ! INTEGER :: i, j, l, fid, t, ij, sig_id, hori_id, it INTEGER :: day=1, month=1, year=1997 INTEGER :: itau=1, start, INDEX(1) ! REAL :: julday, un_mois, un_an REAL :: deltat=86400, dt_wrt, dt_op, dt_wrt2, dt_op2 CHARACTER*20 :: fnamein, fnameout, keyword, value ! ! INTEGER :: i,j,l,fid,t,ij,sig_id,hori_id,it INTEGER :: day=1,month=1,year=1997 INTEGER :: itau=1,start,INDEX(1) ! REAL :: julday,un_mois,un_an REAL :: deltat=86400,dt_wrt,dt_op,dt_wrt2,dt_op2 CHARACTER*20 :: fnamein,fnameout,keyword,value ! REAL :: pi=3.1415 ! !     0.0 Choose a  gregorian calendar ! CALL ioconf_calendar('gregorian') ! !     1.0 Define a few variables we will need. These are the coordinates !         the file name and the date. ! DO i = 1, iim DO j = 1, jjm lon(i,j) = ((float(iim/2)+0.5)-float(i))*pi/float(iim/2) & &           *(-1.)*180./pi lat(i,j) = 180./pi * ASIN(((float(jjm/2)+0.5) - float(j)) & &           /float(jjm/2)) !--------------------------------------------------------------------- !- ! 0.0 Choose a  gregorian calendar !- CALL ioconf_calendar ('gregorian') !- ! 1.0 Define a few variables we will need. !     These are the coordinates the file name and the date. !- DO i=1,iim DO j=1,jjm lon(i,j) = & &     ((float(iim/2)+0.5)-float(i))*pi/float(iim/2)*(-1.)*180./pi lat(i,j) = & &     (180./pi)*ASIN(((float(jjm/2)+0.5)-float(j))/float(jjm/2)) ENDDO ENDDO ! !- DO l=1,llm lev(l) = float(l)/llm ENDDO ! !    1.1 The chosen date is 15 Feb. 1997 as stated above. It has to be !         transformed into julian days using the calendar provided by !         IOIPSL. ! CALL ymds2ju(year, month, day, 0.,julday) CALL ioget_calendar(un_an) !- ! 1.1 The chosen date is 15 Feb. 1997 as stated above. It has to be !     transformed into julian days using the calendar provided by !     IOIPSL. !- CALL ymds2ju (year,month,day,0.,julday) CALL ioget_calendar (un_an) un_mois = un_an/12. dt_wrt = un_mois*deltat dt_wrt2 = -1. dt_op2 = deltat ! ! !- fnamein = 'NONE' fnameout = 'restfile' ! ! 2.0 Create a restart file from nothing ! ! CALL restini(fnamein, iim, jjm, lon, lat, llm, lev, fnameout, & &     itau, julday, deltat, fid) ! !- ! 2.0 Create a restart file from nothing ! !- CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, & &              itau,julday,deltat,fid) !- champ1(:,:,:) = ASIN(1.0) champ2(:,:,:) = EXP(ASIN(1.0)) ! CALL ioconf_setatt('units', '?') CALL ioconf_setatt('long_name', 'Tests 1 for a real variable') CALL restput(fid, 'test1', iim, jjm, llm, itau, champ1) ! CALL ioconf_setatt('units', '?') CALL ioconf_setatt('long_name', 'Tests 2 for a real variable') CALL restput(fid, 'test2', iim, jjm, llm+1, itau, champ2) ! CALL restclo() ! !- CALL ioconf_setatt ('units','?') CALL ioconf_setatt ('long_name','Tests 1 for a real variable') CALL restput (fid,'test1',iim,jjm,llm,itau,champ1) !- CALL ioconf_setatt ('units','?') CALL ioconf_setatt ('long_name','Tests 2 for a real variable') CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2) !- CALL restclo () !- WRITE(*,*) '============== FIRST FILE CLOSED ==============' ! !  3.0 Reopen the restart file and check that the values read are correct ! !- !  3.0 Reopen the restart file and check that the values read are correct !- fnamein = 'restfile' fnameout = 'restfilebis' ! ! CALL restini(fnamein, iim, jjm, lon, lat, llm, lev, fnameout, & &     itau, julday, deltat, fid) ! CALL restget(fid, 'test1', iim, jjm, llm,itau, .FALSE., champ_read) ! !- CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, & &              itau,julday,deltat,fid) !- CALL restget (fid,'test1',iim,jjm,llm,itau,.FALSE.,champ_read) !- itau = itau+10 CALL restput(fid, 'test1', iim, jjm, llm, itau, champ_read) CALL restput(fid, 'test2', iim, jjm, llm+1, itau, champ2) ! itau = itau + 10 champ3(:,:,:) = champ_read(:,:,:) + champ2(:,:,1:llm) CALL restput(fid, 'test1', iim, jjm, llm, itau, champ3) ! CALL restclo() ! CALL restput (fid,'test1',iim,jjm,llm,itau,champ_read) CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2) !- itau = itau+10 champ3(:,:,:) = champ_read(:,:,:)+champ2(:,:,1:llm) CALL restput (fid,'test1',iim,jjm,llm,itau,champ3) !- CALL restclo () !- WRITE(*,'(a25,e36.30)') 'The input data : ',champ1(1,1,1) WRITE(*,'(a25,e36.30)') 'The restart data : ',champ_read(1,1,1) ! !  4.0 Reopen the restart file and add another time step ! !- !  4.0 Reopen the restart file and add another time step !- fnamein = 'restfilebis' fnameout = 'restfilebis' ! ! CALL restini(fnamein, iim, jjm, lon, lat, llm, lev, fnameout, & &     itau, julday, deltat, fid) ! itau = itau + 10 CALL restput(fid, 'test1', iim, jjm, llm, itau, champ1) CALL ioconf_setatt('units', '?') CALL ioconf_setatt('long_name', 'Test a variable with another dimension') CALL restput(fid, 'test4', iim, jjm, 0, itau, champ4) ! CALL restclo() ! STOP ! !- CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, & &              itau,julday,deltat,fid) !- itau = itau+10 CALL restput (fid,'test1',iim,jjm,llm,itau,champ1) CALL ioconf_setatt ('units','?') CALL ioconf_setatt ('long_name', & &                    'Test a variable with another dimension') CALL restput (fid,'test4',iim,jjm,0,itau,champ4) !- CALL restclo () !------------------- END PROGRAM testrest
Note: See TracChangeset for help on using the changeset viewer.