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