module gsi_io !$$$ module documentation block ! . . . . ! module: gsi_io ! prgmmr: treadon org: np23 date: 2006-04-15 ! ! abstract: This module contains routines which handle input/output ! operations for GSI atmospheric and surface files. ! ! program history log: ! 2006-04-15 treadon ! 2007-05-25 todling - make reorder public; add interface to reorder ! ! Subroutines Included: ! sub init_io - initial i/o parameters ! sub read_bias - read gsi guess bias file from binary file, scatter ! from full grid to subdomains ! sub write_bias - gather gsi guess bias from subdomains to full ! grid, write to binary file ! sub reorder21s_ - ! sub reorder21d_ - ! sub reorder12s_ - ! sub reorder12d_ - ! ! Variable Definitions: ! def lendian_in - unit number reserved for little endian input ! def lendian_out - unit number reserved for little endian output ! ! attributes: ! language: f90 ! machine: ! !$$$ end documentation block use kinds, only: i_kind implicit none integer(i_kind):: lendian_in,lendian_out integer(i_kind):: mype_io private public lendian_in, lendian_out public mype_io public init_io public read_bias public write_bias public reorder21 public reorder12 interface reorder21; module procedure & reorder21s_, & reorder21d_ end interface interface reorder12; module procedure & reorder12s_, & reorder12d_ end interface contains subroutine init_io(mype,iope) !$$$ subprogram documentation block ! . . . . ! subprogram: init_io initialize quanities related ! to gsi i/o ! prgmmr: treadon org: np23 date: 2006-05-25 ! ! abstract: initialize quantities related to gsi i/o ! ! program history log: ! 2006-05-25 treadon ! ! input argument list: ! mype - mpi task id ! iope - io server mpi task id ! ! output argument list: ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use constants, only: izero implicit none ! Declare passed variables integer(i_kind),intent(in ) :: mype integer(i_kind),intent(in ) :: iope ! Set unit numbers reserved for little endian input and output lendian_in = 15_i_kind lendian_out = 66_i_kind if (mype==izero) write(6,*)'INIT_IO: reserve units lendian_in=',lendian_in,& ' and lendian_out=',lendian_out,' for little endian i/o' ! Set mpi io task mype_io=iope if (mype==mype_io) write(6,*)'INIT_IO: set IO server task to mype_io=',mype_io end subroutine init_io subroutine read_bias(filename,mype,nbc,sub_z,sub_ps,sub_tskin,sub_vor,& sub_div,sub_u,sub_v,sub_tv,sub_q,sub_cwmr,sub_oz,istatus) !$$$ subprogram documentation block ! . . . . ! subprogram: read_bias read bias, convert to grid and ! send to all mpi tasks ! prgmmr: treadon org: np23 date: 2006-04-15 ! ! abstract: read bias, convert to grid, and ! scatter to subdomains ! ! program history log: ! 2006-04-15 treadon ! 2006-12-04 todling - add nbc and loop over nbc ! 2007-06-01 todling - bug fix: loops were only copying to (1,1) element ! ! input argument list: ! filename - name of local file from which to read bias ! mype - mpi task id ! ! output argument list: ! sub_z - terrain ! sub_ps - surface pressure ! sub_tskin - skin temperature ! sub_vor - vorticity ! sub_div - divergence ! sub_u - zonal wind ! sub_v - meridional wind ! sub_tv - virtual temperature ! sub_q - specific humidity??? ! sub_cwmr - cloud condensate mixing ratio ! sub_oz - ozone mixing ratio ! istatus - read status indicator ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_kind,r_single use gridmod, only: itotsub,nlon,nlat,lat2,lon2,nsig,displs_s,ijn_s,& ntracer,ncloud use constants, only: izero,ione,zero use mpimod, only: mpi_rtype,ierror,mpi_comm_world implicit none ! Declare local parameters integer(i_kind):: lunin=11_i_kind integer(i_kind):: nsize=4_i_kind ! Declare passed variables character(24) ,intent(in ) :: filename integer(i_kind) ,intent(in ) :: mype integer(i_kind) ,intent(in ) :: nbc integer(i_kind) ,intent( out) :: istatus real(r_kind),dimension(lat2,lon2,nbc) ,intent( out) :: sub_z,sub_ps,sub_tskin real(r_kind),dimension(lat2,lon2,nsig,nbc),intent( out) :: sub_u,sub_v,& sub_vor,sub_div,sub_cwmr,sub_q,sub_oz,sub_tv ! Declare local variables integer(i_kind) i,j,k,mm1 integer(i_kind) mype_in,iret integer(i_kind):: ib,nb,ka,n real(r_kind),dimension(itotsub):: work real(r_single),dimension(nlon,nlat):: grid4 real(r_kind),dimension(lat2,lon2,nsig)::work3d !****************************************************************************** ! Initialize variables used below mype_in=izero mm1=mype+ione ib=-ione nb=nsize*nlon*nlat ! Open file to read bias fields istatus=izero call baopenr(lunin,filename,iret) if (iret/=izero) then if (mype==mype_in) write(6,*) & 'READ_BIAS: ***ERROR*** opening output file, iret=',iret,lunin,filename istatus=istatus+iret return endif ! Loop over all coefficients of bias model do n=1,nbc ! Terrain: spectral --> grid transform, scatter to all mpi tasks if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& sub_z(1,1,n),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) ! Surface pressure: same procedure as terrain if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& sub_ps(1,1,n),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) ! Skin temperature if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& sub_tskin(1,1,n),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) ! (Virtual) temperature do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_tv(i,j,k,n) = work3d(i,j,k) end do end do end do ! Divergence and voriticity. do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_div(i,j,k,n) = work3d(i,j,k) end do end do end do do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_vor(i,j,k,n) = work3d(i,j,k) end do end do end do ! u and v wind do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_u(i,j,k,n) = work3d(i,j,k) end do end do end do do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_v(i,j,k,n) = work3d(i,j,k) end do end do end do ! Water vapor mixing ratio do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_q(i,j,k,n) = work3d(i,j,k) end do end do end do ! Ozone mixing ratio do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) do j=1,lon2 do i=1,lat2 sub_oz(i,j,k,n) = work3d(i,j,k) end do end do end do ! Cloud condensate mixing ratio. if (ntracer>2_i_kind .or. ncloud>=ione) then do k=1,nsig if (mype==mype_in) then call baread(lunin,ib,nb,ka,grid4) call reorder21(grid4,work) endif call mpi_scatterv(work,ijn_s,displs_s,mpi_rtype,& work3d(1,1,k),ijn_s(mm1),mpi_rtype,mype_in,mpi_comm_world,ierror) end do do j=1,lon2 do i=1,lat2 sub_cwmr(i,j,k,n) = work3d(i,j,k) end do end do else do k=1,nsig do j=1,lon2 do i=1,lat2 sub_cwmr(i,j,k,n)=zero end do end do end do endif end do ! End loop over coefficients ! Close input file call baclose(lunin,iret) if (iret/=izero) then write(6,*)'READ_BIAS: ***ERROR*** closing input file, iret=',iret endif istatus=istatus+iret ! End of routine. Return return end subroutine read_bias !------------------------------------------------------------------------- ! NOAA/NCEP, National Centers for Environmental Prediction GSI ! !------------------------------------------------------------------------- !BOP ! ! !ROUTINE: write_bias --- Gather, transform, and write out spectal coefficients ! ! !INTERFACE: ! subroutine write_bias(filename,mype,mype_out,nbc,sub_z,sub_ps,& sub_tskin,sub_vor,sub_div,sub_u,sub_v,sub_tv,sub_q,sub_cwmr,sub_oz,istatus) ! ! !USES: ! use kinds, only: r_kind,r_single use constants, only: izero,ione use mpimod, only: mpi_rtype use mpimod, only: mpi_comm_world use mpimod, only: ierror use gridmod, only: nlat, nlon ! no. lat/lon use gridmod, only: lat1, lon1 ! no. lat/lon on subdomain (no buffer) use gridmod, only: lat2, lon2 ! no. lat/lon on subdomain (buffer pnts on ends) use gridmod, only: nsig ! no. levels use gridmod, only: iglobal ! no. of horizontal points on global grid use gridmod, only: ijn ! no. of horiz. pnts for each subdomain (no buffer) use gridmod, only: displs_g ! comm. array, displacement for receive on global grid use gridmod, only: itotsub ! no. of horizontal points of all subdomains combined use gridmod, only: ntracer ! no. of tracers use gridmod, only: ncloud ! no. of cloud types use gridmod, only: strip implicit none ! ! !LOCAL PARAMETER: ! ! ! !INPUT PARAMETERS: ! character(24) ,intent(in):: filename ! file to open and write to integer(i_kind) ,intent(in ) :: mype ! mpi task number integer(i_kind) ,intent(in ) :: mype_out ! mpi task to write output file integer(i_kind) ,intent(in ) :: nbc ! number of bias coefficients in bias model integer(i_kind) ,intent( out) :: istatus ! write status real(r_kind),dimension(lat2,lon2,nbc) ,intent(in ) :: sub_z ! GFS terrain field on subdomains real(r_kind),dimension(lat2,lon2,nbc) ,intent(in ) :: sub_ps ! ps on subdomains real(r_kind),dimension(lat2,lon2,nbc) ,intent(in ) :: sub_tskin! skin temperature real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_vor ! vorticity on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_div ! divergence on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_u ! u wind on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_v ! v wind on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_tv ! virtual temperature on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_q ! specific humidity on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_oz ! ozone on subdomains real(r_kind),dimension(lat2,lon2,nsig,nbc),intent(in ) :: sub_cwmr ! cloud condensate mixing ratio on subdomains ! ! !OUTPUT PARAMETERS: ! ! !DESCRIPTION: This routine gathers fields needed for the GSI analysis ! file from subdomains and then transforms the fields from ! grid to spectral space. The spectral coefficients are ! then written to an atmospheric analysis file. ! ! !REVISION HISTORY: ! ! 2006-12-04 todling - add nbc and loop over nbc ! 2010-04-01 treadon - move strip to gridmod ! ! !REMARKS: ! ! language: f90 ! machines: ibm RS/6000 SP; SGI Origin 2000; Compaq HP ! ! !AUTHOR: ! ! 2006-04-15 treadon ! !EOP !------------------------------------------------------------------------- integer(i_kind),parameter:: lunout = 51_i_kind integer(i_kind),parameter:: nsize=4_i_kind integer(i_kind) k,mm1 integer(i_kind):: iret integer(i_kind):: nb,n real(r_kind),dimension(lat1*lon1):: zsm,psm,tskinsm real(r_kind),dimension(lat1*lon1,nsig):: tvsm,vorsm,divsm,usm,vsm,qsm,ozsm,cwmrsm real(r_kind),dimension(max(iglobal,itotsub)):: work real(r_single),dimension(nlon,nlat):: grid4 !************************************************************************* ! Initialize local variables mm1=mype+ione nb=nsize*nlon*nlat ! Open file to receive bias fields istatus=izero if (mype==mype_out) then call baopenwt(lunout,filename,iret) if (iret/=izero) then write(6,*)'WRITE_BIAS: ***ERROR*** opening output file, iret=',iret endif istatus=istatus+iret endif ! Loop over number of coefficients in bias model do n=1,nbc ! Strip off boundary points from subdomains call strip(sub_z (1,1,n) ,zsm ,ione) call strip(sub_ps (1,1,n) ,psm ,ione) call strip(sub_tskin(1,1,n) ,tskinsm,ione) call strip(sub_vor (1,1,1,n),vorsm ,nsig) call strip(sub_div (1,1,1,n),divsm ,nsig) call strip(sub_u (1,1,1,n),usm ,nsig) call strip(sub_v (1,1,1,n),vsm ,nsig) call strip(sub_tv (1,1,1,n),tvsm ,nsig) call strip(sub_q (1,1,1,n),qsm ,nsig) call strip(sub_oz (1,1,1,n),ozsm ,nsig) call strip(sub_cwmr (1,1,1,n),cwmrsm ,nsig) ! For each output grid, the following steps are repeated ! 1) create global grid by gathering from subdomains ! 2) write full grid field to output file ! Terrain call mpi_gatherv(zsm,ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif ! Surface pressure call mpi_gatherv(psm,ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif ! Skin temperature call mpi_gatherv(tskinsm,ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif ! Virtual temperature do k=1,nsig call mpi_gatherv(tvsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do ! Horizontal divergence and voriticy do k=1,nsig call mpi_gatherv(divsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do do k=1,nsig call mpi_gatherv(vorsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do ! u and v wind do k=1,nsig call mpi_gatherv(usm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do do k=1,nsig call mpi_gatherv(vsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do ! Specific humidity do k=1,nsig call mpi_gatherv(qsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do ! Ozone do k=1,nsig call mpi_gatherv(ozsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do ! Cloud condensate mixing ratio if (ntracer>2_i_kind .or. ncloud>=ione) then do k=1,nsig call mpi_gatherv(cwmrsm(1,k),ijn(mm1),mpi_rtype,& work,ijn,displs_g,mpi_rtype,& mype_out,mpi_comm_world,ierror) if (mype==mype_out) then call reorder12(work,grid4) call wryte(lunout,nb,grid4) endif end do endif end do ! End loop over nbc ! Single task writes message to stdout if (mype==mype_out) then write(6,*) 'WRITE_BIAS: bias file written to ',& trim(filename) call baclose(lunout,iret) if (iret/=izero) then write(6,*)'WRITE_BIAS: ***ERROR*** closing output file, iret=',iret endif istatus=istatus+iret endif ! return end subroutine write_bias !------------------------------------------------------------------------- ! NOAA/NCEP, National Centers for Environmental Prediction GSI ! !------------------------------------------------------------------------- !BOP ! ! !IROUTINE: reorder21s_ --- reorder 2d array to 1d order ! ! !INTERFACE: ! subroutine reorder21s_(grid_in,grid_out) ! !USES: use kinds, only: r_kind,r_single use gridmod, only: itotsub,ltosi_s,ltosj_s,nlat,nlon implicit none ! !INPUT PARAMETERS: real(r_single),dimension(nlon,nlat),intent(in ) :: grid_in ! input grid real(r_kind) ,dimension(itotsub) ,intent( out) :: grid_out ! output grid ! !DESCRIPTION: This routine transfers the contents of a two-diemnsional, ! type r_single array into a one-dimension, type r_kind ! array. ! ! ! !REVISION HISTORY: ! 2004-08-27 treadon ! ! !REMARKS: ! language: f90 ! machine: ibm rs/6000 ! ! !AUTHOR: ! treadon org: np23 date: 2004-08-27 ! !EOP !------------------------------------------------------------------------- ! Declare local variables integer(i_kind) i,j,k ! Transfer input 2d array to output 1d array do k=1,itotsub i=ltosi_s(k) j=ltosj_s(k) grid_out(k)=grid_in(j,i) end do return end subroutine reorder21s_ !------------------------------------------------------------------------- ! NOAA/NCEP, National Centers for Environmental Prediction GSI ! !------------------------------------------------------------------------- !BOP ! ! !IROUTINE: reorder21d_ --- reorder 2d array to 1d order ! ! !INTERFACE: ! subroutine reorder21d_(grid_in,grid_out) ! !USES: use kinds, only: r_kind,r_single use gridmod, only: itotsub,ltosi_s,ltosj_s,nlat,nlon implicit none ! !INPUT PARAMETERS: real(r_kind),dimension(nlon,nlat),intent(in ) :: grid_in ! input grid real(r_kind),dimension(itotsub) ,intent( out) :: grid_out ! output grid ! !DESCRIPTION: This routine transfers the contents of a two-diemnsional, ! type r_single array into a one-dimension, type r_kind ! array. ! ! ! !REVISION HISTORY: ! 2004-08-27 treadon ! 2007-05-27 todling - add double precision version ! ! !REMARKS: ! language: f90 ! machine: ibm rs/6000 ! ! !AUTHOR: ! treadon org: np23 date: 2004-08-27 ! !EOP !------------------------------------------------------------------------- ! Declare local variables integer(i_kind) i,j,k ! Transfer input 2d array to output 1d array do k=1,itotsub i=ltosi_s(k) j=ltosj_s(k) grid_out(k)=grid_in(j,i) end do return end subroutine reorder21d_ !------------------------------------------------------------------------- ! NOAA/NCEP, National Centers for Environmental Prediction GSI ! !------------------------------------------------------------------------- !BOP ! ! !IROUTINE: reorder12s_ --- reorder 1d array to 2d order ! ! !INTERFACE: ! subroutine reorder12s_(grid_in,grid_out) ! !USES: use kinds, only: r_kind,r_single use gridmod, only: itotsub,iglobal,ltosi,ltosj,nlat,nlon implicit none ! !INPUT PARAMETERS: real(r_kind) ,dimension(max(iglobal,itotsub)),intent(in ) :: grid_in ! input grid real(r_single),dimension(nlon,nlat) ,intent( out) :: grid_out ! input grid ! !DESCRIPTION: This routine transfers the contents of a one-diemnsional, ! type r_kind array into a two-dimensional, type r_single ! array. ! ! ! !REVISION HISTORY: ! 2004-08-27 treadon ! ! !REMARKS: ! language: f90 ! machine: ibm rs/6000 ! ! !AUTHOR: ! treadon org: np23 date: 2004-08-27 ! !EOP !------------------------------------------------------------------------- ! Declare local variables integer(i_kind) i,j,k ! Transfer input 1d array to output 2d array do k=1,iglobal i=ltosi(k) j=ltosj(k) grid_out(j,i) = grid_in(k) end do return end subroutine reorder12s_ !------------------------------------------------------------------------- ! NOAA/NCEP, National Centers for Environmental Prediction GSI ! !------------------------------------------------------------------------- !BOP ! ! !IROUTINE: reorder12d_ --- reorder 1d array to 2d order ! ! !INTERFACE: ! subroutine reorder12d_(grid_in,grid_out) ! !USES: use kinds, only: r_kind,r_single use gridmod, only: itotsub,iglobal,ltosi,ltosj,nlat,nlon implicit none ! !INPUT PARAMETERS: real(r_kind),dimension(max(iglobal,itotsub)),intent(in ) :: grid_in ! input grid real(r_kind),dimension(nlon,nlat) ,intent( out) :: grid_out ! input grid ! !DESCRIPTION: This routine transfers the contents of a one-diemnsional, ! type r_kind array into a two-dimensional, type r_single ! array. ! ! ! !REVISION HISTORY: ! 2004-08-27 treadon ! 2007-05-27 todling - add double precision version ! ! !REMARKS: ! language: f90 ! machine: ibm rs/6000 ! ! !AUTHOR: ! treadon org: np23 date: 2004-08-27 ! !EOP !------------------------------------------------------------------------- ! Declare local variables integer(i_kind) i,j,k ! Transfer input 1d array to output 2d array do k=1,iglobal i=ltosi(k) j=ltosj(k) grid_out(j,i) = grid_in(k) end do return end subroutine reorder12d_ end module gsi_io