MODULE IbisOutput  


  USE Constants, ONLY: &
       r8,             & 
       r4,             &
       i8,             &
       pi

 IMPLICIT NONE
 INTEGER :: nnVeg=-1
 INTEGER :: nSoil=-1
 INTEGER :: nVars=-1
 INTEGER :: nVarscp=-1
 INTEGER :: ibMax =-1
 INTEGER :: jbMax =-1
 INTEGER ,ALLOCATABLE :: nLevs(:)
 REAL(KIND=r8) ,ALLOCATABLE :: depth(:)

 INTEGER ,ALLOCATABLE :: nLevscp(:)
 REAL(KIND=r8) ,ALLOCATABLE :: depthcp(:)

 TYPE GRADS
    CHARACTER(LEN= 20)          :: Units ='K'
    CHARACTER(LEN=555)          :: Name  ='Temperature'
    CHARACTER(LEN= 10)          :: NameG ='Temp'
    INTEGER                     :: ibMax  =1
    INTEGER                     :: jbMax  =1
    INTEGER                     :: nVars =1
    INTEGER                     :: nSoil =3 
    INTEGER                     :: nLevs =1
    REAL(KIND=r4)      , POINTER :: Buffer (:,:,:)
 END TYPE GRADS 
 TYPE(GRADS), ALLOCATABLE :: Grd(:)


 TYPE GRADS2
    CHARACTER(LEN= 20)          :: Units ='K'
    CHARACTER(LEN=555)          :: Name  ='Temperature'
    CHARACTER(LEN= 10)          :: NameG ='Temp'
    INTEGER                     :: ibMax  =1
    INTEGER                     :: jbMax  =1
    INTEGER                     :: nVars =1
    INTEGER                     :: nnVeg =8 
    INTEGER                     :: nLevs =1
    REAL(KIND=r4)      , POINTER :: Buffer2 (:,:,:)
 END TYPE GRADS2 
 TYPE(GRADS2), ALLOCATABLE :: Grd_CP(:)

 INTEGER :: step
 REAL(KIND=r8)  :: undef= -9.99E+33
 REAL(KIND=r8)  :: maxstp= 0
 LOGICAL    ::  OPENFILE=.TRUE. 
 LOGICAL    ::  OPENFILE_CTL=.TRUE. 

 LOGICAL    ::  OPENFILE_CP=.TRUE. 
 LOGICAL    ::  OPENFILE_CTL_CP=.TRUE. 
 
 INTEGER    ::  NumberRec=0
 INTEGER    ::  NumberRecCP=0
CONTAINS

 SUBROUTINE Init_IbisOutput(nVars_Input,nVarscp_Input,ibMax_Input,jbMax_Input,nSoil_Input,DELTAOUT,dt,depth_in)
   IMPLICIT NONE
   INTEGER, INTENT(IN   ) :: nVars_Input
   INTEGER, INTENT(IN   ) :: nVarscp_Input
   INTEGER, INTENT(IN   ) :: ibMax_Input
   INTEGER, INTENT(IN   ) :: jbMax_Input
   INTEGER, INTENT(IN   ) :: nSoil_Input
   REAL(KIND=r8), INTENT(IN   ) :: DELTAOUT
   REAL(KIND=r8), INTENT(IN   ) :: dt
   REAL(KIND=r8), INTENT(IN   ) :: depth_in(nSoil_Input)

   
   INTEGER :: k
   INTEGER :: i
   INTEGER :: j
   nVars = nVars_Input
   nVarscp = nVarscp_Input
   nSoil = nSoil_Input
   nnVeg = 8
   ibMax = ibMax_Input
   jbMax = jbMax_Input
   ALLOCATE(nLevs(nVars))
   ALLOCATE(nLevscp(nVarscp))
   ALLOCATE(Grd(nVars))  
   ALLOCATE(Grd_CP(nVarscp))  
   ALLOCATE(depth(nSoil_Input))
   ALLOCATE(depthcp(nnVeg))

   depth   = depth_in
   depthcp = (/1.,2.,3.,4.,5.,6.,7.,8./)

   nLevscp(1:nVarscp)=(/nnVeg      ,nnVeg      ,nnVeg      ,nnVeg      ,nnVeg      /) ! 01-05

   nLevs(1:nVars)=(/1          ,1          ,1          ,nSoil_Input,1          ,& ! 01-05
                    nSoil_Input,1          ,1          ,1          ,1          ,& ! 06-10
                    1          ,1          ,1          ,1          ,1          ,& ! 11-15
                    1          ,1          ,1          ,1          ,1          ,& ! 16-20
                    1          ,1          ,1          ,1          ,1          ,& ! 21-25
                    1          ,1          ,1          ,1          ,1          ,& ! 26-30
                    1          ,1          ,1          ,1          ,1          ,& ! 31-35
                    1          ,1          ,1          ,1          ,1          ,& ! 36-40
                    1          ,nSoil_Input,nSoil_Input,1          ,1          ,& ! 41-45
                    1          ,1          ,1          ,1          ,1          ,& ! 46-50
                    1          ,1          ,1          ,1          ,1          ,& ! 51-55
                    1          ,1          ,1          ,1          ,1          ,& ! 56-60
                    1          ,1          ,1          ,1          ,1          ,& ! 61-65
                    1          ,1          ,1          ,nSoil_Input,nSoil_Input,& ! 66 70
                    nSoil_Input,nSoil_Input,1          ,1          ,1          ,& ! 71-75
                    1          ,1          ,1          ,1          ,1          ,& ! 76-80
                    1          ,1          ,1          ,1          ,1          ,& ! 81-85
                    1          ,1          ,1          ,1          ,1          ,& ! 86-90
                    1          ,1          ,1          ,1          ,1          ,& ! 91-95
                    1          ,1          ,1          ,1          ,1          ,& ! 96-100
                    1          ,1          ,1          ,1          ,1          ,& ! 101-105
                    1          ,1          ,1          ,1          ,1          ,& ! 106-110
                    1          ,1          ,1          ,1          ,1          ,& ! 111-115
                    1          ,1          ,1          ,1          ,1          ,& ! 116-120
                    1          ,1          ,1          ,1          ,1          ,& ! 121-125
                    1          ,1          ,1          ,1          ,1          ,& ! 126-130
                    1          ,1          ,1          ,1          ,1          ,& ! 131-135
                    1          ,1          ,1          ,1          ,1          ,& ! 136-140
                    1          ,1          ,1          ,1          ,1          ,& ! 141-145
                    1          ,1          ,1          ,1          ,1          ,& ! 146-150
                    1          ,1          ,1          ,1          ,1          ,& ! 151-155
                    1          ,1          ,1          ,1          ,1          ,& ! 156-160
                    1          ,1          ,1          ,1          ,1          ,& ! 161-165
                    1          ,1          ,1          ,1          ,1          ,& ! 166-170
                    1          ,1          ,1          ,1          ,1          ,& ! 171-175
                    1          ,1          ,1          ,1          ,1          ,& ! 176-180
                    1          ,1          ,1          ,1          ,1          ,& ! 181-185
                    1          ,1          ,1          ,1          ,1          ,& ! 186-190
                    1          ,1          ,1          ,1          ,1          ,& ! 191-195
                    1          ,1          ,1          ,1          ,1          ,& ! 196-200
                    1          ,1          ,1          ,1          ,1          ,& ! 201-205
                    1          ,1          ,1          ,1          ,1          ,& ! 206-210
                    1          ,1          ,1          ,1          ,1          ,& ! 211-215 
                    1          ,1          ,1          ,1          ,1          ,& ! 216-220 
                    1          ,1          ,1          ,1          ,1          ,& ! 221-225 
                    1          ,1          ,1          ,1          ,1          ,& ! 226-230 
                    1          ,1          ,1          ,1          ,1          ,& ! 231-235 
                    1          ,1          ,1          ,1          ,1          ,& ! 236-240 
                    1          ,1          ,1          ,1          ,1          ,& ! 241-245 
                    1          ,1          ,1          ,1          ,1          ,& ! 246-250 
                    1          ,1          ,1          ,1          ,1          ,& ! 251-255 
                    1          ,1          ,1          ,1          ,1          ,& ! 256-260
                    1          ,1          ,1          ,1          ,1          ,& ! 261-265
                    1          ,1          ,1          ,1          ,1          ,& ! 266-270
                    1          ,1          ,1          ,1          ,1          ,& ! 271-275
                    1          ,1          ,1          ,1          ,1          ,& ! 276-280
                    1          ,1          ,1          ,1          ,1          ,& ! 281-285
                    1          ,1          ,1          ,1          ,1          ,& ! 286-290
                    1          ,1          ,1          ,1          ,1          ,& ! 291-295
                    1          ,1          ,1          ,1          ,1          ,& ! 296-300
                    1          ,1          ,1          ,1          ,1          ,& ! 301-305
                    1          ,1          ,1          ,1          ,1          ,& ! 306-310
                    1          ,1          ,1          ,1          ,1          ,& ! 311-315
                    1          ,1          ,1          ,1          ,1          ,& ! 316-320 
                    1          ,1          ,1          ,1          ,1          ,& ! 321-325 
                    1          ,1          ,1          ,1          ,1          ,& ! 326-330 
                    1          ,1          ,1          ,1          ,1          ,& ! 331-335 
                    1          ,1          ,1          ,1          ,1          ,& ! 336-340
                    1          ,1          ,1          ,1          ,1          ,& ! 341-345 
                    1          ,1          ,1          ,1          ,1          ,& ! 346-350 
                    1          ,1          ,1          ,1          ,1          ,& ! 351-355 
                    1          ,1          ,1          ,1          ,1          ,& ! 356-360 
                    1          ,1          ,1          ,1          ,1          ,& ! 361-365 
                    1          ,1          ,1          ,1          ,1          ,& ! 366-370 
                    1          ,1          ,1          ,1          ,1          ,& ! 371-375 
                    1          ,1          ,1          ,1          ,1          ,& ! 376-380 
                    1          ,1          ,1          ,1          ,1          ,& ! 381-385 
                    1          ,1          ,1          ,1          ,1          ,& ! 386-390 
                    1          ,1          ,1          ,1          ,1          ,& ! 391-395 
                    1          ,1          ,1          ,1          ,1          ,& ! 396-400 
                    1          ,1          ,1          ,1          ,1          ,& ! 401-405 
                    1          ,1          ,1          ,1          ,1          /) ! 406-410 


   DO k=1,nVars_Input
      Grd(k)%Units='K'
      Grd(k)%Name='Temperature'
      Grd(k)%NameG='TEMP'
      Grd(k)%ibMax=ibMax
      Grd(k)%jbMax=jbMax
      Grd(k)%nVars=nVars_Input
      Grd(k)%nSoil=nSoil_Input
      Grd(k)%nLevs=nLevs(k)
   END DO

   DO k=1,nVarscp
      Grd_CP(k)%Units='K'
      Grd_CP(k)%Name='Temperature'
      Grd_CP(k)%NameG='TEMP'
      Grd_CP(k)%ibMax=ibMax
      Grd_CP(k)%jbMax=jbMax
      Grd_CP(k)%nVars=nVarscp
      Grd_CP(k)%nnVeg=nnVeg
      Grd_CP(k)%nLevs=nLevscp(k)
   END DO

   maxstp = dt/DELTAOUT
   DO k=1,nVars
      CALL NULLIFING(Grd( k ),nLevs(k))
   END DO

   DO k=1,nVarscp
      CALL NULLIFING2(Grd_CP( k ),nLevscp(k))
   END DO

 END SUBROUTINE Init_IbisOutput

 SUBROUTINE RunOutput1D_Grads(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc)
  IMPLICIT NONE
  REAL(KIND=r8)  , INTENT(IN   ) :: tod
  INTEGER        , INTENT(IN   ) :: jdt
  INTEGER        , INTENT(IN   ) :: nband     ! INTENT(IN    ) :: nband
  REAL(KIND=r8)  , INTENT(IN   ) :: dt        ! INTENT(IN    ) :: dt 
  INTEGER        , INTENT(IN   ) :: idate (4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatec(4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatep(4)
  REAL(KIND=r8)  , INTENT(IN   ) :: DELTAOUT
  REAL(KIND=r8)  , INTENT(IN   ) :: latic(:,:)
  REAL(KIND=r8)  , INTENT(IN   ) :: longc(:,:)
  REAL(KIND=r4)      :: dumpdata
  REAL(KIND=r8)      :: time
  INTEGER            :: lrec
  INTEGER            :: deltat
  INTEGER            :: nCols
  INTEGER            :: irec
  INTEGER            :: reclen
  INTEGER            :: open_status
  INTEGER            :: ios
  INTEGER, PARAMETER   :: input_unit=100
  INTEGER, PARAMETER   :: input_unit_ctl=90

  INTEGER, PARAMETER   :: ok = 0  
  CHARACTER(LEN=255) :: PREFIX='OUTPUTIBIS'
  CHARACTER(LEN=255) :: SUFFIX='.bin'
  CHARACTER(LEN=255) :: namec
  CHARACTER(LEN=255) :: namectl
  CHARACTER(LEN=20) :: dump='                    '   
  CHARACTER(LEN=3)   :: clday(12)=(/'JAN','FEB','MAR','APR','MAY','JUN',&
                                   'JUL','AUG','SEP','OCT','NOV','DEC'/)
   CHARACTER(LEN=12)   :: date

  INTEGER :: k,i,j,ib,ll
  nCols=ibMax
  time =tod
  open_status = ok
  IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN
    step=0
    DO i=1,ibMax
       WRITE(namec,'(A16,I3.3)')'SAIDAMODELIBIS.S',i   
       IF(OPENFILE_CTL)OPEN(input_unit_ctl+i,FILE='./outputdata/'//TRIM(namec)//'.ctl',ACCESS='SEQUENTIAL',&
             FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE', &
            IOSTAT=open_status)
          IF( open_status == ok ) THEN

             IF(OPENFILE_CTL)THEN
               WRITE(input_unit_ctl+i,'(A6,A                    )',iostat = ios)'dset ^',TRIM(namec)//'.bin'
               WRITE(input_unit_ctl+i,'(A                       )',iostat = ios)'*'
               WRITE(input_unit_ctl+i,'(A6,E12.5                )',iostat = ios)'undef ',undef
               WRITE(input_unit_ctl+i,'(A                       )',iostat = ios)'*'
               WRITE(input_unit_ctl+i,'(A6,A                    )',iostat = ios)'title ',TRIM(namec)
               WRITE(input_unit_ctl+i,'(A                       )',iostat = ios)'*'
               WRITE(input_unit_ctl+i,'(A                       )',iostat = ios)'options yrev big_endian'
               WRITE(input_unit_ctl+i,'(A6,A,A,E12.5,A          )',iostat = ios)'xdef  ','1',' linear   ', longc(1,1),'   1.000000'
               WRITE(input_unit_ctl+i,'(A6,A,A,E12.5,A          )',iostat = ios)'ydef  ','1',' linear   ', latic(1,1),'   1.000000'
               WRITE(input_unit_ctl+1,'(A6,I5,A10               )',iostat = ios)'zdef  ', Grd(1)%nSoil,' levels   '
               WRITE(input_unit_ctl+1,'(10F10.2)')(depth(Grd(1)%nSoil-k+1),k=1,Grd(1)%nSoil)
               WRITE(date,'(I2.2,A1,I2.2,A3,I4.4)')idate(1),'Z',idate(3),clday(idate(2)),idate(4)
               deltat=DELTAOUT/60.0
               WRITE(input_unit_ctl+1,'(A6,A10,A10,A12,a,I10,A2)')'tdef  ','1000000   ',' linear   ',date,'  ',deltat,'mn'
               WRITE(input_unit_ctl+i,'(A6,I5                   )',iostat = ios)'VARS  ',Grd(1)%nVars
               DO k=1,nVars
                  IF(Grd(k)%nLevs==1)THEN
                     WRITE(input_unit_ctl+1,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)&
                     Grd(k)%NameG,Grd(k)%nLevs-1,' 99 ',TRIM(Grd(k)%Name),'[ ',TRIM(Grd(k)%Units),' ]'
                  ELSE
                     WRITE(input_unit_ctl+1,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)&
                     Grd(k)%NameG,Grd(k)%nLevs,' 99 ',TRIM(Grd(k)%Name),'[ ',TRIM(Grd(k)%Units),' ]'
                  END IF
               END DO
               WRITE(input_unit_ctl+i,'(A                       )',iostat = ios)'ENDVARS'
               CLOSE(input_unit_ctl+i,STATUS='KEEP') 
             END IF

         ELSE
             WRITE(0,*)"Unable to OPEN file";STOP
         END IF   

       WRITE(namec,'(A16,I3.3)')'SAIDAMODELIBIS.S',i   
       INQUIRE(IOLENGTH=lrec)dumpdata
       IF(OPENFILE)OPEN(input_unit+i,FILE='./outputdata/'//TRIM(namec)//'.bin',ACCESS='DIRECT',&
             FORM='UNFORMATTED',STATUS='UNKNOWN',ACTION='WRITE',RECL=lrec, &
             IOSTAT=open_status)
          IF( open_status == ok ) THEN

             DO j=1,jbMax 
                DO k=1,nVars
                   DO ll=1,nLevs(k)
                      NumberRec=NumberRec+1
                      WRITE(input_unit+i,rec=NumberRec,iostat = ios)Grd(k)%Buffer(i,ll,j);IF(ios /= 0) STOP
                      Grd(k)%Buffer(i,ll,j) =0.0_r8
                   END DO
                END DO

!                WRITE(input_unit+i,'(3I15,F15.4,51E15.5)',iostat = ios)&
!                idatec(4),idatec(2),idatec(3),REAL(idatec(1))+((tod/3600.0_r8) - int(tod/3600.0_r8)),&
!                Grd(1)%Buffer(i,1,j),Grd(2)%Buffer(i,1,j),Grd(3)%Buffer(i,1,j),&
!                Grd(4)%Buffer(i,1,j),Grd(4)%Buffer(i,2,j),Grd(4)%Buffer(i,3,j),&
!                Grd(4)%Buffer(i,4,j),Grd(4)%Buffer(i,5,j),Grd(4)%Buffer(i,6,j),&
!                Grd(5)%Buffer(i,1,j),Grd(6)%Buffer(i,1,j),Grd(6)%Buffer(i,2,j),&
!                Grd(6)%Buffer(i,3,j),Grd(6)%Buffer(i,4,j),Grd(6)%Buffer(i,5,j),Grd(6)%Buffer(i,6,j),&
!                Grd(7)%Buffer(i,1,j),Grd(8)%Buffer(i,1,j),Grd(9)%Buffer(i,1,j),Grd(10)%Buffer(i,1,j),&
!                Grd(11)%Buffer(i,1,j),Grd(12)%Buffer(i,1,j),Grd(13)%Buffer(i,1,j),Grd(14)%Buffer(i,1,j),&
!                Grd(15)%Buffer(i,1,j),Grd(16)%Buffer(i,1,j),Grd(17)%Buffer(i,1,j),Grd(18)%Buffer(i,1,j),&
!                Grd(19)%Buffer(i,1,j),Grd(20)%Buffer(i,1,j),Grd(21)%Buffer(i,1,j),Grd(22)%Buffer(i,1,j),&
!                Grd(23)%Buffer(i,1,j),Grd(24)%Buffer(i,1,j),Grd(25)%Buffer(i,1,j),Grd(26)%Buffer(i,1,j),&
!                Grd(27)%Buffer(i,1,j),Grd(28)%Buffer(i,1,j),Grd(29)%Buffer(i,1,j),Grd(30)%Buffer(i,1,j),&
!                Grd(31)%Buffer(i,1,j),Grd(32)%Buffer(i,1,j),Grd(33)%Buffer(i,1,j),Grd(34)%Buffer(i,1,j),&
!                Grd(35)%Buffer(i,1,j),Grd(36)%Buffer(i,1,j),Grd(37)%Buffer(i,1,j),Grd(38)%Buffer(i,1,j),&
!                Grd(38)%Buffer(i,1,j),Grd(40)%Buffer(i,1,j),Grd(41)%Buffer(i,1,j)
             END DO 
          ELSE
             WRITE(0,*)"Unable to OPEN file";STOP
          END IF   
      END DO
      OPENFILE=.FALSE.
      OPENFILE_CTL=.FALSE.
  END IF

 END SUBROUTINE RunOutput1D_Grads 



 SUBROUTINE RunOutput1D_Grads2(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc)
  IMPLICIT NONE
  REAL(KIND=r8)  , INTENT(IN   ) :: tod
  INTEGER        , INTENT(IN   ) :: jdt
  INTEGER        , INTENT(IN   ) :: nband     ! INTENT(IN    ) :: nband
  REAL(KIND=r8)  , INTENT(IN   ) :: dt        ! INTENT(IN    ) :: dt 
  INTEGER        , INTENT(IN   ) :: idate (4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatec(4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatep(4)
  REAL(KIND=r8)  , INTENT(IN   ) :: DELTAOUT
  REAL(KIND=r8)  , INTENT(IN   ) :: latic(:,:)
  REAL(KIND=r8)  , INTENT(IN   ) :: longc(:,:)
  REAL(KIND=r4)      :: dumpdata
  REAL(KIND=r8)      :: time
  INTEGER            :: lrec
  INTEGER            :: deltat
  INTEGER            :: nCols
  INTEGER            :: irec
  INTEGER            :: reclen
  INTEGER            :: open_status
  INTEGER            :: ios
  INTEGER, PARAMETER   :: input_unit2=50
  INTEGER, PARAMETER   :: input_unit_ctl2=70
  INTEGER, PARAMETER   :: ok = 0  
  CHARACTER(LEN=255) :: PREFIX='CANOPY_OUTPUTIBIS'
  CHARACTER(LEN=255) :: SUFFIX='.bin'
  CHARACTER(LEN=255) :: namec
  CHARACTER(LEN=255) :: namectl
  CHARACTER(LEN=20) :: dump='                    '   
  CHARACTER(LEN=3)   :: clday(12)=(/'JAN','FEB','MAR','APR','MAY','JUN',&
                                   'JUL','AUG','SEP','OCT','NOV','DEC'/)
   CHARACTER(LEN=12)   :: date

  INTEGER :: k,i,j,ib,ll
  nCols=ibMax
  time =tod
  open_status = ok
  IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN
    step=0
    DO i=1,ibMax
       WRITE(namec,'(A19,I3.3)')'CANOPY_OUTPUTIBIS.S',i   
       IF(OPENFILE_CTL_CP)OPEN(input_unit_ctl2+i,FILE='./outputdata/'//TRIM(namec)//'.ctl',ACCESS='SEQUENTIAL',&
             FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE', &
            IOSTAT=open_status)
          IF( open_status == ok ) THEN

             IF(OPENFILE_CTL_CP)THEN
               WRITE(input_unit_ctl2+i,'(A6,A                    )',iostat = ios)'dset ^',TRIM(namec)//'.bin'
               WRITE(input_unit_ctl2+i,'(A                       )',iostat = ios)'*'
               WRITE(input_unit_ctl2+i,'(A6,E12.5                )',iostat = ios)'undef ',undef
               WRITE(input_unit_ctl2+i,'(A                       )',iostat = ios)'*'
               WRITE(input_unit_ctl2+i,'(A6,A                    )',iostat = ios)'title ',TRIM(namec)
               WRITE(input_unit_ctl2+i,'(A                       )',iostat = ios)'*'
               WRITE(input_unit_ctl2+i,'(A                       )',iostat = ios)'options yrev big_endian'
               WRITE(input_unit_ctl2+i,'(A6,A,A,E12.5,A          )',iostat = ios)'xdef  ','1',' linear   ', longc(1,1),'   1.000000'
               WRITE(input_unit_ctl2+i,'(A6,A,A,E12.5,A          )',iostat = ios)'ydef  ','1',' linear   ', latic(1,1),'   1.000000'
               WRITE(input_unit_ctl2+i,'(A6,I5,A10               )',iostat = ios)'zdef  ', Grd_CP(1)%nnVeg,' levels   '
               WRITE(input_unit_ctl2+i,'(10F10.2)')(depthcp(Grd_CP(1)%nnVeg-k+1),k=1,Grd_CP(1)%nnVeg)
               WRITE(date,'(I2.2,A1,I2.2,A3,I4.4)')idate(1),'Z',idate(3),clday(idate(2)),idate(4)
               deltat=DELTAOUT/60.0
               WRITE(input_unit_ctl2+i,'(A6,A10,A10,A12,a,I10,A2)')'tdef  ','1000000   ',' linear   ',date,'  ',deltat,'mn'
               WRITE(input_unit_ctl2+i,'(A6,I5                   )',iostat = ios)'VARS  ',Grd_CP(1)%nVars
               DO k=1,nVarscp
                  IF(Grd_CP(k)%nLevs==1)THEN
                     WRITE(input_unit_ctl2+i,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)&
                     Grd_CP(k)%NameG,Grd_CP(k)%nLevs-1,' 99 ',TRIM(Grd_CP(k)%Name),'[ ',TRIM(Grd_CP(k)%Units),' ]'
                  ELSE
                     WRITE(input_unit_ctl2+i,'(A10,I5,A4,A,A2,A,A2)',iostat = ios)&
                     Grd_CP(k)%NameG,Grd_CP(k)%nLevs,' 99 ',TRIM(Grd_CP(k)%Name),'[ ',TRIM(Grd_CP(k)%Units),' ]'
                  END IF
               END DO
               WRITE(input_unit_ctl2+i,'(A                       )',iostat = ios)'ENDVARS'
               CLOSE(input_unit_ctl2+i,STATUS='KEEP') 
             END IF

         ELSE
             WRITE(0,*)"Unable to OPEN file";STOP
         END IF   

       WRITE(namec,'(A19,I3.3)')'CANOPY_OUTPUTIBIS.S',i   
       INQUIRE(IOLENGTH=lrec)dumpdata
       IF(OPENFILE_CP)OPEN(input_unit2+i,FILE='./outputdata/'//TRIM(namec)//'.bin',ACCESS='DIRECT',&
             FORM='UNFORMATTED',STATUS='UNKNOWN',ACTION='WRITE',RECL=lrec, &
             IOSTAT=open_status)
          IF( open_status == ok ) THEN

             DO j=1,jbMax 
                DO k=1,nVarscp
                   DO ll=1,nLevscp(k)
                      NumberRecCP=NumberRecCP+1
                      WRITE(input_unit2+i,rec=NumberRecCP,iostat = ios)Grd_CP(k)%Buffer2(i,ll,j);IF(ios /= 0) STOP
                      Grd_CP(k)%Buffer2(i,ll,j) =0.0_r8
                   END DO
                END DO

!                WRITE(input_unit2+i,'(3I15,F15.4,51E15.5)',iostat = ios)&
!                idatec(4),idatec(2),idatec(3),REAL(idatec(1))+((tod/3600.0_r8) - int(tod/3600.0_r8)),&
!                Grd(1)%Buffer(i,1,j),Grd(2)%Buffer(i,1,j),Grd(3)%Buffer(i,1,j),&
!                Grd(4)%Buffer(i,1,j),Grd(4)%Buffer(i,2,j),Grd(4)%Buffer(i,3,j),&
!                Grd(4)%Buffer(i,4,j),Grd(4)%Buffer(i,5,j),Grd(4)%Buffer(i,6,j),&
!                Grd(5)%Buffer(i,1,j),Grd(6)%Buffer(i,1,j),Grd(6)%Buffer(i,2,j),&
!                Grd(6)%Buffer(i,3,j),Grd(6)%Buffer(i,4,j),Grd(6)%Buffer(i,5,j),Grd(6)%Buffer(i,6,j),&
!                Grd(7)%Buffer(i,1,j),Grd(8)%Buffer(i,1,j),Grd(9)%Buffer(i,1,j),Grd(10)%Buffer(i,1,j),&
!                Grd(11)%Buffer(i,1,j),Grd(12)%Buffer(i,1,j),Grd(13)%Buffer(i,1,j),Grd(14)%Buffer(i,1,j),&
!                Grd(15)%Buffer(i,1,j),Grd(16)%Buffer(i,1,j),Grd(17)%Buffer(i,1,j),Grd(18)%Buffer(i,1,j),&
!                Grd(19)%Buffer(i,1,j),Grd(20)%Buffer(i,1,j),Grd(21)%Buffer(i,1,j),Grd(22)%Buffer(i,1,j),&
!                Grd(23)%Buffer(i,1,j),Grd(24)%Buffer(i,1,j),Grd(25)%Buffer(i,1,j),Grd(26)%Buffer(i,1,j),&
!                Grd(27)%Buffer(i,1,j),Grd(28)%Buffer(i,1,j),Grd(29)%Buffer(i,1,j),Grd(30)%Buffer(i,1,j),&
!                Grd(31)%Buffer(i,1,j),Grd(32)%Buffer(i,1,j),Grd(33)%Buffer(i,1,j),Grd(34)%Buffer(i,1,j),&
!                Grd(35)%Buffer(i,1,j),Grd(36)%Buffer(i,1,j),Grd(37)%Buffer(i,1,j),Grd(38)%Buffer(i,1,j),&
!                Grd(38)%Buffer(i,1,j),Grd(40)%Buffer(i,1,j),Grd(41)%Buffer(i,1,j)
             END DO 
          ELSE
             WRITE(0,*)"Unable to OPEN file";STOP
          END IF   
      END DO
      OPENFILE_CP=.FALSE.
      OPENFILE_CTL_CP=.FALSE.
  END IF

 END SUBROUTINE RunOutput1D_Grads2 
  
 SUBROUTINE RunOutput1D(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc)
  IMPLICIT NONE
  REAL(KIND=r8), INTENT(IN   ) :: tod
  INTEGER        , INTENT(IN   ) :: jdt
  INTEGER        , INTENT(IN   ) :: nband     ! INTENT(IN    ) :: nband
  REAL(KIND=r8), INTENT(IN   ) :: dt             ! INTENT(IN    ) :: dt 
  INTEGER        , INTENT(IN   ) :: idate (4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatec(4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatep(4)
  REAL(KIND=r8), INTENT(IN   ) :: DELTAOUT
  REAL(KIND=r8), INTENT(IN   ) :: latic(:,:)
  REAL(KIND=r8), INTENT(IN   ) :: longc(:,:)
  REAL(KIND=r8)     :: time
  INTEGER            :: nCols
  INTEGER            :: irec
  INTEGER            :: reclen
  INTEGER            :: open_status
  INTEGER            :: ios
  INTEGER, PARAMETER   :: input_unit=100
  INTEGER, PARAMETER   :: ok = 0  
  CHARACTER(LEN=255) :: PREFIX='OUTPUTIBIS'
  CHARACTER(LEN=255) :: SUFFIX='.bin'
  CHARACTER(LEN=255) :: namec
  CHARACTER(LEN=20) :: dump='                    '   

  INTEGER :: k,i,j,ib
  nCols=ibMax
  time =tod
  open_status = ok
  IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN
    step=0
    DO i=1,ibMax
       WRITE(namec,'(A16,I3.3)')'SAIDAMODELIBIS.S',i   
       IF(OPENFILE)OPEN(input_unit+i,FILE='./outputdata/'//TRIM(namec),ACCESS='SEQUENTIAL',&
             FORM='FORMATTED',STATUS='UNKNOWN',ACTION='WRITE', &
            IOSTAT=open_status)
          IF( open_status == ok ) THEN

             IF(OPENFILE)WRITE(input_unit+i,'(55A15)',iostat = ios)&
                'ano','mes','dia','hora',&
                Grd(1)%NameG,Grd(2)%NameG,Grd(3)%NameG,&
                Grd(4)%NameG,Grd(4)%NameG,Grd(4)%NameG,&
                Grd(4)%NameG,Grd(4)%NameG,Grd(4)%NameG,&
                Grd(5)%NameG,Grd(6)%NameG,Grd(6)%NameG,&
                Grd(6)%NameG,Grd(6)%NameG,Grd(6)%NameG,Grd(6)%NameG,&
                Grd(7)%NameG,Grd(8)%NameG,Grd(9)%NameG,Grd(10)%NameG,&
                Grd(11)%NameG,Grd(12)%NameG,Grd(13)%NameG,Grd(14)%NameG,&
                Grd(15)%NameG,Grd(16)%NameG,Grd(17)%NameG,Grd(18)%NameG,&
                Grd(19)%NameG,Grd(20)%NameG,Grd(21)%NameG,Grd(22)%NameG,&
                Grd(23)%NameG,Grd(24)%NameG,Grd(25)%NameG,Grd(26)%NameG,&
                Grd(27)%NameG,Grd(28)%NameG,Grd(29)%NameG,Grd(30)%NameG,&
                Grd(31)%NameG,Grd(32)%NameG,Grd(33)%NameG,Grd(34)%NameG,&
                Grd(35)%NameG,Grd(36)%NameG,Grd(37)%NameG,Grd(38)%NameG,&
                Grd(39)%NameG,Grd(40)%NameG,Grd(41)%NameG
             IF(OPENFILE)WRITE(input_unit+i,'(4A16,51A15)',iostat = ios)&
                dump,dump,dump,dump,&
                Grd(1)%Units,Grd(2)%Units,Grd(3)%Units,&
                Grd(4)%Units,Grd(4)%Units,Grd(4)%Units,&
                Grd(4)%Units,Grd(4)%Units,Grd(4)%Units,&
                Grd(5)%Units,Grd(6)%Units,Grd(6)%Units,&
                Grd(6)%Units,Grd(6)%Units,Grd(6)%Units,Grd(6)%Units,&
                Grd(7)%Units,Grd(8)%Units,Grd(9)%Units,Grd(10)%Units,&
                Grd(11)%Units,Grd(12)%Units,Grd(13)%Units,Grd(14)%Units,&
                Grd(15)%Units,Grd(16)%Units,Grd(17)%Units,Grd(18)%Units,&
                Grd(19)%Units,Grd(20)%Units,Grd(21)%Units,Grd(22)%Units,&
                Grd(23)%Units,Grd(24)%Units,Grd(25)%Units,Grd(26)%Units,&
                Grd(27)%Units,Grd(28)%Units,Grd(29)%Units,Grd(30)%Units,&
                Grd(31)%Units,Grd(32)%Units,Grd(33)%Units,Grd(34)%Units,&
                Grd(35)%Units,Grd(36)%Units,Grd(37)%Units,Grd(38)%Units,&
                Grd(39)%Units,Grd(40)%Units,Grd(41)%Units

             DO j=1,jbMax 
                WRITE(input_unit+i,'(3I15,F15.4,51E15.5)',iostat = ios)&
                idatec(4),idatec(2),idatec(3),REAL(idatec(1))+((tod/3600.0_r8) - int(tod/3600.0_r8)),&
                Grd(1)%Buffer(i,1,j),Grd(2)%Buffer(i,1,j),Grd(3)%Buffer(i,1,j),&
                Grd(4)%Buffer(i,1,j),Grd(4)%Buffer(i,2,j),Grd(4)%Buffer(i,3,j),&
                Grd(4)%Buffer(i,4,j),Grd(4)%Buffer(i,5,j),Grd(4)%Buffer(i,6,j),&
                Grd(5)%Buffer(i,1,j),Grd(6)%Buffer(i,1,j),Grd(6)%Buffer(i,2,j),&
                Grd(6)%Buffer(i,3,j),Grd(6)%Buffer(i,4,j),Grd(6)%Buffer(i,5,j),Grd(6)%Buffer(i,6,j),&
                Grd(7)%Buffer(i,1,j),Grd(8)%Buffer(i,1,j),Grd(9)%Buffer(i,1,j),Grd(10)%Buffer(i,1,j),&
                Grd(11)%Buffer(i,1,j),Grd(12)%Buffer(i,1,j),Grd(13)%Buffer(i,1,j),Grd(14)%Buffer(i,1,j),&
                Grd(15)%Buffer(i,1,j),Grd(16)%Buffer(i,1,j),Grd(17)%Buffer(i,1,j),Grd(18)%Buffer(i,1,j),&
                Grd(19)%Buffer(i,1,j),Grd(20)%Buffer(i,1,j),Grd(21)%Buffer(i,1,j),Grd(22)%Buffer(i,1,j),&
                Grd(23)%Buffer(i,1,j),Grd(24)%Buffer(i,1,j),Grd(25)%Buffer(i,1,j),Grd(26)%Buffer(i,1,j),&
                Grd(27)%Buffer(i,1,j),Grd(28)%Buffer(i,1,j),Grd(29)%Buffer(i,1,j),Grd(30)%Buffer(i,1,j),&
                Grd(31)%Buffer(i,1,j),Grd(32)%Buffer(i,1,j),Grd(33)%Buffer(i,1,j),Grd(34)%Buffer(i,1,j),&
                Grd(35)%Buffer(i,1,j),Grd(36)%Buffer(i,1,j),Grd(37)%Buffer(i,1,j),Grd(38)%Buffer(i,1,j),&
                Grd(38)%Buffer(i,1,j),Grd(40)%Buffer(i,1,j),Grd(41)%Buffer(i,1,j)
             END DO 
             IF(ios /= 0) STOP
             DO k=1,nVars
                DO ib=1,nLevs(k)
                    Grd(k)%Buffer(:,ib,:) =0.0_r8
                END DO
             END DO
          ELSE
             WRITE(0,*)"Unable to OPEN file";STOP
         END IF   
      END DO
      OPENFILE=.FALSE.
  END IF
 END SUBROUTINE RunOutput1D 

 SUBROUTINE RunOutput(jdt,tod,nband,dt,idate,idatec,idatep,DELTAOUT,latic,longc)
  IMPLICIT NONE
  REAL(KIND=r8), INTENT(IN   ) :: tod
  INTEGER        , INTENT(IN   ) :: jdt
  INTEGER        , INTENT(IN   ) :: nband  ! INTENT(IN         ) :: nband
  REAL(KIND=r8), INTENT(IN   ) :: dt         ! INTENT(IN        ) :: dt 
  INTEGER        , INTENT(IN   ) :: idate (4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatec(4) ! INTENT(IN    ) :: idatec(:)
  INTEGER        , INTENT(IN   ) :: idatep(4)
  REAL(KIND=r8), INTENT(IN   ) :: DELTAOUT
  REAL(KIND=r8), INTENT(IN   ) :: latic(:,:)
  REAL(KIND=r8), INTENT(IN   ) :: longc(:,:)
  REAL(KIND=r8)     :: time
  INTEGER            :: nCols
  INTEGER            :: irec
  INTEGER            :: reclen
  INTEGER            :: open_status
  INTEGER            :: ios
  INTEGER, PARAMETER   :: input_unit=19
  INTEGER, PARAMETER   :: ok = 0  
  CHARACTER(LEN=255) :: PREFIX='OUTPUTIBIS'
  CHARACTER(LEN=255) :: SUFFIX='.bin'
  CHARACTER(LEN=255) :: namec
  INTEGER :: k,i
  nCols=ibMax
  time =tod
  IF(MOD(tod,DELTAOUT) == 0.0_r8 )THEN
    step=0
    WRITE(namec,'(A10,2(I4.4,3i2.2),A4)')TRIM(PREFIX),&
    idate(4),idate(2),idate(3),idate(1),&
    idatec(4),idatec(2),idatec(3),idatec(1),&
    TRIM(SUFFIX)    
    INQUIRE(IOLENGTH=reclen)        Grd(1)%Buffer(:,1,:)
    OPEN(input_unit,FILE='./outputdata/'//TRIM(namec),ACCESS='DIRECT',&
        FORM='UNFORMATTED',STATUS='UNKNOWN',RECL=reclen,ACTION='WRITE', &
        IOSTAT=open_status)
    IF( open_status == ok ) THEN
        CALL Wrctls(namec,input_unit,longc,latic,idatec)
        irec=1
        DO k=1,nVars
          DO i=1,nLevs(k)
              WRITE(input_unit,rec=irec,iostat = ios)Grd(k)%Buffer(:,i,:);IF(ios /= 0) STOP
              !WRITE(0,*)'latic',MAXVAL(Grd(k)%Buffer(:,i,:)),MINVAL(Grd(k)%Buffer(:,i,:))
              irec=irec+1
              Grd(k)%Buffer(:,i,:) =0.0_r8
          END DO
        END DO
        CLOSE(input_unit,STATUS='KEEP')         
    ELSE
       WRITE(0,*)"Unable to OPEN file";STOP
    END IF   
  END IF
 END SUBROUTINE RunOutput
 
 SUBROUTINE Wrctls(namec,input_unit,longc,latic,idatec)
   IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN   ) :: namec
   INTEGER, INTENT(IN   ) :: input_unit
   REAL(KIND=r8), INTENT(IN   ) :: longc(:,:)
   REAL(KIND=r8), INTENT(IN   ) :: latic(:,:)
   INTEGER        , INTENT(IN   ) :: idatec(4) ! INTENT(IN    ) :: idatec(:)
   INTEGER            :: open_status
   INTEGER, PARAMETER   :: ok = 0  
   CHARACTER(LEN=12)   :: date
   CHARACTER(LEN=3)   :: clday(12)=(/'JAN','FEB','MAR','APR','MAY','JUN',&
                                   'JUL','AUG','SEP','OCT','NOV','DEC'/)
   INTEGER :: lch,i,j,k
   lch=LEN_TRIM(TRIM(namec))-4
   OPEN(input_unit+1,FILE='./outputdata/'//namec(1:lch)//'.ctl',FORM='FORMATTED',&
       ACTION='WRITE',STATUS='UNKNOWN',IOSTAT=open_status)
   
   IF( open_status == ok ) THEN
      WRITE(input_unit+1,'(A6,A)')'dset ^',TRIM(namec)
      WRITE(input_unit+1,'(A8,A6,A12)')'options ',' yrev ',' big_endian '
      WRITE(input_unit+1,'(A6,e12.5)')'undef ',undef
      WRITE(input_unit+1,'(A6,A)')'title ','CPTEC-IBIS  PROJECT'
      WRITE(input_unit+1,'(A6,I5,A10)')'xdef  ',Grd(1)%ibMax,' levels   '
      WRITE(input_unit+1,'(10F12.5)')(longc(i,1),i=1,Grd(1)%ibMax)
      WRITE(input_unit+1,'(A6,I5,A10)')'ydef  ',Grd(1)%jbMax,' levels   '
      WRITE(input_unit+1,'(10F12.5)')(latic(1,j),j=1,Grd(1)%jbMax)
      WRITE(input_unit+1,'(A6,I5,A10)')'zdef  ', Grd(1)%nSoil,' levels   '
      WRITE(input_unit+1,'(10I10)')(i,i=1,Grd(1)%nSoil)
      WRITE(date,'(I2.2,A1,I2.2,A3,I4.4)')idatec(1),'Z',idatec(3),clday(idatec(2)),idatec(4)
      WRITE(input_unit+1,'(A6,A5,A10,A12,A6)')'tdef  ',' 1   ',' linear   ',date,'  6hr '
      WRITE(input_unit+1,'(A6,I5)')'vars  ', Grd(1)%nVars  
      DO k=1,Grd(1)%nVars  
         WRITE(input_unit+1,'(A10,I5,A4,A,A2,A,A2)')&
         Grd(k)%NameG,Grd(k)%nLevs,' 99 ',TRIM(Grd(k)%Name),'[ ',TRIM(Grd(k)%Units),' ]'
      END DO          
      WRITE(input_unit+1,'(A7)')'endvars'
   ELSE
      WRITE(0,*)"Unable to OPEN file";STOP
   END IF   
   CLOSE(input_unit+1,STATUS='KEEP')

 END SUBROUTINE Wrctls

 SUBROUTINE NULLIFING(a,nLevs)
  IMPLICIT NONE
   TYPE(GRADS)          :: a
   INTEGER, INTENT(IN   ) :: nLevs 

   IF ( ASSOCIATED( a%Buffer) )  NULLIFY ( a%Buffer )   
   ALLOCATE( a%Buffer(ibMax,nLevs,jbMax) )
   a%Buffer=0.0_r8

 END SUBROUTINE NULLIFING
 
 SUBROUTINE NULLIFING2(a,nLevs)
  IMPLICIT NONE
   TYPE(GRADS2)          :: a
   INTEGER, INTENT(IN   ) :: nLevs 

   IF ( ASSOCIATED( a%Buffer2) )  NULLIFY ( a%Buffer2)   
   ALLOCATE( a%Buffer2(ibMax,nLevs,jbMax) )
   a%Buffer2=0.0_r8

 END SUBROUTINE NULLIFING2
END MODULE IbisOutput

