! ! $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) USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi USE comvert_mod, ONLY: presnivs, preff, pa IMPLICIT NONE INCLUDE "dimensions.h" INCLUDE "paramet.h" INCLUDE "comgeom.h" INCLUDE "netcdf.inc" 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