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

       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
       integer start(2),count(2),status
       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) :: startj,endj
!JE20140526>>
!$OMP MASTER
       IF (is_mpi_root .AND. is_omp_root) THEN

       print*,'Lecture du fichier donnees_lisa.nc' 
       ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode)

!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'
       status = nf90_inq_varid(ncid, aux4s, rcode)
!       print *,'stat,i',status,i,outcycle,aux4s
!       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .false.
       IF ((.not.(status.NE. nf90_noerr) ).and.( .not. outcycle )) THEN
         outcycle=.true.
         latstr=aux4s
       ENDIF
      enddo ! check if it inversed lat
      startj(1)=1
!      endj(1)=jjp1
      endj(1)=nbp_lat
      varid=nf90_inq_varid(ncid,latstr,rcode)

          status = nf90_get_var(ncid, varid, lats_glo, startj, endj)
!      print *,latstr,varid,status,jjp1,rcode
!      IF (status .NE. nf90_noerr) print*,'NOOOOOOO'
!      print *,lats
!stop

! 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
       print*,'lecture variable:',varname
          varid=nf90_inq_varid(ncid,trim(varname),rcode)
!          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
! -----------------------
          status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count)

!      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