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 IMPLICIT NONE INCLUDE "dimensions.h" INCLUDE "paramet.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 :: 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