source: LMDZ6/trunk/libf/phylmd/Dust/read_surface.f90 @ 5481

       subroutine read_surface(name,surfa)

     
! common
! ------
       USE ioipsl
!       USE comgeomphy
       USE dimphy
       USE mod_phys_lmdz_para
       USE iophy
       USE netcdf, ONLY: nf90_inq_varid,nf90_noerr,nf90_get_var,nf90_nowrite,nf90_inq_varid,nf90_open
       USE mod_grid_phy_lmdz, ONLY: nbp_lon,  nbp_lat, klon_glo

!!USE paramet_mod_h
IMPLICIT NONE



       character*10 name
       character*10 varname
!
       real tmp_dyn(nbp_lon+1,nbp_lat)
       real tmp_dyn_glo(nbp_lon+1,nbp_lat)
!       real tmp_dyn_glo(nbp_lon,nbp_lat)
       REAL tmp_dyn_invers(nbp_lon+1,nbp_lat)
       real tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
!       real tmp_dyn_invers_glo(nbp_lon,nbp_lat)
       real tmp_fi(klon)
       real tmp_fi_glo(klon_glo)
       real surfa(klon,5)
       real surfa_glo(klon_glo,5)
!
       integer ncid, varid, rcode, varlatid,tmpid
       integer start_(2),count_(2)
       integer i,j,l,ig
       character*1 str1

!JE20140526<<
      character*4 ::  latstr,aux4s
      logical :: outcycle, isinversed
      real, dimension(nbp_lat) :: lats
      real, dimension(nbp_lat) :: lats_glo
      integer, dimension(1) :: start_j,endj
!JE20140526>>
!$OMP MASTER
       IF (is_mpi_root .AND. is_omp_root) THEN

       print*,'Lecture du fichier donnees_lisa.nc' 
       rcode=nf90_open('donnees_lisa.nc',nf90_nowrite,ncid)
       if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open donnees_lisa.nc dans read_vent',1) ; endif


!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa
      outcycle=.false.
      latstr='null'
      isinversed=.false.
      do i=1,5
          if (i==1) aux4s='latu'
          if (i==2) aux4s='LATU'
          if (i==3) aux4s='LatU'
          if (i==4) aux4s='Latu'
          if (i==5) aux4s='latU'
          rcode = nf90_inq_varid(ncid, aux4s, tmpid)
          IF ((rcode==0).and.( .not. outcycle )) THEN
            outcycle=.true.
            varlatid=tmpid
          ENDIF
      enddo ! check if it inversed lat
      start_j(1)=1
      endj(1)=nbp_lat
      rcode = nf90_get_var(ncid, varlatid, lats_glo, start_j, endj)
      if ( .not. outcycle ) then ; call abort_physic('LMDZ','get lat dans read_surface',1) ; endif



! check if netcdf is latitude inversed or not. 
      if (lats_glo(1)<lats_glo(2)) isinversed=.true.
! JE20140526>>


       DO i=1,5
          write(str1,'(i1)') i
          varname=trim(name)//str1
          rcode=nf90_inq_varid(ncid,trim(varname),varid)
          if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//'  dans read_vent',1) ; endif
!          varid=nf90_inq_varid(ncid,varname,rcode)

!  dimensions pour les champs scalaires et le vent zonal
!  -----------------------------------------------------

          start_(1)=1
          start_(2)=1      
          count_(1)=nbp_lon+1
!          count_(1)=iip1
          count_(2)=nbp_lat
!          count_(2)=jjp1

! mise a zero des tableaux 
! ------------------------
          tmp_dyn(:,:)=0.0
          tmp_fi(:)=0.0
! Lecture
! -----------------------
          rcode = nf90_get_var(ncid, varid, tmp_dyn_glo, start_, count_)
          if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//'  dans read_vent',1) ; endif

!      call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn   ')
       DO j=1, nbp_lat
          DO ig=1, nbp_lon+1
             tmp_dyn_invers_glo(ig,j)=tmp_dyn_glo(ig,nbp_lat-j+1)
          ENDDO
       ENDDO

       
           if (isinversed) then
                        call local_gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, &
     & tmp_dyn_invers_glo, tmp_fi_glo)
           else      
                        call local_gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, &
     &   tmp_dyn_glo, tmp_fi_glo)
           endif
!JE20140526>>
!
          DO j=1,klon_glo

                surfa_glo(j,i)=tmp_fi_glo(j)

          ENDDO ! Fin de recopie du tableau
!
       ENDDO ! Fin boucle 1 a 5
       print*,'Passage Grille Dyn -> Phys'


      ENDIF !mpi 
!$OMP END MASTER
!$OMP BARRIER
      call scatter(surfa_glo,surfa)


       return
       end subroutine read_surface

      SUBROUTINE local_gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
      IMPLICIT NONE
!=======================================================================
!   passage d'un champ de la grille scalaire a la grille physique
!=======================================================================

!-----------------------------------------------------------------------
!   declarations:
!   -------------

      INTEGER im,jm,ngrid,nfield
      REAL pdyn(im,jm,nfield)
      REAL pfi(ngrid,nfield)

      INTEGER j,ifield,ig

!-----------------------------------------------------------------------
!   calcul:
!   -------

      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)                          &
     &    STOP 'probleme de dim'
!   traitement des poles
      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)

!   traitement des point normaux
      DO ifield=1,nfield
         DO j=2,jm-1
            ig=2+(j-2)*(im-1)
            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
         ENDDO
      ENDDO

      RETURN
      END SUBROUTINE local_gr_dyn_fi