!############################# Change Log ##################################
! 5.0.0
!
!###########################################################################
!  Copyright (C)  1990, 1995, 1999, 2000, 2003 - All Rights Reserved
!  Regional Atmospheric Modeling System - RAMS
!###########################################################################

subroutine commio (cfile,io,iun)

  use mem_all
  use leaf_coms
!--(DMK-CCATT-INI)-----------------------------------------------------
  use mem_stilt, only: &
       iexev,          &
       imassflx
!--(DMK-CCATT-END)-----------------------------------------------------

  implicit none
  integer :: iun
  character(len=*) :: io,cfile

  !     This routine reads or writes the history and analysis file common blocks.

  integer, external :: cio_i,cio_f,cio_f8,cio_c
  character(len=2) :: cng
  integer :: irw,ie,ng

  IF(IO.EQ.'READ') irw=1
  IF(IO.EQ.'WRITE') irw=2
  !      print*,'in commio',cfile,' ',io,' ',iun

  ie=cio_i(iun,irw,'iversion',iversion,1)
  ie=cio_c(iun,irw,'expnme',expnme,1)
  ie=cio_i(iun,irw,'ioutput',ioutput,1)
  ie=cio_i(iun,irw,'if_adap',if_adap,1)
  ie=cio_i(iun,irw,'ngrids',ngrids,1)
  ie=cio_i(iun,irw,'nzg',nzg,1)
  ie=cio_i(iun,irw,'nzs',nzs,1)
  ie=cio_i(iun,irw,'naddsc',naddsc,1)
  ie=cio_f(iun,irw,'time',time,1)
  ie=cio_f(iun,irw,'ztop',ztop,1)
  ie=cio_f(iun,irw,'polelat',polelat,1)
  ie=cio_f(iun,irw,'polelon',polelon,1)
  ie=cio_f(iun,irw,'dzrat',dzrat,1)
  ie=cio_f(iun,irw,'dzmax',dzmax,1)

  ie=cio_i(iun,irw,'nnxp',nnxp,ngrids)
  ie=cio_i(iun,irw,'nnyp',nnyp,ngrids)
  ie=cio_i(iun,irw,'nnzp',nnzp,ngrids)
  ie=cio_i(iun,irw,'nnqparm',nnqparm,ngrids)
  ie=cio_i(iun,irw,'nndtrat',nndtrat,ngrids)
  ie=cio_i(iun,irw,'nstratx',nstratx,ngrids)
  ie=cio_i(iun,irw,'nstraty',nstraty,ngrids)
  ie=cio_i(iun,irw,'ngbegun',ngbegun,ngrids)
  ie=cio_i(iun,irw,'nnacoust',nnacoust,ngrids)
  ie=cio_i(iun,irw,'nxtnest',nxtnest,ngrids)
  ie=cio_i(iun,irw,'nnsttop',nnsttop,ngrids)
  ie=cio_i(iun,irw,'nnstbot',nnstbot,ngrids)
  ie=cio_i(iun,irw,'ninest',ninest,ngrids)
  ie=cio_i(iun,irw,'njnest',njnest,ngrids)
  ie=cio_i(iun,irw,'nknest',nknest,ngrids)
  ie=cio_i(iun,irw,'idiffk',idiffk,ngrids)
  ie=cio_f(iun,irw,'gridu',gridu,ngrids)
  ie=cio_f(iun,irw,'gridv',gridv,ngrids)
  ie=cio_f(iun,irw,'akmin',akmin,ngrids)
  ie=cio_f(iun,irw,'csz',csz,ngrids)
  ie=cio_f(iun,irw,'csx',csx,ngrids)
  ie=cio_f(iun,irw,'xkhkm',xkhkm,ngrids)
  ie=cio_f(iun,irw,'zkhkm',zkhkm,ngrids)
  ie=cio_f(iun,irw,'centlat',centlat,ngrids)
  ie=cio_f(iun,irw,'centlon',centlon,ngrids)
  ie=cio_f(iun,irw,'dimove',dimove,ngrids)
  ie=cio_f(iun,irw,'djmove',djmove,ngrids)
  ie=cio_f(iun,irw,'deltazn',deltazn,ngrids)
  ie=cio_f(iun,irw,'deltaxn',deltaxn,ngrids)
  ie=cio_f(iun,irw,'deltayn',deltayn,ngrids)
  ie=cio_f(iun,irw,'platn',platn,ngrids)
  ie=cio_f(iun,irw,'plonn',plonn,ngrids)
  ie=cio_f(iun,irw,'zz',zz,nnzp(1))

  ie=cio_i(iun,irw,'nestz1',nestz1,1)
  ie=cio_i(iun,irw,'nestz2',nestz2,1)
  ie=cio_i(iun,irw,'nstratz1',nstratz1,nnzp(1))
  ie=cio_i(iun,irw,'nstratz2',nstratz2,nnzp(1))

  do ng=1,ngrids
     write(cng,1) ng
1    format(i2.2)
     ie=cio_f(iun,irw,'xmn'//cng,xmn(1,ng),nnxp(ng))
     ie=cio_f(iun,irw,'xtn'//cng,xtn(1,ng),nnxp(ng))
     ie=cio_f(iun,irw,'ymn'//cng,ymn(1,ng),nnyp(ng))
     ie=cio_f(iun,irw,'ytn'//cng,ytn(1,ng),nnyp(ng))
     ie=cio_f(iun,irw,'zmn'//cng,zmn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'ztn'//cng,ztn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'dzmn'//cng,dzmn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'dztn'//cng,dztn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'u01dn'//cng,u01dn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'v01dn'//cng,v01dn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'pi01dn'//cng,pi01dn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'th01dn'//cng,th01dn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'dn01dn'//cng,dn01dn(1,ng),nnzp(ng))
     ie=cio_f(iun,irw,'rt01dn'//cng,rt01dn(1,ng),nnzp(ng))
  enddo

  ie=cio_i(iun,irw,'kroot',kroot,nvtyp+nvtyp_teb)

  ie=cio_i(iun,irw,'itopo',itopo,1)
  ie=cio_i(iun,irw,'initial',initial,1)
  ie=cio_i(iun,irw,'impl',impl,1)
  ie=cio_i(iun,irw,'iinput',iinput,1)
  ie=cio_i(iun,irw,'jdim',jdim,1)
  ie=cio_i(iun,irw,'iadvl',iadvl,1)
  ie=cio_i(iun,irw,'iadvf',iadvf,1)
  ie=cio_i(iun,irw,'lonrad',lonrad,1)
  ie=cio_i(iun,irw,'lsflg',lsflg,1)
  ie=cio_i(iun,irw,'ibnd',ibnd,1)
  ie=cio_i(iun,irw,'jbnd',jbnd,1)
  ie=cio_i(iun,irw,'icorflg',icorflg,1)
  ie=cio_i(iun,irw,'vveldamp',vveldamp,1)
!--(DMK-CCATT)---------------------------------------------------------
![ML
  ie=cio_i(iun,irw,'iexev',iexev,1)
  ie=cio_i(iun,irw,'imassflx',imassflx,1)
!ML]
!--(DMK-CCATT-END)-----------------------------------------------------
  ie=cio_i(iun,irw,'ilwrtyp',ilwrtyp,1)
  ie=cio_i(iun,irw,'iswrtyp',iswrtyp,1)
  ie=cio_i(iun,irw,'iref',iref,1)
  ie=cio_i(iun,irw,'jref',jref,1)
  ie=cio_i(iun,irw,'ihtran',ihtran,1)
  ie=cio_i(iun,irw,'nfpt',nfpt,1)
  ie=cio_i(iun,irw,'nsndg',nsndg,1)
  ie=cio_i(iun,irw,'ideltat',ideltat,1)
  ie=cio_i(iun,irw,'nacoust',nacoust,1)
  ie=cio_i(iun,irw,'iflag',iflag,1)
  ie=cio_i(iun,irw,'ntopsmth',ntopsmth,1)
  ie=cio_i(iun,irw,'izflat',izflat,1)
  ie=cio_i(iun,irw,'iyear1',iyear1,1)
  ie=cio_i(iun,irw,'imonth1',imonth1,1)
  ie=cio_i(iun,irw,'idate1',idate1,1)
  ie=cio_i(iun,irw,'itime1',itime1,1)
  ie=cio_i(iun,irw,'isfcl',isfcl,1)
  ie=cio_i(iun,irw,'npatch',npatch,1)
  ie=cio_i(iun,irw,'nvegpat',nvegpat,1)
  ie=cio_i(iun,irw,'mcphys_type',mcphys_type,1)
  ie=cio_i(iun,irw,'level',level,1)
  ie=cio_i(iun,irw,'irain',irain,1)
  ie=cio_i(iun,irw,'ipris',ipris,1)
  ie=cio_i(iun,irw,'isnow',isnow,1)
  ie=cio_i(iun,irw,'iaggr',iaggr,1)
  ie=cio_i(iun,irw,'igraup',igraup,1)
  ie=cio_i(iun,irw,'icloud',icloud,1)
  ie=cio_i(iun,irw,'ihail',ihail,1)

  ie=cio_f(iun,irw,'brunt',brunt,1)
  ie=cio_f(iun,irw,'wcldbs',wcldbs,1)
  ie=cio_f(iun,irw,'drtcon',drtcon,1)
  ie=cio_f(iun,irw,'rmin',rmin,1)
  ie=cio_f(iun,irw,'radfrq',radfrq,1)
  ie=cio_f(iun,irw,'distim',distim,1)
  ie=cio_f(iun,irw,'seatmp',seatmp,1)
  ie=cio_f(iun,irw,'confrq',confrq,1)
  ie=cio_f(iun,irw,'rmax',rmax,1)
  ie=cio_f(iun,irw,'eps',eps,1)
  ie=cio_f(iun,irw,'albedo',albedo,1)
  ie=cio_f(iun,irw,'dthcon',dthcon,1)
  ie=cio_f(iun,irw,'cphas',cphas,1)
  ie=cio_f(iun,irw,'topref',topref,1)
  ie=cio_f(iun,irw,'sspct',sspct,1)
  ie=cio_f(iun,irw,'rparm',rparm,1)
  ie=cio_f(iun,irw,'pparm',pparm,1)
  ie=cio_f(iun,irw,'sparm',sparm,1)
  ie=cio_f(iun,irw,'aparm',aparm,1)
  ie=cio_f(iun,irw,'gparm',gparm,1)
  ie=cio_f(iun,irw,'cparm',cparm,1)
  ie=cio_f(iun,irw,'hparm',hparm,1)

  ie=cio_f(iun,irw,'cfmas',cfmas,nhcat)
  ie=cio_f(iun,irw,'pwmas',pwmas,nhcat)

  ie=cio_f(iun,irw,'us',us,maxsndg)
  ie=cio_f(iun,irw,'vs',vs,maxsndg)
  ie=cio_f(iun,irw,'ts',ts,maxsndg)
  ie=cio_f(iun,irw,'thds',thds,maxsndg)
  ie=cio_f(iun,irw,'ps',ps,maxsndg)
  ie=cio_f(iun,irw,'hs',hs,maxsndg)

  ie=cio_f(iun,irw,'slden',slden,nstyp)
  ie=cio_f(iun,irw,'slcpd',slcpd,nstyp)
  ie=cio_f(iun,irw,'slbs',slbs,nstyp)
  ie=cio_f(iun,irw,'slcond',slcond,nstyp)
  ie=cio_f(iun,irw,'slcons',slcons,nstyp)
  ie=cio_f(iun,irw,'slmsts',slmsts,nstyp)
  ie=cio_f(iun,irw,'slpots',slpots,nstyp)
  ie=cio_f(iun,irw,'ssand',ssand,nstyp)
  ie=cio_f(iun,irw,'sclay',sclay,nstyp)
  ie=cio_f(iun,irw,'sorgan',sorgan,nstyp)
  ie=cio_f(iun,irw,'sporo',sporo,nstyp)
  ie=cio_f(iun,irw,'soilcp',soilcp,nstyp)
  ie=cio_f(iun,irw,'slfc',slfc,nstyp)
  ie=cio_f(iun,irw,'emisg',emisg,nstyp)

  ie=cio_f(iun,irw,'emisv',emisv,nvtyp+nvtyp_teb)

  ie=cio_f(iun,irw,'root',root,nzgmax*(nvtyp+nvtyp_teb))
  ie=cio_f(iun,irw,'slz',slz,nzg)

  ie=cio_f(iun,irw,'cmin',cmin,1)
  ie=cio_f(iun,irw,'corg',corg,1)
  ie=cio_f(iun,irw,'cwat',cwat,1)
  ie=cio_f(iun,irw,'cair',cair,1)
  ie=cio_f(iun,irw,'cka',cka,1)
  ie=cio_f(iun,irw,'ckw',ckw,1)

  return
end subroutine commio

!---------------------------------------------------------

subroutine cio_pos_file(iun,cstr,ierr)
  implicit none
  integer :: iun,ierr
  character(len=*) :: cstr
  character(len=256) :: line,csearch

  integer :: nl,nc,iend,ilen

  !      print*,'cio_pos:',iun,cstr

  iend=0
1 continue
  do nl=1,1000000
     read(iun,10,end=100) line
10   format(a)
     ilen=len(cstr)
     csearch='__'//cstr(1:ilen)
     nc=index(line,csearch(1:ilen+2) )
     !         print*,'cio_pos:',nl,nc,line
     if(nc.eq.1) then
        ierr=0
        !            print*,'---- Name found on header file:',cstr
        return
     endif
  enddo

100 continue
  if(iend.eq.1) then
     ierr=1
     print*,'---- Name NOT found on header file:',cstr
     rewind(iun)
     return
  endif
  rewind(iun)
  iend=1
  goto 1

end subroutine cio_pos_file

!---------------------------------------------------------

integer function cio_i(iun,irw,cstr,ia,n)
  implicit none
  integer :: iun,irw,n
  integer, dimension(n) :: ia
  character(len=*) :: cstr
  character(len=256) :: string
  integer :: nn,i

  if (irw.eq.1) then
     call cio_pos_file (iun,cstr,cio_i)
     if(cio_i.eq.1) return
     read(iun,*) nn
     read(iun,*) (ia(i),i=1,nn)
  elseif(irw.eq.2) then
     write(iun,20) cstr
20   format('__',a)
     write(iun,*) n
     write(iun,11) (ia(i),i=1,n)
11   format(i6)
     cio_i=0
  endif

  return
end function cio_i

!---------------------------------------------------------

integer function cio_f(iun,irw,cstr,ia,n)
  implicit none
  integer :: iun,irw,n
  real, dimension(n) :: ia
  character(len=*) :: cstr
  character(len=256) :: string
  integer :: nn,i

  if (irw.eq.1) then
     call cio_pos_file (iun,cstr,cio_f)
     if(cio_f.eq.1) return
     read(iun,*) nn
     read(iun,*) (ia(i),i=1,nn)
  elseif(irw.eq.2) then
     write(iun,20) cstr
20   format('__',a)
     write(iun,*) n
     write(iun,11) (ia(i),i=1,n)
11   format(e16.8)
     cio_f=0
  endif

  return
end function cio_f

!---------------------------------------------------------

integer function cio_f8(iun,irw,cstr,ia,n)
  implicit none
  integer :: iun,irw,n
  real(kind=8) :: ia(*)
  character(len=*) :: cstr
  character(len=256) :: string
  integer :: nn,i

  if (irw.eq.1) then
     call cio_pos_file (iun,cstr,cio_f8)
     if(cio_f8.eq.1) return
     read(iun,*) nn
     read(iun,*) (ia(i),i=1,nn)
  elseif(irw.eq.2) then
     write(iun,20) cstr
20   format('__',a)
     write(iun,*) n
     write(iun,11) (ia(i),i=1,n)
11   format(e24.16)
     cio_f8=0
  endif

  return
end function cio_f8

!---------------------------------------------------------

integer function cio_c(iun,irw,cstr,ia,n)
  implicit none
  integer :: iun,irw,n
  character(len=*) :: ia(*)
  character(len=*) :: cstr
  character(len=256) :: string
  integer :: nn,i

  if (irw.eq.1) then
     call cio_pos_file (iun,cstr,cio_c)
     if(cio_c.eq.1) return
     read(iun,*) nn
     read(iun,10) (ia(i),i=1,nn)
  elseif(irw.eq.2) then
     write(iun,20) cstr
20   format('__',a)
     write(iun,*) n
     write(iun,10) (ia(i),i=1,n)
10   format(a)
     cio_c=0
  endif

  return
end function cio_c


