source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90 @ 5182

SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec)
  USE dimphy
  USE lmdz_grid_phy
  USE lmdz_phys_para
  USE netcdf, ONLY: nf90_get_var, nf90_open, nf90_inq_varid, nf90_nowrite
USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
  IMPLICIT NONE



  INTEGER :: step, nbjour
  LOGICAL :: debutphy
  REAL :: u10m_ec(klon), v10m_ec(klon)
  REAL :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)

  !  real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72
  !  real v10m_nc(iip1,jjp1)  ! dim 97x73
  REAL :: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
  REAL :: v10m_nc_glo(nbp_lon + 1, nbp_lat)  ! dim 97x73
  INTEGER :: rcode
  INTEGER :: ncidu1, varidu1, ncidv1, varidv1
  save ncidu1, varidu1, ncidv1, varidv1
  !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
  INTEGER :: start(4), count(4), status
  INTEGER :: i, j, ig

  !$OMP MASTER
  IF (is_mpi_root .AND. is_omp_root) THEN
    IF (debutphy) THEN
      ncidu1 = nf90_open('u10m.nc', nf90_nowrite, rcode)
      varidu1 = nf90_inq_varid(ncidu1, 'U10M', rcode)
      ncidv1 = nf90_open('v10m.nc', nf90_nowrite, rcode)
      varidv1 = nf90_inq_varid(ncidv1, 'V10M', rcode)

    endif

    start(1) = 1
    start(2) = 1
    start(4) = 0

    ! count(1)=iip1
    count(1) = nbp_lon + 1
    ! count(2)=jjp1
    count(2) = nbp_lat
    count(3) = 1
    count(4) = 0

    start(3) = step

    status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count)

    status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count)


    ! PRINT *,'beforebidcor u10m_nc', u10m_nc(1,jjp1)
    ! PRINT *,'beforebidcor v10m_nc', v10m_nc(1,jjp1)

    !  PRINT *,status
    ! CALL correctbid(iim,jjp1,u10m_nc)
    ! CALL correctbid(iim,jjp1,v10m_nc)
    CALL correctbid(nbp_lon, nbp_lat, u10m_nc_glo)
    CALL correctbid(nbp_lon, nbp_lat, v10m_nc_glo)

    ! PRINT *,'afterbidcor u10m_nc', u10m_nc(1,jjp1)
    ! PRINT *,'afterbidcor v10m_nc', v10m_nc(1,jjp1)

    !--upside down + physical grid

    !  u10m_ec(1)=u10m_nc(1,jjp1)
    !  v10m_ec(1)=v10m_nc(1,jjp1)
    u10m_ec_glo(1) = u10m_nc_glo(1, nbp_lat)
    v10m_ec_glo(1) = v10m_nc_glo(1, nbp_lat)
    ig = 2
    ! DO j=2,jjm
    !    DO i = 1, iim
    DO j = 2, nbp_lat - 1
      DO i = 1, nbp_lon
        ! u10m_ec(ig)=u10m_nc(i,jjp1+1-j)
        ! v10m_ec(ig)=v10m_nc(i,jjp1+1-j)
        u10m_ec_glo(ig) = u10m_nc_glo(i, nbp_lat + 1 - j)
        v10m_ec_glo(ig) = v10m_nc_glo(i, nbp_lat + 1 - j)
        ig = ig + 1
        ! PRINT *,u10m_ec(ig) ,v10m_ec(ig)
      ENDDO
    ENDDO
    u10m_ec_glo(ig) = u10m_nc_glo(1, 1)
    v10m_ec_glo(ig) = v10m_nc_glo(1, 1)


    ! end if master
  ENDIF
  !$OMP END MASTER
  !$OMP BARRIER
  CALL scatter(u10m_ec_glo, u10m_ec)
  CALL scatter(v10m_ec_glo, v10m_ec)

  ! PRINT *,'JE  tamagno viento ig= ', ig
  ! PRINT *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec),
  ! .                                      MAXVAL(u10m_ec)
  !  PRINT *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec),
  ! .                                      MAXVAL(v10m_ec)
  !   PRINT *,'u v 1 ', u10m_ec(1),v10m_ec(1)
  !   PRINT *,'u v klon ', u10m_ec(klon),v10m_ec(klon)

END SUBROUTINE read_vent

! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
SUBROUTINE correctbid(iim, nl, x)
  INTEGER :: iim, nl
  REAL :: x(iim + 1, nl)
  INTEGER :: i, l
  REAL :: zz

  DO l = 1, nl
    DO i = 2, iim - 1
      IF(abs(x(i, l))>1.e10) THEN
        zz = 0.5 * (x(i - 1, l) + x(i + 1, l))
        ! PRINT*,'correction ',i,l,x(i,l),zz
        x(i, l) = zz
      endif
    enddo
  enddo


END SUBROUTINE  correctbid