| [207] | 1 | c $Header$ |
|---|
| [198] | 2 | subroutine read_fstoke(irec, |
|---|
| 3 | . zrec,zim,zjm,zlm,rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy, |
|---|
| 4 | . airedy,phis, |
|---|
| 5 | . masse,pbaru,pbarv,w,teta,phi) |
|---|
| 6 | |
|---|
| 7 | IMPLICIT NONE |
|---|
| 8 | |
|---|
| 9 | #include "netcdf.inc" |
|---|
| 10 | #include "dimensions.h" |
|---|
| 11 | #include "paramet.h" |
|---|
| 12 | #include "comgeom.h" |
|---|
| 13 | #include "comvert.h" |
|---|
| 14 | |
|---|
| 15 | integer nlevnc,irec |
|---|
| 16 | parameter (nlevnc=19) |
|---|
| 17 | integer mode,l |
|---|
| 18 | |
|---|
| 19 | integer imo,jmo,imo1,jmo1,imn,jmn |
|---|
| 20 | parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2) |
|---|
| 21 | parameter (imo1=imo+1,jmo1=jmo+1) |
|---|
| 22 | |
|---|
| 23 | real*4 pbaru(imo1,jmo1,llm),pbarv(imo1,jmo,llm) |
|---|
| 24 | real*4 teta(imo1,jmo1,llm),phis(imo1,jmo1),phi(imo1,jmo1,llm) |
|---|
| 25 | real*4 masse(imo1,jmo1,llm),w(imo1,jmo1,llm) |
|---|
| 26 | real*4 airedy(imo1,jmo1) |
|---|
| 27 | real*4 rlonu_dy(imo1,jmo1),rlonv_dy(imo1,jmo), |
|---|
| 28 | . rlatu_dy(imo1,jmo1),rlatv_dy(imo1,jmo) |
|---|
| 29 | integer*4 ncrec,ncim,ncjm,nclm |
|---|
| [218] | 30 | integer*4 zrec,zim,zjm,zlm |
|---|
| [198] | 31 | integer*4 xid,yid,zid,tid |
|---|
| 32 | real*4 zdtvr,ziadvtrac |
|---|
| 33 | real adv(1), dtv(1) |
|---|
| 34 | |
|---|
| 35 | integer ncidf,ncidfv |
|---|
| 36 | integer varidpu,varidpv,varidt,varidw,varidps,varidph,varidai |
|---|
| 37 | integer varidpl,varidm |
|---|
| 38 | integer varidnlo,varidnla,varidnlov,varidnlav |
|---|
| 39 | save ncidf,ncidfv |
|---|
| 40 | save varidpu,varidpv,varidt,varidw,varidps,varidph,varidai |
|---|
| 41 | save varidpl,varidm |
|---|
| 42 | save varidnlo,varidnla,varidnlov,varidnlav |
|---|
| 43 | |
|---|
| 44 | real*4 pl(nlevnc) |
|---|
| 45 | |
|---|
| 46 | integer start(4),count(4),status |
|---|
| 47 | |
|---|
| 48 | real rcode |
|---|
| 49 | |
|---|
| 50 | character namedim |
|---|
| 51 | |
|---|
| 52 | c --------------------------------------------- |
|---|
| 53 | c Initialisation de la lecture des fichiers |
|---|
| 54 | c --------------------------------------------- |
|---|
| 55 | |
|---|
| 56 | if (irec .eq. 0) then |
|---|
| 57 | |
|---|
| 58 | ncidf=NCOPN('fluxstoke.nc',NCNOWRIT,rcode) |
|---|
| 59 | |
|---|
| 60 | varidps=NCVID(ncidf,'phis',rcode) |
|---|
| 61 | print*,'ncidf,varidps',ncidf,varidps |
|---|
| 62 | |
|---|
| 63 | varidpl=NCVID(ncidf,'sig_s',rcode) |
|---|
| 64 | print*,'ncidf,varidpl',ncidf,varidpl |
|---|
| 65 | |
|---|
| 66 | varidnlo=NCVID(ncidf,'nav_lon',rcode) |
|---|
| 67 | print*,'ncidf,varidnlo',ncidf,varidnlo |
|---|
| 68 | |
|---|
| 69 | varidnla=NCVID(ncidf,'nav_lat',rcode) |
|---|
| 70 | print*,'ncidf,varidnla',ncidf,varidnla |
|---|
| 71 | |
|---|
| 72 | varidai=NCVID(ncidf,'aire',rcode) |
|---|
| 73 | print*,'ncidf,varidai',ncidf,varidai |
|---|
| 74 | |
|---|
| 75 | varidm=NCVID(ncidf,'masse',rcode) |
|---|
| 76 | print*,'ncidf,varidm',ncidf,varidm |
|---|
| 77 | |
|---|
| 78 | varidpu=NCVID(ncidf,'pbaru',rcode) |
|---|
| 79 | print*,'ncidf,varidpu',ncidf,varidpu |
|---|
| 80 | |
|---|
| 81 | varidw=NCVID(ncidf,'w',rcode) |
|---|
| 82 | print*,'ncidf,varidw',ncidf,varidw |
|---|
| 83 | |
|---|
| 84 | varidt=NCVID(ncidf,'teta',rcode) |
|---|
| 85 | print*,'ncidf,varidt',ncidf,varidt |
|---|
| 86 | |
|---|
| 87 | varidph=NCVID(ncidf,'phi',rcode) |
|---|
| 88 | print*,'ncidf,varidph',ncidf,varidph |
|---|
| 89 | |
|---|
| 90 | ncidfv=NCOPN('fluxstokev.nc',NCNOWRIT,rcode) |
|---|
| 91 | |
|---|
| 92 | varidpv=NCVID(ncidfv,'pbarv',rcode) |
|---|
| 93 | print*,'ncidfv,varidpv',ncidfv,varidpv |
|---|
| 94 | |
|---|
| 95 | varidnlov=NCVID(ncidfv,'nav_lon',rcode) |
|---|
| 96 | print*,'ncidf,varidnlov',ncidf,varidnlov |
|---|
| 97 | |
|---|
| 98 | varidnlav=NCVID(ncidfv,'nav_lat',rcode) |
|---|
| 99 | print*,'ncidfv,varidnlav',ncidfv,varidnlav |
|---|
| 100 | |
|---|
| 101 | |
|---|
| 102 | c ID pour les dimensions |
|---|
| 103 | |
|---|
| 104 | status = nf_inq_dimid(ncidf,'y',yid) |
|---|
| 105 | status = nf_inq_dimid(ncidf,'x',xid) |
|---|
| 106 | status = nf_inq_dimid(ncidf,'sig_s',zid) |
|---|
| 107 | status = nf_inq_dimid(ncidf,'time_counter',tid) |
|---|
| 108 | |
|---|
| 109 | c lecture des dimensions |
|---|
| 110 | |
|---|
| 111 | status = nf_inq_dim(ncidf,yid,namedim,ncjm) |
|---|
| 112 | status = nf_inq_dim(ncidf,xid,namedim,ncim) |
|---|
| 113 | status = nf_inq_dim(ncidf,zid,namedim,nclm) |
|---|
| 114 | status = nf_inq_dim(ncidf,tid,namedim,ncrec) |
|---|
| 115 | |
|---|
| 116 | zjm=ncjm |
|---|
| 117 | zim=ncim |
|---|
| 118 | zlm=nclm |
|---|
| 119 | zrec=ncrec |
|---|
| 120 | |
|---|
| 121 | write(*,*) 'read_fstoke : zrec = ', zrec |
|---|
| 122 | write(*,*) 'read_fstoke : zlm = ', zlm |
|---|
| 123 | write(*,*) 'read_fstoke : zim = ', zim |
|---|
| 124 | write(*,*) 'read_fstoke : zjm = ', zjm |
|---|
| 125 | |
|---|
| 126 | c niveaux de pression |
|---|
| 127 | |
|---|
| [218] | 128 | #ifdef NC_DOUBLE |
|---|
| 129 | status=NF_GET_VARA_DOUBLE(ncidf,varidpl,1,zlm,pl) |
|---|
| 130 | #else |
|---|
| [198] | 131 | status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl) |
|---|
| [218] | 132 | #endif |
|---|
| [198] | 133 | |
|---|
| 134 | c rlonu,rlonv,rlatu,rlatv |
|---|
| 135 | |
|---|
| 136 | start(1)=1 |
|---|
| 137 | start(2)=1 |
|---|
| 138 | start(3)=1 |
|---|
| 139 | start(4)=0 |
|---|
| 140 | |
|---|
| 141 | count(1)=zim |
|---|
| 142 | count(2)=zjm |
|---|
| 143 | count(3)=1 |
|---|
| 144 | count(4)=0 |
|---|
| 145 | |
|---|
| [218] | 146 | #ifdef NC_DOUBLE |
|---|
| 147 | status=NF_GET_VARA_DOUBLE(ncidf,varidnlo,start,count,rlonu_dy) |
|---|
| 148 | status=NF_GET_VARA_DOUBLE(ncidf,varidnla,start,count,rlatu_dy) |
|---|
| 149 | #else |
|---|
| 150 | status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy) |
|---|
| 151 | status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy) |
|---|
| 152 | #endif |
|---|
| [198] | 153 | |
|---|
| 154 | start(1)=1 |
|---|
| 155 | start(2)=1 |
|---|
| 156 | start(3)=1 |
|---|
| 157 | start(4)=0 |
|---|
| 158 | |
|---|
| 159 | count(1)=zim |
|---|
| 160 | count(2)=zjm-1 |
|---|
| 161 | count(3)=1 |
|---|
| 162 | count(4)=0 |
|---|
| 163 | |
|---|
| [218] | 164 | #ifdef NC_DOUBLE |
|---|
| 165 | status=NF_GET_VARA_DOUBLE(ncidfv,varidnlov,start,count,rlonv_dy) |
|---|
| 166 | status=NF_GET_VARA_DOUBLE(ncidfv,varidnlav,start,count,rlatv_dy) |
|---|
| 167 | #else |
|---|
| 168 | status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy) |
|---|
| 169 | status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy) |
|---|
| 170 | #endif |
|---|
| [198] | 171 | |
|---|
| 172 | c Lecture de phis et aire |
|---|
| 173 | |
|---|
| 174 | start(1)=1 |
|---|
| 175 | start(2)=1 |
|---|
| 176 | start(3)=1 |
|---|
| 177 | start(4)=0 |
|---|
| 178 | |
|---|
| 179 | count(1)=zim |
|---|
| 180 | count(2)=zjm |
|---|
| 181 | count(3)=1 |
|---|
| 182 | count(4)=0 |
|---|
| 183 | |
|---|
| 184 | c phis |
|---|
| [218] | 185 | #ifdef NC_DOUBLE |
|---|
| 186 | status=NF_GET_VARA_DOUBLE(ncidf,varidps,start,count,phis) |
|---|
| 187 | #else |
|---|
| [198] | 188 | status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis) |
|---|
| [218] | 189 | #endif |
|---|
| [198] | 190 | |
|---|
| 191 | c aire |
|---|
| [218] | 192 | #ifdef NC_DOUBLE |
|---|
| 193 | status=NF_GET_VARA_DOUBLE(ncidf,varidai,start,count,airedy) |
|---|
| 194 | #else |
|---|
| [198] | 195 | status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy) |
|---|
| [218] | 196 | #endif |
|---|
| [198] | 197 | |
|---|
| 198 | else |
|---|
| 199 | |
|---|
| 200 | print*,'ok1' |
|---|
| 201 | |
|---|
| 202 | c --------------------- |
|---|
| 203 | c lecture des champs |
|---|
| 204 | c --------------------- |
|---|
| 205 | |
|---|
| 206 | print*,'WARNING!!! Il n y a pas de test de coherence' |
|---|
| 207 | print*,'sur le nombre de niveaux verticaux dans le fichier nc' |
|---|
| 208 | |
|---|
| 209 | start(1)=1 |
|---|
| 210 | start(2)=1 |
|---|
| 211 | start(3)=1 |
|---|
| 212 | start(4)=irec |
|---|
| 213 | |
|---|
| 214 | count(1)=zim |
|---|
| 215 | count(2)=zjm |
|---|
| 216 | count(3)=zlm |
|---|
| 217 | count(4)=1 |
|---|
| 218 | |
|---|
| 219 | c masse |
|---|
| [218] | 220 | #ifdef NC_DOUBLE |
|---|
| 221 | status=NF_GET_VARA_DOUBLE(ncidf,varidm,start,count,masse) |
|---|
| 222 | #else |
|---|
| [198] | 223 | status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse) |
|---|
| [218] | 224 | #endif |
|---|
| [198] | 225 | c print*,'WARNING!!! Correction bidon pour palier a un ' |
|---|
| 226 | c print*,'probleme dans la creation des fichiers nc' |
|---|
| 227 | c call correctbid(iim,jmo1*nlevnc,masse) |
|---|
| 228 | print*,'***********Lecture MASSE ' |
|---|
| 229 | call dump2d(imo1,jmo1,masse,'MASSE COUCHE 1') |
|---|
| 230 | c pbaru |
|---|
| [218] | 231 | #ifdef NC_DOUBLE |
|---|
| 232 | status=NF_GET_VARA_DOUBLE(ncidf,varidpu,start,count,pbaru) |
|---|
| 233 | #else |
|---|
| [198] | 234 | status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru) |
|---|
| [218] | 235 | #endif |
|---|
| [198] | 236 | c print*,'WARNING!!! Correction bidon pour palier a un ' |
|---|
| 237 | c print*,'probleme dans la creation des fichiers nc' |
|---|
| 238 | c call correctbid(iim,jmo1*nlevnc,pbaru) |
|---|
| 239 | c call dump2d(imo1,jmo1,pbaru,'PBARUNC COUCHE 1') |
|---|
| 240 | |
|---|
| 241 | c w |
|---|
| [218] | 242 | #ifdef NC_DOUBLE |
|---|
| 243 | status=NF_GET_VARA_DOUBLE(ncidf,varidw,start,count,w) |
|---|
| 244 | #else |
|---|
| [198] | 245 | status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w) |
|---|
| [218] | 246 | #endif |
|---|
| [198] | 247 | c print*,'WARNING!!! Correction bidon pour palier a un ' |
|---|
| 248 | c print*,'probleme dans la creation des fichiers nc' |
|---|
| 249 | c call correctbid(iim,jmo1*nlevnc,w) |
|---|
| 250 | c call dump2d(imo1,jmo1,w,'WNC COUCHE 1') |
|---|
| 251 | |
|---|
| 252 | c teta |
|---|
| [218] | 253 | #ifdef NC_DOUBLE |
|---|
| 254 | status=NF_GET_VARA_DOUBLE(ncidf,varidt,start,count,teta) |
|---|
| 255 | #else |
|---|
| [198] | 256 | status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta) |
|---|
| [218] | 257 | #endif |
|---|
| [198] | 258 | c print*,'WARNING!!! Correction bidon pour palier a un ' |
|---|
| 259 | c print*,'probleme dans la creation des fichiers nc' |
|---|
| 260 | c call correctbid(iim,jmo1*nlevnc,teta) |
|---|
| 261 | c call dump2d(imo1,jmo1,teta,'TETANC COUCHE 1') |
|---|
| 262 | |
|---|
| 263 | c phi |
|---|
| [218] | 264 | #ifdef NC_DOUBLE |
|---|
| 265 | status=NF_GET_VARA_DOUBLE(ncidf,varidph,start,count,phi) |
|---|
| 266 | #else |
|---|
| [198] | 267 | status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi) |
|---|
| [218] | 268 | #endif |
|---|
| [198] | 269 | c print*,'WARNING!!! Correction bidon pour palier a un ' |
|---|
| 270 | c print*,'probleme dans la creation des fichiers nc' |
|---|
| 271 | c call correctbid(iim,jmo1*nlevnc,phi) |
|---|
| 272 | c call dump2d(imo1,jmo1,phi,'PHINC COUCHE 1') |
|---|
| 273 | |
|---|
| 274 | count(2) = zjm-1 |
|---|
| 275 | |
|---|
| 276 | c pbarv |
|---|
| 277 | print*,'Lecture de pbarv irec=',irec |
|---|
| [218] | 278 | #ifdef NC_DOUBLE |
|---|
| 279 | status=NF_GET_VARA_DOUBLE(ncidfv,varidpv,start,count,pbarv) |
|---|
| 280 | #else |
|---|
| [198] | 281 | status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv) |
|---|
| [218] | 282 | #endif |
|---|
| [198] | 283 | c call correctbid(iim,jjm*nlevnc,pbarv) |
|---|
| 284 | PRINT*,'*******LECTURE DE PBARV******' |
|---|
| 285 | call dump2d(imo1,jjm,pbarv,'PBARVNC COUCHE 1') |
|---|
| 286 | print*,'Ok Lecture de pbarv irec=',irec |
|---|
| 287 | start(3)=irec |
|---|
| 288 | start(4)=0 |
|---|
| 289 | count(2)=jmo1 |
|---|
| 290 | count(3)=1 |
|---|
| 291 | count(4)=0 |
|---|
| 292 | |
|---|
| 293 | endif |
|---|
| 294 | print*,'Fin read_fstoke a irec=',irec |
|---|
| 295 | return |
|---|
| 296 | end |
|---|
| 297 | |
|---|
