[198] | 1 | c $Header |
---|
| 2 | PROGRAM create_fausse_var |
---|
| 3 | C |
---|
| 4 | IMPLICIT NONE |
---|
| 5 | C |
---|
| 6 | C |
---|
| 7 | #include "dimensions.h" |
---|
| 8 | #include "paramet.h" |
---|
| 9 | #include "comconst.h" |
---|
| 10 | #include "comgeom.h" |
---|
| 11 | #include "netcdf.inc" |
---|
| 12 | |
---|
| 13 | c Attributs netcdf sortie |
---|
| 14 | character*64 fich_out |
---|
| 15 | integer*4 ncid_out,rcode_out |
---|
| 16 | integer*4 out_lonuid,out_lonvid,out_latuid,out_latvid |
---|
| 17 | integer*4 out_varid |
---|
| 18 | integer*4 out_lonudim,out_lonvdim |
---|
| 19 | integer*4 out_latudim,out_latvdim,out_dim(3) |
---|
| 20 | |
---|
| 21 | c champs a faire disparaitre |
---|
| 22 | real ucov(ijp1llm),vcov(ijmllm),teta(ijp1llm) |
---|
| 23 | real masse(ijp1llm),ps(ip1jmp1),phis(ip1jmp1) |
---|
| 24 | real q(ijp1llm*nqmx) |
---|
| 25 | real time_0 |
---|
| 26 | |
---|
| 27 | real clesphy0(20),pa,preff |
---|
| 28 | |
---|
| 29 | integer status,i,j |
---|
| 30 | real rlatudeg(jjp1),rlatvdeg(jjm) |
---|
| 31 | real rlonudeg(iip1),rlonvdeg(iip1) |
---|
| 32 | |
---|
| 33 | |
---|
| 34 | rad = 6400000 |
---|
| 35 | omeg = 7.272205e-05 |
---|
| 36 | g = 9.8 |
---|
| 37 | kappa = 0.285716 |
---|
| 38 | daysec = 86400 |
---|
| 39 | cpp = 1004.70885 |
---|
| 40 | |
---|
| 41 | preff = 101325. |
---|
| 42 | pa= 50000. |
---|
| 43 | |
---|
| 44 | c CALL dynetat0("start.nc",nqmx,vcov,ucov, |
---|
| 45 | c . teta,q,masse,ps,phis, time_0) |
---|
| 46 | |
---|
| 47 | |
---|
| 48 | open(99,file='run.def',status='old',form='formatted') |
---|
| 49 | CALL defrun_new( 99, .TRUE. ,clesphy0) |
---|
| 50 | close(99) |
---|
| 51 | CALL iniconst |
---|
| 52 | print*,'inigeom pas OK' |
---|
| 53 | CALL inigeom |
---|
| 54 | print*,'inigeom OK' |
---|
| 55 | |
---|
| 56 | do j=1,jjp1 |
---|
| 57 | rlatudeg(j)=rlatu(j)*180./pi |
---|
| 58 | enddo |
---|
| 59 | do j=1,jjm |
---|
| 60 | rlatvdeg(j)=rlatv(j)*180./pi |
---|
| 61 | enddo |
---|
| 62 | |
---|
| 63 | do i=1,iip1 |
---|
| 64 | rlonudeg(i)=rlonu(i)*180./pi |
---|
| 65 | rlonvdeg(i)=rlonv(i)*180./pi |
---|
| 66 | enddo |
---|
| 67 | |
---|
| 68 | print*,' 2 ----- OUVERTURE DE LA SORTIE NETCDF' |
---|
| 69 | c --------------------------------------------------- |
---|
| 70 | c CREATION OUTPUT |
---|
| 71 | c ouverture fichier netcdf de sortie out |
---|
| 72 | fich_out='grilles_gcm.nc' |
---|
| 73 | |
---|
| 74 | status=NF_CREATE(fich_out,NF_NOCLOBBER,ncid_out) |
---|
| 75 | status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim) |
---|
| 76 | status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim) |
---|
| 77 | status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim) |
---|
| 78 | status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim) |
---|
| 79 | |
---|
| 80 | c Longitudes en u |
---|
| 81 | print *,'OUTID: ',ncid_out |
---|
| 82 | status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, |
---|
| 83 | % out_lonuid) |
---|
| 84 | call handle_err(status) |
---|
| 85 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', |
---|
| 86 | % 12,'degrees_east') |
---|
| 87 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name', |
---|
| 88 | % 9,'Longitude en u') |
---|
| 89 | |
---|
| 90 | c Longitudes en v |
---|
| 91 | print *,'OUTID: ',ncid_out |
---|
| 92 | status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, |
---|
| 93 | % out_lonvid) |
---|
| 94 | call handle_err(status) |
---|
| 95 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', |
---|
| 96 | % 12,'degrees_east') |
---|
| 97 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', |
---|
| 98 | % 9,'Longitude en v') |
---|
| 99 | |
---|
| 100 | c Latitude en u |
---|
| 101 | status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, |
---|
| 102 | % out_latuid) |
---|
| 103 | call handle_err(status) |
---|
| 104 | status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', |
---|
| 105 | % 13,'degrees_north') |
---|
| 106 | status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', |
---|
| 107 | % 8,'Latitude en u') |
---|
| 108 | |
---|
| 109 | c Latitude en v |
---|
| 110 | status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, |
---|
| 111 | % out_latvid) |
---|
| 112 | call handle_err(status) |
---|
| 113 | status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', |
---|
| 114 | % 13,'degrees_north') |
---|
| 115 | status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', |
---|
| 116 | % 8,'Latitude en v') |
---|
| 117 | |
---|
| 118 | c ecriture de la grille u |
---|
| 119 | out_dim(1)=out_lonudim |
---|
| 120 | out_dim(2)=out_latudim |
---|
| 121 | status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, |
---|
| 122 | % out_varid) |
---|
| 123 | call handle_err(status) |
---|
| 124 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', |
---|
| 125 | % 6,'Kelvin') |
---|
| 126 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', |
---|
| 127 | % 16,'Grille aux point u') |
---|
| 128 | |
---|
| 129 | c ecriture de la grille v |
---|
| 130 | out_dim(1)=out_lonvdim |
---|
| 131 | out_dim(2)=out_latvdim |
---|
| 132 | status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, |
---|
| 133 | % out_varid) |
---|
| 134 | call handle_err(status) |
---|
| 135 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', |
---|
| 136 | % 6,'Kelvin') |
---|
| 137 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', |
---|
| 138 | % 16,'Grille aux point v') |
---|
| 139 | |
---|
| 140 | |
---|
| 141 | status=NF_ENDDEF(ncid_out) |
---|
| 142 | print*,' 5) ----- FERMETURE DES FICHIERS NETCDF-' |
---|
| 143 | c -------------------------------------------------------- |
---|
| 144 | c 3-b- Ecriture de la grille pour la sortie |
---|
| 145 | c rajoute l'ecriture de la grille |
---|
| 146 | |
---|
| 147 | status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg) |
---|
| 148 | status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg) |
---|
| 149 | status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg) |
---|
| 150 | status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg) |
---|
| 151 | |
---|
| 152 | |
---|
| 153 | c fermeture du fichier netcdf |
---|
| 154 | call ncclos(ncid_out,rcode_out) |
---|
| 155 | write(*,*) 'Fermeture: ',fich_out |
---|
| 156 | |
---|
| 157 | end |
---|
| 158 | |
---|
| 159 | |
---|
| 160 | |
---|
| 161 | subroutine handle_err(status) |
---|
| 162 | #include "netcdf.inc" |
---|
| 163 | integer status |
---|
| 164 | print *,'handle code err: ',NF_NOERR |
---|
| 165 | IF (status.NE.nf_noerr) THEN |
---|
| 166 | print *,NF_STRERROR(status) |
---|
| 167 | stop 'stopped' |
---|
| 168 | ENDIF |
---|
| 169 | END |
---|
| 170 | |
---|