source: codes/icosagcm/trunk/src/output/write_etat0.f90 @ 1013

MODULE write_etat0_mod



CONTAINS

  SUBROUTINE write_etat0(it,f_ps,f_phis,f_theta_rhodz,f_u, f_q, f_geopot, f_W)
  USE icosa
  USE restart_mod
  USE wind_mod
  USE write_field_mod
  USE domain_mod
  USE omp_para
  USE xios_mod
  USE checksum_mod
  IMPLICIT NONE
    INTEGER,INTENT(IN)    :: it
    TYPE(t_field),POINTER :: f_ps(:)
    TYPE(t_field),POINTER :: f_phis(:)
    TYPE(t_field),POINTER :: f_theta_rhodz(:)
    TYPE(t_field),POINTER :: f_u(:)
    TYPE(t_field),POINTER :: f_q(:)
    TYPE(t_field),POINTER, OPTIONAL :: f_geopot(:)
    TYPE(t_field),POINTER, OPTIONAL :: f_W(:)
  
    TYPE(t_field),POINTER,SAVE :: f_ulon(:)
    TYPE(t_field),POINTER,SAVE :: f_ulat(:)
    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
    TYPE(t_field),POINTER,SAVE :: f_xcell(:),f_ycell(:),f_zcell(:)
    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
    REAL(rstd), POINTER :: xcell(:), ycell(:), zcell(:)
    INTEGER :: ind,n,i,j
    
    
    CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
    CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
    CALL allocate_field(f_xcell,field_t,type_real,name='xcell')
    CALL allocate_field(f_ycell,field_t,type_real,name='ycell')
    CALL allocate_field(f_zcell,field_t,type_real,name='zcell')

!$OMP BARRIER    
    DO ind=1, ndomain
      IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
      theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
      theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
   
      xcell=f_xcell(ind) ; ! xcell=xyz_i(:,1)/radius  => cannot use due to rounding error
      ycell=f_ycell(ind) ; ! ycell=xyz_i(:,2)/radius  => for 1+1=2
      zcell=f_zcell(ind) ; ! zcell=xyz_i(:,3)/radius

      DO j=jj_begin,jj_end
        DO i=ii_begin,ii_end
          n=(j-1)*iim+i
          xcell(n) = domain(ind)%xyz(1,i,j) ! not the best but for now it works
          ycell(n) = domain(ind)%xyz(2,i,j) 
          zcell(n) = domain(ind)%xyz(3,i,j) 
        ENDDO
      ENDDO       
    ENDDO
    
    CALL transfert_request(f_u,req_e1_vect)
    CALL un2ulonlat(f_u, f_ulon, f_ulat)

    IF(hydrostatic) THEN
       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_xcell, f_ycell, f_zcell )
    ELSE
       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_geopot, f_W, f_xcell, f_ycell, f_zcell)
    END IF
    CALL deallocate_field(f_ulon)
    CALL deallocate_field(f_ulat)
    
  END SUBROUTINE write_etat0
    
END MODULE write_etat0_mod