source: trunk/LMDZ.MARS/libf/phymars/datareadnc.F @ 342

c=======================================================================
      SUBROUTINE datareadnc(relief,phisinit,alb,ith,z0,
     &                    zmea,zstd,zsig,zgam,zthe)
c=======================================================================
c
c
c   Author: F. Hourdin      01/1997
c   -------
c
c   Object: To read data from Martian surface to use in a GCM
c   ------                from NetCDF file "surface.nc"
c
c
c   Arguments:
c   ----------
c
c     Inputs:
c     ------
c
c     Outputs:
c     --------
c
c=======================================================================
c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
c
c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
c
c   360 valeurs en longitude (de -179.5 a 179.5)
c   180 valeurs en latitudes (de 89.5 a -89.5)
c
c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
c
c   Il faut donc que ces donnees soient au format grille scalaire
c               (imold+1 jmold+1)
c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
c
c   On prend imd (d pour donnees!) 
c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
c                   (rlonud de -179 a -181)
c           jmd = 179 
c                   (rlatvd de 89 a -89)
c=======================================================================

! to use  'getin'
       use ioipsl_getincom 

      implicit none

#include "dimensions.h"
#include "paramet.h"
#include "comgeom.h"
#include "comconst.h"
#include "netcdf.inc"
#include "datafile.h"

c=======================================================================
c   Declarations:
C=======================================================================

      INTEGER    imd,jmd,imdp1,jmdp1
      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)

      INTEGER    iimp1
      parameter    (iimp1=iim+1-1/iim)

! Arguments:
      CHARACTER(len=3),intent(inout) :: relief
      REAL,intent(out) :: phisinit(iimp1*jjp1)
      REAL,intent(out) :: alb(iimp1*jjp1)
      REAL,intent(out) :: ith(iimp1*jjp1)
      REAL,intent(out) :: z0(iimp1*jjp1)
      REAL,intent(out) :: zmea(imdp1*jmdp1)
      REAL,intent(out) :: zstd(imdp1*jmdp1)
      REAL,intent(out) :: zsig(imdp1*jmdp1)
      REAL,intent(out) :: zgam(imdp1*jmdp1)
      REAL,intent(out) :: zthe(imdp1*jmdp1)

! Local variables:
      REAL        zdata(imd*jmdp1)
      REAL        zdataS(imdp1*jmdp1)
      REAL        pfield(iimp1*jjp1)

      INTEGER     ierr

      INTEGER   unit,nvarid

      INTEGER    i,j,k

      INTEGER klatdat,ngridmxgdat
      PARAMETER (klatdat=180,ngridmxgdat=360)

c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)

      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
      REAL rlonud(imdp1),rlatvd(jmd)

      CHARACTER*20 string
      DIMENSION string(0:4)


#include "lmdstd.h"
#include "fxyprim.h"

      pi=2.*ASIN(1.)

c=======================================================================
c    rlonud, rlatvd
c=======================================================================

c-----------------------------------------------------------------------
c    Lecture NetCDF des donnees latitude et longitude
c-----------------------------------------------------------------------
      write(*,*) 'datareadnc: opening file surface.nc'

      datafile="/u/forget/WWW/datagcm/datafile" ! default path to surface.nc
      call getin("datadir",datafile) ! but users may specify another path
      
      ierr = NF_OPEN (trim(datafile)//'/surface.nc',
     &  NF_NOWRITE,unit)
      IF (ierr.NE.NF_NOERR) THEN
        write(*,*)'Error : cannot open file surface.nc '
        write(*,*)'(in phymars/datareadnc.F)'
        write(*,*)'It should be in :',trim(datafile),'/'
        write(*,*)'1) You can set this path in the callphys.def file:'
        write(*,*)'   datadir=/path/to/the/datafiles'
        write(*,*)'2) If necessary, surface.nc (and other datafiles)'
        write(*,*)'   can be obtained online on:'
        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
        CALL ABORT
      ENDIF

c
c Lecture des latitudes (coordonnees):
c
      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
#ifdef NC_DOUBLE
      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
#else
      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
#endif
c
c Lecture des longitudes (coordonnees):
c
      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
#ifdef NC_DOUBLE
      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
#else
      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
#endif

c-----------------------------------------------------------------------
c    Passage au format boites scalaires
c-----------------------------------------------------------------------

c-----------------------------------------------------------------------
c       longitude(imd)        -->      rlonud(imdp1) 
c-----------------------------------------------------------------------

c Passage en coordonnees boites scalaires et en radian
      do i=1,imd 
          rlonud(i)=(longitude(i)+.5)*pi/180.
      enddo

c Repetition de la valeur im+1
      rlonud(imdp1)=rlonud(1) + 2*pi

c-----------------------------------------------------------------------
c        latitude(jmdp1)         -->        rlonvd(jmd)
c-----------------------------------------------------------------------

c Passage en coordonnees boites scalaires et en radian
      do j=1,jmd 
          rlatvd(j)=(latitude(j)-.5)*pi/180.
      enddo

c=======================================================================
c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
c=======================================================================

      string(0) = 'z0'
      string(1) = 'albedo'
      string(2) = 'thermal'
      if (relief.ne.'pla') then
        write(*,*) ' MOLA topography'
        relief = 'MOL'
          string(3) = 'z'//relief
      else
          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
                            ! remise a 0 derriere
      endif
      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
 

      DO k=0,4
          write(*,*) 'string',k,string(k)
          
c-----------------------------------------------------------------------
c    initialisation
c-----------------------------------------------------------------------
      call initial0(iimp1*jjp1,pfield)
      call initial0(imd*jmdp1,zdata)
      call initial0(imdp1*jmdp1,zdataS)

c-----------------------------------------------------------------------
c    Lecture NetCDF  
c-----------------------------------------------------------------------

      ierr = NF_INQ_VARID (unit, string(k), nvarid)
      if (ierr.ne.nf_noerr) then
        write(*,*) 'datareadnc error, cannot find ',trim(string(k))
        write(*,*) ' in file ',trim(datafile),'/surface.nc'
        stop
      endif
#ifdef NC_DOUBLE
      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
#else
      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
#endif
      if (ierr.ne.nf_noerr) then
        write(*,*) 'datareadnc: error failed loading ',trim(string(k))
        stop
      endif

c-----------------------------------------------------------------------
c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
c-----------------------------------------------------------------------
      if (k.eq.4) then

          call multscal(imd*jmdp1,zdata,1000.,zdata)
          call multscal(imd,longitude,pi/180.,longitude)
          call multscal(jmdp1,latitude,pi/180.,latitude)

          call grid_noro1(360, 180, longitude, latitude, zdata,
     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)

          CALL dump2d(iip1,jjp1,zmea,'zmea')
          CALL dump2d(iip1,jjp1,zstd,'zstd')
          CALL dump2d(iip1,jjp1,zsig,'zsig')
          CALL dump2d(iip1,jjp1,zgam,'zgam')
          CALL dump2d(iip1,jjp1,zthe,'zthe')

      endif

c-----------------------------------------------------------------------
c   Passage de zdata en grille (imdp1 jmdp1)
c-----------------------------------------------------------------------
      do j=1,jmdp1
          do i=1,imd
              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
          enddo
          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
      enddo

c-----------------------------------------------------------------------
c    Interpolation
c-----------------------------------------------------------------------
      call interp_horiz(zdataS,pfield,imd,jmd,
     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 

c-----------------------------------------------------------------------
c    Periodicite    
c-----------------------------------------------------------------------

      do j=1,jjp1
         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
      enddo 
 
c-----------------------------------------------------------------------
c    Sauvegarde des champs    
c-----------------------------------------------------------------------

      if (k.eq.0) then                    ! z0
         z0(1:iimp1*jjp1)=pfield(1:iimp1*jjp1)*.01
         ! multiplied by 0.01 to have z0 in m
         CALL dump2d(iimp1,jjp1,z0,'z0 in m')
      elseif (k.eq.1) then                    ! albedo
         do i=1,iimp1*jjp1
              alb(i) = pfield(i)
          enddo
      elseif (k.eq.2) then                ! thermal
         do i=1,iimp1*jjp1
              ith(i) = pfield(i)
          enddo
      elseif (k.eq.3) then                ! relief
        if (relief.eq.'pla') then
              call initial0(iimp1*jjp1,phisinit)
        else
             do i=1,iimp1*jjp1
                  phisinit(i) = pfield(i)
              enddo
        endif
      endif

      ENDDO

c-----------------------------------------------------------------------
c    Traitement Phisinit
c-----------------------------------------------------------------------

      DO i=1,iimp1*jjp1
            phisinit(i)=1000.*phisinit(i)
      ENDDO
      CALL dump2d(iimp1,jjp1,phisinit,'Altitude in m')
      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)

c-----------------------------------------------------------------------
c    FIN
c-----------------------------------------------------------------------

      END