MODULE dynetat0_hz_mod 
  USE genmod
  USE icosa
  IMPLICIT NONE 
  PRIVATE

       PUBLIC  etat0
       INTEGER,SAVE::ncell
       TYPE(t_field),POINTER:: f_iu(:)
       TYPE(t_field),POINTER:: f_iv(:) 
       TYPE(t_field),POINTER:: f_iue(:)
       TYPE(t_field),POINTER:: f_ive(:) 
       REAL(rstd),POINTER :: iu(:,:),iv(:,:)
       REAL(rstd),POINTER :: iue(:,:),ive(:,:) 

 
CONTAINS

    SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
  USE icosa
  USE caldyn_mod
  USE write_field  
  USE maxicosa
  USE wind_mod
        IMPLICIT NONE
     TYPE(t_domain),POINTER :: d 
     TYPE(t_field),POINTER:: f_ps(:)
     TYPE(t_field),POINTER:: f_phis(:)
     TYPE(t_field),POINTER:: f_u(:)
     TYPE(t_field),POINTER:: f_q(:)
     TYPE(t_field),POINTER:: f_theta_rhodz(:) 
     TYPE(t_field),POINTER::  f_buf_i3(:), f_buf1_i(:), f_buf2_i(:)
     REAL(rstd),POINTER :: ps(:)
     REAL(rstd),POINTER :: phis(:)
     REAL(rstd),POINTER :: theta_rhodz(:,:)
     REAL(rstd),POINTER :: u(:,:) 
     REAL(rstd),POINTER :: q(:,:,:)
     REAL(rstd):: maxff,minff,maxuu,minuu
     INTEGER :: ind
 
     CALL allocate_field(f_iu,field_t,type_real,llm) 
     CALL allocate_field(f_iv,field_t,type_real,llm)
     CALL allocate_field(f_iue,field_u,type_real,llm) 
     CALL allocate_field(f_ive,field_u,type_real,llm)
     CALL allocate_field(f_u,field_u,type_real,llm) 
     CALL allocate_field(f_buf1_i,field_t,type_real,llm) 
     CALL allocate_field(f_buf2_i,field_t,type_real,llm) 
     CALL allocate_field(f_buf_i3,field_u,type_real,3,llm) 
  
     PRINT*,"IN NETCDF READ"
!------------------------------------zero 
	DO ind=1,ndomain
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
	  iu = f_iu(ind) 
	  iv = f_iv(ind) 
      iue = f_iue(ind) 
	 ive = f_ive(ind) 	
	   u = f_u(ind) 
	  iu = 0.0 
	  iv = 0.0 
	   u = 0.0 
	 iue = 0.0	
	 ive = 0.0 
     END DO 
!--------------------------------------------
     ncell = 0
     DO ind=1,ndomain
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
      d => domain_glo(ind)
      ps=f_ps(ind)
      phis=f_phis(ind)
      theta_rhodz=f_theta_rhodz(ind)
      q=f_q(ind)
      iu=f_iu(ind) 
      iv=f_iv(ind) 
      CALL compute_dynetat0(ind,d,ps,phis,theta_rhodz,iu,iv,q)
      ENDDO

     CALL transfert_request(f_ps,req_i1)
	CALL transfert_request(f_phis,req_i1)
	CALL transfert_request(f_theta_rhodz,req_i1)
	CALL transfert_request(f_q,req_i1)
	CALL transfert_request(f_iu,req_i1)
	CALL transfert_request(f_iv,req_i1)
!------------------------------------------
	DO ind=1,ndomain
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
	 u=f_u(ind)
	 iu=f_iu(ind) 
	 iv=f_iv(ind) 
	 iue=f_iue(ind) 
	 ive=f_ive(ind) 
  	 CALL compute_dynetatu(iu,iv,iue,ive,u)
	ENDDO
!------------- OUTPUT OF Variables 
	CALL un2ulonlat(f_u,f_buf1_i,f_buf2_i) 
	CALL writefield("buf1",f_buf1_i)
  END SUBROUTINE etat0

!==================================================================
  SUBROUTINE compute_dynetat0(ind,d,ps,phis,theta_rhodz,iu,iv,q) 
   use icosa
   use netcdf
   use wind_mod 
   USE disvert_mod
 	IMPLICIT NONE 
   TYPE(t_domain),POINTER :: d 
   CHARACTER*20::dimname 
   REAL(rstd), INTENT(OUT) :: ps(iim*jjm)
   REAL(rstd), INTENT(OUT) :: phis(iim*jjm)
   REAL(rstd), INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
   REAL(rstd), INTENT(OUT) :: q(iim*jjm,llm,nqtot)
   REAL(rstd),ALLOCATABLE :: mass(:,:)   ! mass    
   REAL(rstd),ALLOCATABLE :: rhodz(:,:)   ! mass density  
   REAL(rstd),ALLOCATABLE :: theta(:,:) 
   REAL(rstd),ALLOCATABLE :: p(:,:)  ! pression
   REAL(rstd),POINTER :: iu(:,:),iv(:,:)
   REAL(rstd),POINTER :: icops(:)
   REAL(rstd),POINTER :: icophis(:)
   REAL(rstd),POINTER :: icou(:,:),icov(:,:)
   REAL(rstd),POINTER :: icotheta(:,:)
   REAL(rstd),POINTER :: icoq(:,:,:)
   
   INTEGER length,iq,ind,l
   PARAMETER (length = 1)
   CHARACTER(LEN=200):: iqq ! tableau des parametres du run
   INTEGER::ierr,nid,ncid,nvarid,dimid,nind
   INTEGER::ncells  
   INTEGER::halo_size,i,j,k,ij
   LOGICAL::single 
   INTEGER::nDims,nVars,nGlobalAtts,unlimdimid
   INTEGER:: len
   
!	OPEN NETCDF FILE 
	 ierr = NF90_OPEN ("icosa_hz30.nc",NF90_NOWRITE,nid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)'dynetat0: with file icosa_hz30.nc'
        write(*,*)' ierr = ', ierr
        STOP 
      ENDIF

     ierr= nf90_inquire(nid,nDims,nVars,nGlobalAtts,unlimdimid)
	IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)'Problem in inquire'
        write(*,*)' ierr = ', ierr
        STOP 
      ENDIF

	PRINT*,"nDims,nVars,nGlobalAtts,unlimdimid"
	PRINT*,nDims,nVars,nGlobalAtts,unlimdimid


	 ierr = NF90_INQ_DIMID(nid,"ncells",dimid)
	 IF (ierr .NE. NF90_NOERR ) THEN 
	   write(*,*)'ncells is not present in hzdy_30.nc'
        write(*,*)' ierr = ', ierr
	   STOP 
	 ENDIF 
	   
	 ierr = nf90_inquire_dimension(nid,dimid,dimname,ncells)
	 IF (ierr .NE. NF90_NOERR ) THEN 
	   write(*,*)'ncells  in hzdy_30.nc'
        write(*,*)' ierr = ', ierr
	   STOP 
	 ENDIF

	  ALLOCATE(icops(ncells))
	  ALLOCATE(icophis(ncells))
	  ALLOCATE(icou(ncells,llm))
	  ALLOCATE(icov(ncells,llm))
	  ALLOCATE(icotheta(ncells,llm))
	  ALLOCATE(icoq(ncells,llm,nqtot))
       ALLOCATE(p(iim*jjm,llm+1))
	  ALLOCATE(theta(iim*jjm,llm)) 
       ALLOCATE(mass(iim*jjm,llm))   ! mass    
       ALLOCATE(rhodz(iim*jjm,llm))   ! mass density   
!============================================================
      ierr = NF90_INQ_VARID(nid, "phis", nvarid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)"dynetat0: phis is absent"
	   write(*,*)' ierr = ', ierr
         STOP       
      ENDIF

      ierr = NF90_GET_VAR(nid, nvarid, icophis)
      IF (ierr .NE. NF90_NOERR) THEN
         write(*,*)"dynetat0: PROBLEM IN PHIS"
         STOP
      ENDIF
!==============================================================
	  ierr = NF90_INQ_VARID(nid, "ps", nvarid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)"dynetat0: ps is absent"
	   write(*,*)' ierr = ', ierr
         STOP       
      ENDIF

      ierr = NF90_GET_VAR(nid, nvarid, icops)
      IF (ierr .NE. NF90_NOERR) THEN
         write(*,*)"dynetat0: PROBLEM IN PS"
         STOP
      ENDIF
!================================================================
	  ierr = NF90_INQ_VARID(nid, "theta", nvarid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)"dynetat0: teta is not available in start.nc"
	   write(*,*)' ierr = ', ierr
         STOP       
      ENDIF

      ierr = NF90_GET_VAR(nid, nvarid,icotheta)
      IF (ierr .NE. NF90_NOERR) THEN
         write(*,*)"dynetat0: PROBLEM IN Teta"
         STOP
      ENDIF
!================================================================
	DO iq = 1,nqtot   
		write(iqq,*)INT(iq)
		iqq=ADJUSTL(iqq)  
     	ierr = NF90_INQ_VARID(nid,"q"//iqq, nvarid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)"dynetat0: ","q"//iqq,"not here"
	   write(*,*)' ierr = ', ierr
         STOP       
      ENDIF

      ierr = NF90_GET_VAR(nid, nvarid,icoq(:,:,iq))
      IF (ierr .NE. NF90_NOERR) THEN
         write(*,*)"dynetat0: PROBLEM IN Q"
         STOP
      ENDIF
	END DO
!===============================================================
	 ierr = NF90_INQ_VARID(nid, "ulon", nvarid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)"dynetat0: ulon is not in file"
	   write(*,*)' ierr = ', ierr
         STOP       
      ENDIF
	
      ierr = NF90_GET_VAR(nid, nvarid,icou)
      IF (ierr .NE. NF90_NOERR) THEN
         write(*,*)"dynetat0: PROBLEM IN ucov"
         STOP
      ENDIF
!================================================================
	  ierr = NF90_INQ_VARID(nid, "ulat", nvarid)
      IF (ierr .NE. NF90_NOERR) THEN
        write(*,*)"dynetat0: ulat is not available in start.nc"
	   write(*,*)' ierr = ', ierr
         STOP       
      ENDIF

      ierr = NF90_GET_VAR(nid, nvarid,icov)
      IF (ierr .NE. NF90_NOERR) THEN
         write(*,*)"dynetat0: PROBLEM IN vlat"
         STOP
      ENDIF
!================================================================
			iu = 0.0 ; iv = 0.0 
             DO j=d%jj_begin,d%jj_end
              DO i=d%ii_begin,d%ii_end
                  k=d%iim*(j-1)+i
                 IF (d%assign_domain(i,j)==ind ) THEN
                     ncell=ncell+1
				 phis(k)= icophis(ncell) 
	                ps(k)= icops(ncell) 
	                theta(k,:) = icotheta(ncell,:) 
	                q(k,:,:)= icoq(ncell,:,:) 
	                iu(k,:) = icou(ncell,:)
				 iv(k,:) = icov(ncell,:)
			   ENDIF
                ENDDO
              ENDDO

    DO    l    = 1, llm+1
      DO j=jj_begin,jj_end
        DO i=ii_begin,ii_end
          ij=(j-1)*iim+i
          p(ij,l) = ap(l) + bp(l) * ps(ij)
        ENDDO
      ENDDO
    ENDDO

   DO l = 1, llm
     DO j=jj_begin,jj_end
       DO i=ii_begin,ii_end
         ij=(j-1)*iim+i
         mass(ij,l) = ( p(ij,l) - p(ij,l+1) )*Ai(ij)/g
         rhodz(ij,l) = mass(ij,l) / Ai(ij)
       ENDDO
     ENDDO
   ENDDO

    DO    l    = 1, llm
      DO j=jj_begin,jj_end
        DO i=ii_begin,ii_end
          ij=(j-1)*iim+i
          theta_rhodz(ij,l) = theta(ij,l)*rhodz(ij,l)
        ENDDO
      ENDDO
    ENDDO

	  DEALLOCATE(icops)
	  DEALLOCATE(icophis)
	  DEALLOCATE(icou)
	  DEALLOCATE(icov)
	  DEALLOCATE(icotheta)
	  DEALLOCATE(p)
	  DEALLOCATE(theta) 
       DEALLOCATE(mass)   ! mass    
       DEALLOCATE(rhodz)   !
	END SUBROUTINE compute_dynetat0
!==================================================================
	  SUBROUTINE compute_dynetatu(iu,iv,iue,ive,u) 
   use icosa
   use wind_mod 
    	IMPLICIT NONE 
   CHARACTER*20::dimname 
   REAL(rstd),INTENT(OUT):: u(3*iim*jjm,llm)
   REAL(rstd) :: iu(iim*jjm,llm),iv(iim*jjm,llm)
   REAL(rstd) :: iue(3*iim*jjm,llm),ive(3*iim*jjm,llm)
   INTEGER::halo_size,i,j,k,ij,l


  Do l = 1, llm
   DO j=jj_begin-1,jj_end+1
      DO i=ii_begin-1,ii_end+1
         k=iim*(j-1)+i
	   iue(k+u_right,l)=0.5*(iu(k,l)+iu(k+t_right,l))
        iue(k+u_lup,l)  =0.5*(iu(k,l)+iu(k+t_lup,l))
        iue(k+u_ldown,l)=0.5*(iu(k,l)+iu(k+t_ldown,l)) 
!------------------------------------------------------ 
	   ive(k+u_right,l)=0.5*(iv(k,l)+iv(k+t_right,l))
        ive(k+u_lup,l)  =0.5*(iv(k,l)+iv(k+t_lup,l))
        ive(k+u_ldown,l)=0.5*(iv(k,l)+iv(k+t_ldown,l)) 
	 END DO
    END DO 
  END DO 
	CALL compute_wind_perp_from_lonlat_compound(iue,ive,u) 

	END SUBROUTINE compute_dynetatu


 END MODULE dynetat0_hz_mod