! ! $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 use netcdf, only: nf90_def_var, nf90_int, nf90_float, nf90_put_var 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 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',IOR(NF_CLOBBER,NF_64BIT_OFFSET),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=NF90_DEF_VAR(ncid_out,'lonu',NF90_FLOAT,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=NF90_DEF_VAR(ncid_out,'lonv',NF90_FLOAT,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=NF90_DEF_VAR(ncid_out,'latu',NF90_FLOAT,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=NF90_DEF_VAR(ncid_out,'latv',NF90_FLOAT,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=NF90_DEF_VAR(ncid_out,'grille_u',NF90_FLOAT,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=NF90_DEF_VAR(ncid_out,'grille_v',NF90_FLOAT,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=NF90_DEF_VAR(ncid_out,'grille_s',NF90_FLOAT,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 status=NF90_PUT_VAR(ncid_out,out_lonuid,rlonudeg,[1],[iim+1]) CALL handle_err(status) status=NF90_PUT_VAR(ncid_out,out_lonvid,rlonvdeg,[1],[iim+1]) CALL handle_err(status) status=NF90_PUT_VAR(ncid_out,out_latuid,rlatudeg,[1],[jjm+1]) CALL handle_err(status) status=NF90_PUT_VAR(ncid_out,out_latvid,rlatvdeg,[1],[jjm]) CALL handle_err(status) 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 status=NF90_PUT_VAR(ncid_out,out_varid,temp,start, count) CALL handle_err(status) ! 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=NF90_DEF_VAR(ncid_out,'presnivs',NF90_FLOAT,out_levdim,& presnivs_id) CALL handle_err(status) ! fields out_dim(1)=out_lonvdim out_dim(2)=out_latudim status = nf90_def_var(ncid_out,'phis',NF90_FLOAT,out_dim,phis_id) CALL handle_err(status) status = nf90_def_var(ncid_out,'aire',NF90_FLOAT,out_dim,area_id) CALL handle_err(status) status = nf90_def_var(ncid_out,'mask',NF90_INT,out_dim,mask_id) CALL handle_err(status) status=NF_ENDDEF(ncid_out) CALL handle_err(status) ! ecriture des variables status=NF90_PUT_VAR(ncid_out,presnivs_id,rlevdeg,[1],[llm]) CALL handle_err(status) 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 = nf90_put_var(ncid_out, phis_id, phis_loc,start,count) CALL handle_err(status) status = nf90_put_var(ncid_out, area_id, aire,start,count) CALL handle_err(status) masque_int(:,:) = nINT(masque(:,:)) status = nf90_put_var(ncid_out, mask_id,masque_int,start,count) 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