grilles_gcm_netcdf_sub.F90

Go to the documentation of this file.

!
! $Id: $
!
! This subroutine creates the file grilles_gcm.nc containg longitudes and
! latitudes in degrees for grid u and v. This subroutine is called from
! ce0l. This subroutine corresponds to the first 
! part in the program create_fausse_var.
!
SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)

  IMPLICIT NONE

  include "dimensions.h"
  include "paramet.h"
  include "comconst.h"
  include "comgeom.h"
  include "comvert.h"
  include "netcdf.inc"
  include "serre.h"


  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: masque ! masque terre/mer
  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: phis   ! geopotentiel au sol

  REAL temp(iim+1,jjm+1)
  ! Attributs netcdf sortie
  INTEGER ncid_out,rcode_out
  INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid
  INTEGER out_varid
  INTEGER out_lonudim,out_lonvdim
  INTEGER out_latudim,out_latvdim,out_dim(3)
  INTEGER out_levdim

  INTEGER start(4),COUNT(4)

  INTEGER status,i,j
  REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm)
  REAL rlonudeg(iip1),rlonvdeg(iip1)

  REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
  REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
  REAL,DIMENSION(iip1,jjp1)  :: phis_loc
  INTEGER masque_int(iip1,jjp1)
  INTEGER :: phis_id
  INTEGER :: area_id
  INTEGER :: mask_id
  INTEGER :: presnivs_id
  
  rad = 6400000
  omeg = 7.272205e-05
  g = 9.8
  kappa = 0.285716
  daysec = 86400
  cpp = 1004.70885

  preff = 101325.
  pa= 50000.

  CALL conf_gcm( 99, .true. )
  CALL iniconst
  CALL inigeom

  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 + 360.
     rlonvdeg(i)=rlonv(i)*180./pi + 360.
  ENDDO


  !  2 ----- OUVERTURE DE LA SORTIE NETCDF
  ! ---------------------------------------------------
  ! CREATION OUTPUT
  ! ouverture fichier netcdf de sortie out
  status=nf_create('grilles_gcm.nc',nf_clobber,ncid_out)
  CALL handle_err(status)
  status=nf_def_dim(ncid_out,'lonu',iim+1,out_lonudim)
  CALL handle_err(status)
  status=nf_def_dim(ncid_out,'lonv',iim+1,out_lonvdim)
  CALL handle_err(status)
  status=nf_def_dim(ncid_out,'latu',jjm+1,out_latudim)
  CALL handle_err(status)
  status=nf_def_dim(ncid_out,'latv',jjm,out_latvdim)
  CALL handle_err(status)


  !   Longitudes en u
  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')

  !   Longitudes en v
  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')

  !   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')

  !  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')

  !   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')

  !   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')

  !   ecriture de la grille u
  out_dim(1)=out_lonvdim
  out_dim(2)=out_latudim
  status=nf_def_var(ncid_out,'grille_s',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')

  status=nf_enddef(ncid_out)
  write(*,*) "COUCOU 6"
  CALL handle_err(status)
  ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
  ! --------------------------------------------------------
  ! 3-b- Ecriture de la grille pour la sortie
  ! rajoute l'ecriture de la grille

#ifdef NC_DOUBLE
  status=nf_put_vara_double(ncid_out,out_lonuid,1,iim+1,rlonudeg)
  CALL handle_err(status)
  status=nf_put_vara_double(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
  CALL handle_err(status)
  status=nf_put_vara_double(ncid_out,out_latuid,1,jjm+1,rlatudeg)
  CALL handle_err(status)
  status=nf_put_vara_double(ncid_out,out_latvid,1,jjm,rlatvdeg)
  CALL handle_err(status)
#else
  status=nf_put_vara_real(ncid_out,out_lonuid,1,iim+1,rlonudeg)
  CALL handle_err(status)
  status=nf_put_vara_real(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
  CALL handle_err(status)
  status=nf_put_vara_real(ncid_out,out_latuid,1,jjm+1,rlatudeg)
  CALL handle_err(status)
  status=nf_put_vara_real(ncid_out,out_latvid,1,jjm,rlatvdeg)
  CALL handle_err(status)
#endif

  start(1)=1
  start(2)=1
  start(3)=1
  start(4)=1

  count(1)=iim+1
  count(2)=jjm+1
  count(3)=1
  count(4)=1

  DO j=1,jjm+1
     DO i=1,iim+1
        temp(i,j)=mod(i,2)+mod(j,2)
     ENDDO
  ENDDO

#ifdef NC_DOUBLE
  status=nf_put_vara_double(ncid_out,out_varid,start, count,temp)
  CALL handle_err(status)
#else
  status=nf_put_vara_real(ncid_out,out_varid,start, count,temp)
  CALL handle_err(status)
#endif

  ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA
! lev - phis - aire - mask
! rlevdeg(:) = presnivs
  rlevdeg(:) = presnivs(:)
  phis_loc(:,:) = phis(:,:)/g

! niveaux de pression verticaux
  status = nf_redef(ncid_out)
  CALL handle_err(status)
  status=nf_def_dim(ncid_out,'lev',llm,out_levdim)
  CALL handle_err(status)
  status=nf_def_var(ncid_out,'presnivs',nf_float,1,out_levdim,&
                    presnivs_id)
  CALL handle_err(status)
  
! fields
  out_dim(1)=out_lonvdim
  out_dim(2)=out_latudim

  status = nf_def_var(ncid_out,'phis',nf_float,2,out_dim,phis_id)
  CALL handle_err(status)
  status = nf_def_var(ncid_out,'aire',nf_float,2,out_dim,area_id)
  CALL handle_err(status)
  status = nf_def_var(ncid_out,'mask',nf_int  ,2,out_dim,mask_id)
  CALL handle_err(status)

  status=nf_enddef(ncid_out)
  CALL handle_err(status)

  ! ecriture des variables
#ifdef NC_DOUBLE
  status=nf_put_vara_double(ncid_out,presnivs_id,1,llm,rlevdeg)
  CALL handle_err(status)
#else
  status=nf_put_vara_real(ncid_out,out_levid,1,llm,rlevdeg)
  CALL handle_err(status)
#endif

  start(1)=1
  start(2)=1
  start(3)=1
  start(4)=0
  count(1)=iip1
  count(2)=jjp1
  count(3)=1
  count(4)=0

  status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc)
  CALL handle_err(status)
  status = nf_put_vara_double(ncid_out, area_id,start,count, aire)
  CALL handle_err(status)
  masque_int(:,:) = nint(masque(:,:))
  status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int)
  CALL handle_err(status)
  
  ! fermeture du fichier netcdf
  CALL ncclos(ncid_out,rcode_out)

END SUBROUTINE grilles_gcm_netcdf_sub



SUBROUTINE handle_err(status)
  include "netcdf.inc"

  INTEGER status
  IF (status.NE.nf_noerr) THEN
     print *,nf_strerror(status)
     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)
  ENDIF
END SUBROUTINE handle_err