wrfv2_fire/external/io_pnetcdf/testWRFWrite.F90

   1 program testwrite_john
   2   use wrf_data_pnc
   3   implicit none
   4   include 'wrf_status_codes.h'
   5   include 'netcdf.inc'
   6   character (80) FileName
   7   integer Comm
   8   character (80) SysDepInfo
   9   integer     :: DataHandle
  10   integer Status
  11   integer NCID
  12   real data(200)
  13   integer idata(200)
  14   real*8 ddata(200)
  15   logical ldata(200)
  16   character (80) cdata
  17   integer OutCount
  18   integer i,j,k
  19
  20   integer, parameter ::    pad = 3
  21   integer, parameter ::    jds=1       , jde=6      , &
  22                            ids=1       , ide=9      , &
  23                            kds=1       , kde=5
  24   integer, parameter ::    jms=jds-pad , jme=jde+pad , &
  25                            ims=ids-pad , ime=ide+pad , &
  26                            kms=kds     , kme=kde
  27   integer, parameter ::    jps=jds     , jpe=jde    , &
  28                            ips=ids     , ipe=ide    , &
  29                            kps=kds     , kpe=kde
  30
  31   real u( ims:ime , kms:kme , jms:jme )
  32   real v( ims:ime , kms:kme , jms:jme )
  33   real rho( ims:ime , kms:kme , jms:jme )
  34   real u2( ims:ime , jms:jme )
  35   real u1( ims:ime )
  36
  37   integer int( ims:ime , kms:kme , jms:jme )
  38   real*8  r8 ( ims:ime , kms:kme , jms:jme )
  39
  40   integer Dom
  41   character*3 MemOrd
  42   character (19) Date
  43   character (19) Date2
  44   integer , Dimension(3) :: DomS,DomE,MemS,MemE,PatS,PatE
  45   integer , Dimension(2) :: Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E
  46   integer , Dimension(1) :: Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E
  47   print *, 'Testing wrf write'
  48   print *, ims,ime , kms,kme , jms,jme
  49   Date = '2000-09-18_16:42:01'
  50   Date2 = '2000-09-18_16:52:01'
  51   call ext_init(Status)
  52   print *,'After call ext_init, Status =',Status
  53   FileName = 'foo.nc'
  54   Comm = 1
  55   SysDepInfo = 'sys info'
  56
  57 print*,'!!!!!!!!!!!!!!!!!!!!!!! ext_open_for_write_begin'
  58
  59   call ext_open_for_write_begin( FileName, Comm, SysDepInfo, DataHandle, Status)
  60   print *, ' ext_open_for_write_begin Status = ',Status,DataHandle
  61
  62   MemOrd = "XZY"
  63
  64   DomS(1) = ids
  65   DomE(1) = ide
  66   DomS(2) = kds
  67   DomE(2) = kde
  68   DomS(3) = jds
  69   DomE(3) = jde
  70
  71   PatS(1) = ips
  72   PatE(1) = ipe
  73   PatS(2) = kps
  74   PatE(2) = kpe
  75   PatS(3) = jps
  76   PatE(3) = jpe
  77
  78   MemS(1) = ims
  79   MemE(1) = ime
  80   MemS(2) = kms
  81   MemE(2) = kme
  82   MemS(3) = jms
  83   MemE(3) = jme
  84
  85   Dom2S(1) = ids
  86   Dom2S(2) = jds
  87   Dom2E(1) = ide
  88   Dom2E(2) = jde
  89   Mem2S(1) = ims
  90   Mem2S(2) = jms
  91   Mem2E(1) = ime
  92   Mem2E(2) = jme
  93   Pat2S(1) = ips
  94   Pat2S(2) = jps
  95   Pat2E(1) = ipe
  96   Pat2E(2) = jpe
  97
  98   Dom1S = ids
  99   Dom1E = ide
 100   Mem1S = ims
 101   Mem1E = ime
 102   Pat1S = ips
 103   Pat1E = ipe
 104
 105   call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 106   print *,'             dry run : ext_write_field Status = ',Status
 107   call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 108   print *,'             dry run : ext_write_field Status = ',Status
 109   call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 110   print *,'             dry run : ext_write_field Status = ',Status
 111   call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
 112   print *,'             dry run : ext_write_field Status = ',Status
 113   call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
 114   print *,'             dry run : ext_write_field Status = ',Status
 115   call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
 116   print *,'             dry run : ext_write_field Status = ',Status
 117   call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 118   print *,'             dry run : ext_write_field Status = ',Status
 119   call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 120   print *,'             dry run : ext_write_field Status = ',Status
 121
 122   call ext_open_for_write_commit(DataHandle, Status)
 123   print *, '             ext_open_for_write_commit Status = ', Status,DataHandle
 124
 125   do j=jds,jde
 126     do k=kds,kde
 127       do i=ids,ide
 128         u  (i,k,j) = 100*i+j+10*k
 129         v  (i,k,j) = 100*i+j+10*k
 130         rho(i,k,j) = 100*i+j+10*k
 131         int(i,k,j) = 100*i+j+10*k
 132         r8 (i,k,j) = 100*i+j+10*k
 133       enddo
 134     enddo
 135   enddo
 136   do j=jds,jde
 137     do i=ids,ide
 138       u2(i,j) = 10*i+j
 139     enddo
 140   enddo
 141   do i=ids,ide
 142     u1(i) = i
 143   enddo
 144
 145   print *,'testWRFWrite u  (2,3,4) = ',u(2,3,4)
 146   print *,'testWRFWrite v  (4,3,2) = ',v(4,3,2)
 147   print *,'testWRFWrite rho(3,4,5) = ',rho(3,4,5)
 148   print *,'testWRFWrite u2 (6,5)   = ',u2(6,5)
 149   print *,'testWRFWrite u1 (9)     = ',u1(9)
 150   print *,'testWRFWrite int(8,5,6) = ',int(8,5,6)
 151   print *,'testWRFWrite r8 (7,4,5) = ',r8(7,4,5)
 152   call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 153   print *,'              first write: ext_write_field Status = ',Status
 154   call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 155   print *,'              first write: ext_write_field Status = ',Status
 156   call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 157   print *,'              first write: ext_write_field Status = ',Status
 158   call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
 159   print *,'              first write: ext_write_field Status = ',Status
 160   call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
 161   print *,'              first write: ext_write_field Status = ',Status
 162   call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
 163   print *,'              first write: ext_write_field Status = ',Status
 164   call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 165   print *,'              first write: ext_write_field Status = ',Status
 166   call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 167   print *,'             dry run : ext_write_field Status = ',Status
 168
 169   print *,'2nd : testWRFWrite u(3,3,3) = ',u(3,3,3)
 170   print *,'2nd : testWRFWrite v(4,4,4) = ',v(4,4,4)
 171   print *,'2nd : testWRFWrite rho(3,4,5) = ',rho(3,4,5)
 172   call ext_write_field(DataHandle,Date2,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 173   print *,'              2nd write : ext_write_field Status = ',Status
 174   call ext_write_field(DataHandle,Date2,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 175   print *,'              2nd write : ext_write_field Status = ',Status
 176   call ext_write_field(DataHandle,Date2,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
 177   print *,'              2nd write : ext_write_field Status = ',Status
 178
 179   call ext_close( DataHandle, Status)
 180   print *, '             After ext_close, Status = ',Status
 181   call ext_exit(Status)
 182   print *,'              End of test program',Status
 183   stop
 184   end program testwrite_john