source: LMDZ6/trunk/libf/phylmd/Dust/read_vent.f90 @ 5482

SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec)
  USE dimphy
  USE mod_grid_phy_lmdz
  USE mod_phys_lmdz_para
  USE netcdf, ONLY: nf90_get_var, nf90_open, nf90_inq_varid, nf90_nowrite
   ! USE write_field_phy
!!USE paramet_mod_h
IMPLICIT NONE

    ! INCLUDE "dimphy.h"

  !
  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 :: ncidu1, varidu1, ncidv1, varidv1, rcode
  save ncidu1, varidu1, ncidv1, varidv1
!$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
  integer :: start(4),count_(4)
  integer :: i, j, ig


  !
!$OMP MASTER
  IF (is_mpi_root .AND. is_omp_root) THEN
  if (debutphy) then
  !
     rcode=nf90_open('u10m.nc',nf90_nowrite,ncidu1)
     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open u10m.nc dans read_vent',1) ; endif
     rcode=nf90_inq_varid(ncidu1,'U10M',varidu1)
     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id u10m dans read_vent',1) ; endif
     rcode=nf90_open('v10m.nc',nf90_nowrite,ncidv1)
     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open v10m.nc dans read_vent',1) ; endif
     rcode=nf90_inq_varid(ncidv1,'V10M',varidv1)
     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id v10m dans read_vent',1) ; endif
  !
  endif
  !
  start(1)=1
  start(2)=1
  start(3)=step
  start(4)=0

   ! count_(1)=iip1
  count_(1)=nbp_lon+1
   ! count_(2)=jjp1
  count_(2)=nbp_lat
  count_(3)=1
  count_(4)=0
  !
  !
  rcode = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count_)
  if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture u10m dans read_vent',1) ; endif
  rcode = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count_)
  if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture v10m dans read_vent',1) ; endif


! ------- Tests 2024/12/31-FH----------------------------------------
! print*,'nbp_lon,npb_lat ',nbp_lon,nbp_lat
! print*,'start ',start
! print*,'count_ ',count_
! print*,'satus lecture u10m ',rcode
! call dump2d(nbp_lon+1,nbp_lat,u10m_nc_glo,'U10M global read_vent')
! call dump2d(nbp_lon+1,nbp_lat,v10m_nc_glo,'V10M global read_vent')
! stop
! ------- Tests -----------------------------------------------------

  !

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

  !   print *,rcode
  !  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)
  RETURN
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)).gt.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

  return
end subroutine correctbid