source: LMDZ.3.3/trunk/libf/dyn3d/grilles_gcm_netcdf.F @ 198

c $Header
      PROGRAM create_fausse_var
C
      IMPLICIT NONE
C
C
#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comgeom.h"
#include "netcdf.inc"

c Attributs netcdf sortie
        character*64 fich_out
        integer*4 ncid_out,rcode_out
        integer*4 out_lonuid,out_lonvid,out_latuid,out_latvid
        integer*4 out_varid
        integer*4 out_lonudim,out_lonvdim
        integer*4 out_latudim,out_latvdim,out_dim(3)

c   champs a faire disparaitre
        real ucov(ijp1llm),vcov(ijmllm),teta(ijp1llm)
        real masse(ijp1llm),ps(ip1jmp1),phis(ip1jmp1)
        real q(ijp1llm*nqmx)
        real time_0

        real clesphy0(20),pa,preff

        integer status,i,j
        real rlatudeg(jjp1),rlatvdeg(jjm)
        real rlonudeg(iip1),rlonvdeg(iip1)


      rad = 6400000
      omeg = 7.272205e-05
      g = 9.8
      kappa = 0.285716
      daysec = 86400
      cpp = 1004.70885

      preff = 101325.
      pa= 50000.

c     CALL dynetat0("start.nc",nqmx,vcov,ucov,
c    .              teta,q,masse,ps,phis, time_0)


      open(99,file='run.def',status='old',form='formatted')
      CALL defrun_new( 99, .TRUE. ,clesphy0)
      close(99)
      CALL iniconst
      print*,'inigeom pas OK'
      CALL inigeom
      print*,'inigeom OK'

      do j=1,jjp1
         rlatudeg(j)=rlatu(j)*180./pi
      enddo
      do j=1,jjm
         rlatvdeg(j)=rlatv(j)*180./pi
      enddo

      do i=1,iip1
         rlonudeg(i)=rlonu(i)*180./pi
         rlonvdeg(i)=rlonv(i)*180./pi
      enddo

      print*,'  2 ----- OUVERTURE DE LA SORTIE NETCDF'
c ---------------------------------------------------
c CREATION OUTPUT
c ouverture fichier netcdf de sortie out
        fich_out='grilles_gcm.nc'

        status=NF_CREATE(fich_out,NF_NOCLOBBER,ncid_out)
        status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
        status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
        status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
        status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)

c   Longitudes en u
        print *,'OUTID: ',ncid_out
        status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim,
     %  out_lonuid)
        call handle_err(status)
        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units',
     %  12,'degrees_east')
        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',
     %  9,'Longitude en u')

c   Longitudes en v
        print *,'OUTID: ',ncid_out
        status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim,
     %  out_lonvid)
        call handle_err(status)
        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units',
     %  12,'degrees_east')
        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name',
     %  9,'Longitude en v')

c   Latitude en u
        status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim,
     %  out_latuid)
        call handle_err(status)
        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units',
     %  13,'degrees_north')
        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name',
     %  8,'Latitude en u')

c  Latitude en v
        status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim,
     %  out_latvid)
        call handle_err(status)
        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units',
     %  13,'degrees_north')
        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name',
     %  8,'Latitude en v')

c   ecriture de la grille u
        out_dim(1)=out_lonudim
        out_dim(2)=out_latudim
        status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim,
     %  out_varid)
        call handle_err(status)
        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
     %  6,'Kelvin')
        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
     %  16,'Grille aux point u')

c   ecriture de la grille v
        out_dim(1)=out_lonvdim
        out_dim(2)=out_latvdim
        status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim,
     %  out_varid)
        call handle_err(status)
        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
     %  6,'Kelvin')
        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
     %  16,'Grille aux point v')


        status=NF_ENDDEF(ncid_out)
        print*,' 5) ----- FERMETURE DES FICHIERS NETCDF-'
c --------------------------------------------------------
c 3-b- Ecriture de la grille pour la sortie
c rajoute l'ecriture de la grille

        status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
        status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
        status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
        status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)


c fermeture du fichier netcdf
        call ncclos(ncid_out,rcode_out)
        write(*,*) 'Fermeture: ',fich_out

        end



        subroutine handle_err(status)
#include "netcdf.inc"
        integer status
        print *,'handle code err: ',NF_NOERR
        IF (status.NE.nf_noerr) THEN
                print *,NF_STRERROR(status)
                stop 'stopped'
        ENDIF
        END