Changeset 122 for IOIPSL/trunk/example


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

JB: some cleaning (-> fortran 90)

File:
1 edited

Legend:

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

    r16 r122  
    22!- 
    33!$Id$ 
    4   ! 
     4!--------------------------------------------------------------------- 
     5!- This program provide a an example of the basic usage of REST. 
     6!- Here the test the time sampling and averaging. Thus a long 
     7!- time-series is produced and sampled in different ways. 
     8!--------------------------------------------------------------------- 
    59  USE ioipsl 
    6   ! 
    7   !     This program provide a an example of the basic usage of REST. 
    8   !     Here the test the time sampling and averaging. Thus a long 
    9   !     time-series is produced and sampled in different ways. 
    10   ! 
     10! 
    1111  IMPLICIT NONE 
    12   ! 
    13   INTEGER :: iim, jjm, llm 
     12! 
     13  INTEGER :: iim,jjm,llm 
    1414  PARAMETER (iim=12,jjm=10,llm=2) 
    15   ! 
    16   REAL :: champ1(iim,jjm,llm), champ2(iim,jjm,llm+1), champ3(iim,jjm,llm) 
     15! 
     16  REAL :: champ1(iim,jjm,llm),champ2(iim,jjm,llm+1),champ3(iim,jjm,llm) 
    1717  REAL :: champ4(iim,jjm) 
    1818  REAL :: champ_read(iim,jjm,llm) 
    19   REAL :: lon(iim,jjm),lat(iim,jjm), lev(llm) 
     19  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm) 
    2020  REAL :: x 
    21   ! 
    22   INTEGER :: i, j, l, fid, t, ij, sig_id, hori_id, it 
    23   INTEGER :: day=1, month=1, year=1997 
    24   INTEGER :: itau=1, 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*20 :: fnamein, fnameout, keyword, value 
    29   ! 
     21! 
     22  INTEGER :: i,j,l,fid,t,ij,sig_id,hori_id,it 
     23  INTEGER :: day=1,month=1,year=1997 
     24  INTEGER :: itau=1,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*20 :: fnamein,fnameout,keyword,value 
     29! 
    3030  REAL :: pi=3.1415 
    31   ! 
    32   !     0.0 Choose a  gregorian calendar 
    33   ! 
    34   CALL ioconf_calendar('gregorian') 
    35   ! 
    36   !     1.0 Define a few variables we will need. These are the coordinates 
    37   !         the file name and the date. 
    38   ! 
    39   DO i = 1, iim 
    40     DO j = 1, jjm 
    41       lon(i,j) = ((float(iim/2)+0.5)-float(i))*pi/float(iim/2) & 
    42          &           *(-1.)*180./pi 
    43       lat(i,j) = 180./pi * ASIN(((float(jjm/2)+0.5) - float(j)) & 
    44          &           /float(jjm/2)) 
     31!--------------------------------------------------------------------- 
     32!- 
     33! 0.0 Choose a  gregorian 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) = & 
     43 &     ((float(iim/2)+0.5)-float(i))*pi/float(iim/2)*(-1.)*180./pi 
     44      lat(i,j) = & 
     45 &     (180./pi)*ASIN(((float(jjm/2)+0.5)-float(j))/float(jjm/2)) 
    4546    ENDDO 
    4647  ENDDO 
    47   ! 
     48!- 
    4849  DO l=1,llm 
    4950    lev(l) = float(l)/llm 
    5051  ENDDO 
    51   ! 
    52   !    1.1 The chosen date is 15 Feb. 1997 as stated above. It has to be  
    53   !         transformed into julian days using the calendar provided by  
    54   !         IOIPSL. 
    55   ! 
    56   CALL ymds2ju(year, month, day, 0.,julday) 
    57   CALL ioget_calendar(un_an) 
     52!- 
     53! 1.1 The chosen date is 15 Feb. 1997 as stated above. It has to be  
     54!     transformed into julian days using the calendar provided by  
     55!     IOIPSL. 
     56!- 
     57  CALL ymds2ju (year,month,day,0.,julday) 
     58  CALL ioget_calendar (un_an) 
    5859  un_mois = un_an/12. 
    5960  dt_wrt = un_mois*deltat 
     
    6162  dt_wrt2 = -1. 
    6263  dt_op2 = deltat 
    63   ! 
    64   ! 
     64!- 
    6565  fnamein = 'NONE' 
    6666  fnameout = 'restfile' 
    67   ! 
    68   ! 2.0 Create a restart file from nothing ! 
    69   ! 
    70   CALL restini(fnamein, iim, jjm, lon, lat, llm, lev, fnameout, & 
    71      &     itau, julday, deltat, fid) 
    72   ! 
     67!- 
     68! 2.0 Create a restart file from nothing ! 
     69!- 
     70  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, & 
     71 &              itau,julday,deltat,fid) 
     72!- 
    7373  champ1(:,:,:) = ASIN(1.0) 
    7474  champ2(:,:,:) = EXP(ASIN(1.0)) 
    75   ! 
    76   CALL ioconf_setatt('units', '?') 
    77   CALL ioconf_setatt('long_name', 'Tests 1 for a real variable') 
    78   CALL restput(fid, 'test1', iim, jjm, llm, itau, champ1) 
    79   ! 
    80   CALL ioconf_setatt('units', '?') 
    81   CALL ioconf_setatt('long_name', 'Tests 2 for a real variable') 
    82   CALL restput(fid, 'test2', iim, jjm, llm+1, itau, champ2) 
    83   ! 
    84   CALL restclo() 
    85   ! 
     75!- 
     76  CALL ioconf_setatt ('units','?') 
     77  CALL ioconf_setatt ('long_name','Tests 1 for a real variable') 
     78  CALL restput (fid,'test1',iim,jjm,llm,itau,champ1) 
     79!- 
     80  CALL ioconf_setatt ('units','?') 
     81  CALL ioconf_setatt ('long_name','Tests 2 for a real variable') 
     82  CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2) 
     83!- 
     84  CALL restclo () 
     85!- 
    8686  WRITE(*,*) '============== FIRST FILE CLOSED ==============' 
    87   ! 
    88   !  3.0 Reopen the restart file and check that the values read are correct 
    89   ! 
     87!- 
     88!  3.0 Reopen the restart file and check that the values read are correct 
     89!- 
    9090  fnamein = 'restfile' 
    9191  fnameout = 'restfilebis' 
    92   ! 
    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   ! 
     92!- 
     93  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, & 
     94 &              itau,julday,deltat,fid) 
     95!- 
     96  CALL restget (fid,'test1',iim,jjm,llm,itau,.FALSE.,champ_read) 
     97!- 
    9998  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   ! 
     99  CALL restput (fid,'test1',iim,jjm,llm,itau,champ_read) 
     100  CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2) 
     101!- 
     102  itau = itau+10 
     103  champ3(:,:,:) = champ_read(:,:,:)+champ2(:,:,1:llm)  
     104  CALL restput (fid,'test1',iim,jjm,llm,itau,champ3) 
     105!- 
     106  CALL restclo () 
     107!- 
    109108  WRITE(*,'(a25,e36.30)') 'The input data : ',champ1(1,1,1) 
    110109  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   ! 
     110!- 
     111!  4.0 Reopen the restart file and add another time step 
     112!- 
    114113  fnamein = 'restfilebis' 
    115114  fnameout = 'restfilebis' 
    116   ! 
    117   !  
    118   CALL restini(fnamein, iim, jjm, lon, lat, llm, lev, fnameout, & 
    119      &     itau, julday, deltat, fid) 
    120   ! 
    121   itau = itau + 10 
    122   CALL restput(fid, 'test1', iim, jjm, llm, itau, champ1) 
    123   CALL ioconf_setatt('units', '?') 
    124   CALL ioconf_setatt('long_name', 'Test a variable with another dimension') 
    125   CALL restput(fid, 'test4', iim, jjm, 0, itau, champ4) 
    126   ! 
    127   CALL restclo() 
    128   ! 
    129   STOP 
    130   ! 
     115!- 
     116  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, & 
     117 &              itau,julday,deltat,fid) 
     118!- 
     119  itau = itau+10 
     120  CALL restput (fid,'test1',iim,jjm,llm,itau,champ1) 
     121  CALL ioconf_setatt ('units','?') 
     122  CALL ioconf_setatt ('long_name', & 
     123 &                    'Test a variable with another dimension') 
     124  CALL restput (fid,'test4',iim,jjm,0,itau,champ4) 
     125!- 
     126  CALL restclo () 
     127!------------------- 
    131128END PROGRAM testrest 
    132  
Note: See TracChangeset for help on using the changeset viewer.