|
| 1 | +program create_example |
| 2 | +use netcdf |
| 3 | +use, intrinsic :: iso_fortran_env, only: REAL64 |
| 4 | +implicit none |
| 5 | + |
| 6 | + |
| 7 | +character(len=512) :: fin,fout,str,fncar |
| 8 | +integer :: im_world,jm_world |
| 9 | +integer :: varid, lonid, latid |
| 10 | +integer :: i, j, nc,xid,yid |
| 11 | +integer :: zid,gwdid,trbid |
| 12 | +integer :: ncid,rc |
| 13 | +integer :: dimids(2) |
| 14 | +integer :: status |
| 15 | + |
| 16 | +integer :: nargs |
| 17 | + |
| 18 | +logical :: doNcar,doGEOS |
| 19 | + |
| 20 | +integer :: ntiles |
| 21 | +real, allocatable :: z1d(:) |
| 22 | +real(REAL64), allocatable :: xdim(:),ydim(:) |
| 23 | +real, allocatable :: a(:,:) |
| 24 | +logical :: isCube |
| 25 | + |
| 26 | +nargs = command_argument_count() |
| 27 | + |
| 28 | +doNCAR=.false. |
| 29 | +doGEOS=.false. |
| 30 | +isCube = .true. |
| 31 | +do i=1,nargs |
| 32 | + call get_command_argument(i,str) |
| 33 | + select case(trim(str)) |
| 34 | + case ('-i','--input') |
| 35 | + call get_command_argument(i+1,fin) |
| 36 | + case ('-o','--output') |
| 37 | + call get_command_argument(i+1,fout) |
| 38 | + doGEOS=.true. |
| 39 | + case ('--im') |
| 40 | + call get_command_argument(i+1,str) |
| 41 | + read(str,'(I10)')im_world |
| 42 | + case ('--jm') |
| 43 | + call get_command_argument(i+1,str) |
| 44 | + read(str,'(I10)')jm_world |
| 45 | + isCube = .false. |
| 46 | + case ('--ncar') |
| 47 | + call get_command_argument(i+1,fncar) |
| 48 | + doNCAR=.true. |
| 49 | + end select |
| 50 | +enddo |
| 51 | + |
| 52 | +if (isCube) jm_world = im_world*6 |
| 53 | + |
| 54 | +allocate(a(im_world,jm_world)) |
| 55 | +open(file=fin,unit=21,form='unformatted') |
| 56 | +read(21)a |
| 57 | +close(21) |
| 58 | + |
| 59 | +if (doGEOS) then |
| 60 | + |
| 61 | + call check( nf90_create(fout, NF90_NETCDF4,ncid),"error") |
| 62 | + call check( nf90_def_dim(ncid,"Xdim",im_world,lonid),"error") |
| 63 | + call check( nf90_def_var(ncid,"Xdim",NF90_DOUBLE,(/lonid/),xid),"error") |
| 64 | + call check( nf90_put_att(ncid,xid,"units","degrees_east"),"error") |
| 65 | + call check( nf90_def_dim(ncid,"Ydim",jm_world,latid),"error") |
| 66 | + call check( nf90_def_var(ncid,"Ydim",NF90_DOUBLE,(/latid/),yid),"error") |
| 67 | + call check( nf90_put_att(ncid,yid,"units","degrees_north"),"error") |
| 68 | + call check( nf90_def_var(ncid,"z",NF90_FLOAT,(/lonid,latid/),varid),"error") |
| 69 | + call check( nf90_put_att(ncid,varid,"units","m"),"error") |
| 70 | + call check( nf90_put_att(ncid,varid,"long_name","height above sea level"),"error") |
| 71 | + |
| 72 | + call check( nf90_enddef(ncid),"error") |
| 73 | + |
| 74 | + allocate(xdim(im_world),ydim(jm_world)) |
| 75 | + do i=1,im_world |
| 76 | + xdim(i)=i |
| 77 | + enddo |
| 78 | + do j=1,jm_world |
| 79 | + ydim(j)=j |
| 80 | + enddo |
| 81 | + |
| 82 | + call check(nf90_put_var(ncid,xid,xdim),"error") |
| 83 | + call check(nf90_put_var(ncid,yid,ydim),"error") |
| 84 | + call check(nf90_put_var(ncid,varid,a),"error") |
| 85 | + call check(nf90_close(ncid),"error") |
| 86 | + |
| 87 | +end if |
| 88 | + |
| 89 | +if (doNCAR) then |
| 90 | + |
| 91 | + ntiles=im_world*jm_world |
| 92 | + allocate(z1d(ntiles)) |
| 93 | + call check( nf90_create(fncar, NF90_NETCDF4,ncid),"error") |
| 94 | + call check( nf90_def_dim(ncid,"ncol",ntiles,xid),"error") |
| 95 | + call check( nf90_def_var(ncid,"PHIS",NF90_DOUBLE,(/xid/),varid),"error") |
| 96 | + call check( nf90_put_att(ncid,varid,"long_name","height"),"error") |
| 97 | + call check( nf90_put_att(ncid,varid,"units","m"),"error") |
| 98 | + call check( nf90_enddef(ncid),"error") |
| 99 | + |
| 100 | + nc=0 |
| 101 | + do j=1,jm_world |
| 102 | + do i=1,im_world |
| 103 | + nc=nc+1 |
| 104 | + z1d(nc)=a(i,j) |
| 105 | + enddo |
| 106 | + enddo |
| 107 | + |
| 108 | + call check(nf90_put_var(ncid,varid,z1d),"error") |
| 109 | + |
| 110 | +end if |
| 111 | + |
| 112 | +contains |
| 113 | + |
| 114 | +subroutine check(status,loc) |
| 115 | + |
| 116 | + integer, intent ( in) :: status |
| 117 | + character(len=*), intent ( in) :: loc |
| 118 | + |
| 119 | + if(status /= NF90_noerr) then |
| 120 | + write (*,*) "Error at ", loc |
| 121 | + write (*,*) nf90_strerror(status) |
| 122 | + stop "Stopped" |
| 123 | + end if |
| 124 | + |
| 125 | +end subroutine check |
| 126 | + |
| 127 | +end program create_example |
| 128 | + |
0 commit comments