[2] | 1 | PROGRAM create_limit |
---|
| 2 | IMPLICIT none |
---|
| 3 | c |
---|
| 4 | c------------------------------------------------------------- |
---|
| 5 | C Author : L. Fairhead |
---|
| 6 | C Date : 27/01/94 |
---|
| 7 | C Objet : Construction des fichiers de conditions aux limites |
---|
| 8 | C pour le nouveau |
---|
| 9 | C modele a partir de fichiers de climatologie. Les deux |
---|
| 10 | C grilles doivent etre regulieres |
---|
| 11 | c |
---|
| 12 | c Modifie par z.x.li (le23mars1994) |
---|
| 13 | c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999 |
---|
| 14 | c pour lecture netcdf dans LMDZ.3.3 |
---|
| 15 | c------------------------------------------------------------- |
---|
| 16 | c |
---|
| 17 | #include "dimensions.h" |
---|
| 18 | #include "paramet.h" |
---|
| 19 | #include "control.h" |
---|
| 20 | #include "logic.h" |
---|
| 21 | #include "netcdf.inc" |
---|
| 22 | #include "comvert.h" |
---|
| 23 | #include "comgeom2.h" |
---|
| 24 | #include "comconst.h" |
---|
| 25 | c |
---|
| 26 | c----------------------------------------------------------------------- |
---|
| 27 | INTEGER KIDIA, KFDIA, KLON, KLEV |
---|
| 28 | PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2, |
---|
| 29 | . KLON=KFDIA-KIDIA+1,KLEV=llm) |
---|
| 30 | c----------------------------------------------------------------------- |
---|
| 31 | REAL phy_nat(klon,360), phy_nat0(klon) |
---|
| 32 | REAL phy_alb(klon,360) |
---|
| 33 | REAL phy_sst(klon,360) |
---|
| 34 | REAL phy_bil(klon,360) |
---|
| 35 | REAL phy_rug(klon,360) |
---|
| 36 | REAL phy_ice(klon,360) |
---|
| 37 | c |
---|
| 38 | REAL masque(iip1,jjp1) |
---|
| 39 | REAL mask(iim,jjp1) |
---|
| 40 | |
---|
| 41 | C Declarations pour le champ de depart |
---|
| 42 | INTEGER imdep, jmdep,lmdep |
---|
| 43 | INTEGER ibid, jbid, tbid |
---|
| 44 | PARAMETER (ibid = 400, ! >360 pts |
---|
| 45 | . jbid = 200, ! >181 pts |
---|
| 46 | . tbid = 60) ! >52 semaines |
---|
| 47 | REAL champ(ibid*jbid) |
---|
| 48 | REAL dlon(ibid), dlat(jbid), timecoord(tbid) |
---|
| 49 | c |
---|
| 50 | INTEGER ibid_msk, jbid_msk |
---|
| 51 | PARAMETER(ibid_msk=2200,jbid_msk=1100) |
---|
| 52 | REAL champ_msk(ibid_msk*jbid_msk) |
---|
| 53 | REAL dlon_msk(ibid_msk), dlat_msk(jbid_msk) |
---|
| 54 | |
---|
| 55 | C Declarations pour le champ interpole 2D |
---|
| 56 | REAL champint(iim,jjp1) |
---|
| 57 | |
---|
| 58 | C Declarations pour le champ interpole 3D |
---|
| 59 | REAL champtime(iim,jjp1,tbid) |
---|
| 60 | REAL timeyear(tbid) |
---|
| 61 | REAL champan(iip1,jjp1,366) |
---|
| 62 | |
---|
| 63 | C Declarations pour l'inteprolation verticale |
---|
| 64 | REAL ax(tbid), ay(tbid) |
---|
| 65 | REAL by |
---|
| 66 | REAL yder(tbid) |
---|
| 67 | |
---|
| 68 | |
---|
| 69 | INTEGER ierr |
---|
| 70 | INTEGER dimfirst(3) |
---|
| 71 | INTEGER dimlast(3) |
---|
| 72 | c |
---|
| 73 | INTEGER nid, ndim, ntim |
---|
| 74 | INTEGER dims(2), debut(2), epais(2) |
---|
| 75 | INTEGER id_tim |
---|
| 76 | INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB |
---|
| 77 | |
---|
| 78 | INTEGER i, j, k, l |
---|
| 79 | c Diverses variables locales |
---|
| 80 | REAL time |
---|
| 81 | |
---|
| 82 | INTEGER longcles |
---|
| 83 | PARAMETER ( longcles = 20 ) |
---|
| 84 | REAL clesphy0 ( longcles ) |
---|
| 85 | #include "serre.h" |
---|
| 86 | INTEGER ncid,varid,ndimid(4),dimid |
---|
| 87 | character*30 namedim |
---|
| 88 | |
---|
| 89 | c initialisations: |
---|
| 90 | OPEN (8,file='run.def',form='formatted') |
---|
| 91 | CALL defrun_new(8,.TRUE.,clesphy0) |
---|
| 92 | CLOSE(8) |
---|
| 93 | |
---|
| 94 | pi = 4. * ATAN(1.) |
---|
| 95 | rad = 6 371 229. |
---|
| 96 | omeg = 4.* ASIN(1.)/(24.*3600.) |
---|
| 97 | g = 9.8 |
---|
| 98 | daysec = 86400. |
---|
| 99 | kappa = 0.2857143 |
---|
| 100 | cpp = 1004.70885 |
---|
| 101 | dtvr = daysec/FLOAT(day_step) |
---|
| 102 | c |
---|
| 103 | ccc CALL iniconst ( non indispensable ) |
---|
| 104 | |
---|
| 105 | CALL inigeom |
---|
| 106 | c |
---|
| 107 | c |
---|
| 108 | C Traitement du relief au sol |
---|
| 109 | c |
---|
| 110 | write(*,*) 'Traitement du relief au sol pour fabriquer masque' |
---|
| 111 | ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid) |
---|
| 112 | |
---|
| 113 | if (ierr.ne.0) then |
---|
| 114 | print *, NF_STRERROR(ierr) |
---|
| 115 | STOP |
---|
| 116 | ENDIF |
---|
| 117 | |
---|
| 118 | ierr = NF_INQ_VARID(ncid,'RELIEF',varid) |
---|
| 119 | if (ierr.ne.0) then |
---|
| 120 | print *, NF_STRERROR(ierr) |
---|
| 121 | STOP |
---|
| 122 | ENDIF |
---|
| 123 | ierr = NF_INQ_VARDIMID (ncid,varid,ndimid) |
---|
| 124 | if (ierr.ne.0) then |
---|
| 125 | print *, NF_STRERROR(ierr) |
---|
| 126 | STOP |
---|
| 127 | ENDIF |
---|
| 128 | ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep) |
---|
| 129 | if (ierr.ne.0) then |
---|
| 130 | print *, NF_STRERROR(ierr) |
---|
| 131 | STOP |
---|
| 132 | ENDIF |
---|
| 133 | print*,'variable ', namedim, 'dimension ', imdep |
---|
| 134 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 135 | if (ierr.ne.0) then |
---|
| 136 | print *, NF_STRERROR(ierr) |
---|
| 137 | STOP |
---|
| 138 | ENDIF |
---|
[71] | 139 | c ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_msk) |
---|
| 140 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_msk) |
---|
| 141 | c$$$ zbidon=0.0 |
---|
| 142 | c$$$ ierr = NF_GET_VAR_REAL(ncid,dimid,zbidon(1:imdep)) |
---|
| 143 | c$$$ dlon_msk(1 : imdep) = dble(zbidon(1:imdep)) |
---|
| 144 | c |
---|
[2] | 145 | if (ierr.ne.0) then |
---|
| 146 | print *, NF_STRERROR(ierr) |
---|
| 147 | STOP |
---|
| 148 | ENDIF |
---|
| 149 | ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep) |
---|
| 150 | if (ierr.ne.0) then |
---|
| 151 | print *, NF_STRERROR(ierr) |
---|
| 152 | STOP |
---|
| 153 | ENDIF |
---|
| 154 | print*,'variable ', namedim, 'dimension ', jmdep |
---|
| 155 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 156 | if (ierr.ne.0) then |
---|
| 157 | print *, NF_STRERROR(ierr) |
---|
| 158 | STOP |
---|
| 159 | ENDIF |
---|
[71] | 160 | c ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_msk) |
---|
| 161 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_msk) |
---|
| 162 | c$$$ zbidon=0. |
---|
| 163 | c$$$ ierr = NF_GET_VAR_REAL(ncid,dimid,zbidon(1:jmdep)) |
---|
| 164 | c$$$ dlat_msk=dble(zbidon(1:jmdep)) |
---|
| 165 | c |
---|
[2] | 166 | if (ierr.ne.0) then |
---|
| 167 | print *, NF_STRERROR(ierr) |
---|
| 168 | STOP |
---|
| 169 | ENDIF |
---|
[71] | 170 | c ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk) |
---|
| 171 | ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk) |
---|
| 172 | c$$$ zbidon=0. |
---|
| 173 | c$$$ ierr = NF_GET_VAR_REAL(ncid,varid,zbidon(1:imdep*jmdep)) |
---|
| 174 | c$$$ champ_msk(1: imdep*jmdep) = zbidon(1:imdep*jmdep) |
---|
| 175 | c |
---|
[2] | 176 | if (ierr.ne.0) then |
---|
| 177 | print *, NF_STRERROR(ierr) |
---|
| 178 | STOP |
---|
| 179 | ENDIF |
---|
| 180 | |
---|
| 181 | c |
---|
| 182 | CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk, |
---|
| 183 | . iim, jjp1, rlonv, rlatu, champint) |
---|
| 184 | CALL gr_int_dyn(champint, masque, iim, jjp1) |
---|
| 185 | DO i = 1, iim |
---|
| 186 | masque(i,1) = FLOAT(NINT(masque(i,1))) |
---|
| 187 | masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1))) |
---|
| 188 | ENDDO |
---|
| 189 | DO i = 1, iim |
---|
| 190 | DO j = 1, jjp1 |
---|
| 191 | mask(i,j) = champint(i,j) |
---|
| 192 | ENDDO |
---|
| 193 | ENDDO |
---|
| 194 | CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0) |
---|
| 195 | ierr = NF_CLOSE(ncid) |
---|
| 196 | c |
---|
| 197 | c |
---|
| 198 | C Traitement de la rugosite |
---|
| 199 | c |
---|
| 200 | PRINT*, 'Traitement de la rugosite' |
---|
| 201 | ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid) |
---|
| 202 | if (ierr.ne.0) then |
---|
| 203 | print *, NF_STRERROR(ierr) |
---|
| 204 | STOP |
---|
| 205 | ENDIF |
---|
| 206 | |
---|
| 207 | ierr = NF_INQ_VARID(ncid,'RUGOS',varid) |
---|
| 208 | if (ierr.ne.0) then |
---|
| 209 | print *, NF_STRERROR(ierr) |
---|
| 210 | STOP |
---|
| 211 | ENDIF |
---|
| 212 | ierr = NF_INQ_VARDIMID (ncid,varid,ndimid) |
---|
| 213 | if (ierr.ne.0) then |
---|
| 214 | print *, NF_STRERROR(ierr) |
---|
| 215 | STOP |
---|
| 216 | ENDIF |
---|
| 217 | ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep) |
---|
| 218 | if (ierr.ne.0) then |
---|
| 219 | print *, NF_STRERROR(ierr) |
---|
| 220 | STOP |
---|
| 221 | ENDIF |
---|
| 222 | print*,'variable ', namedim, 'dimension ', imdep |
---|
| 223 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 224 | if (ierr.ne.0) then |
---|
| 225 | print *, NF_STRERROR(ierr) |
---|
| 226 | STOP |
---|
| 227 | ENDIF |
---|
[71] | 228 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon) |
---|
[2] | 229 | if (ierr.ne.0) then |
---|
| 230 | print *, NF_STRERROR(ierr) |
---|
| 231 | STOP |
---|
| 232 | ENDIF |
---|
| 233 | ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep) |
---|
| 234 | if (ierr.ne.0) then |
---|
| 235 | print *, NF_STRERROR(ierr) |
---|
| 236 | STOP |
---|
| 237 | ENDIF |
---|
| 238 | print*,'variable ', namedim, 'dimension ', jmdep |
---|
| 239 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 240 | if (ierr.ne.0) then |
---|
| 241 | print *, NF_STRERROR(ierr) |
---|
| 242 | STOP |
---|
| 243 | ENDIF |
---|
[71] | 244 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat) |
---|
[2] | 245 | if (ierr.ne.0) then |
---|
| 246 | print *, NF_STRERROR(ierr) |
---|
| 247 | STOP |
---|
| 248 | ENDIF |
---|
| 249 | ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep) |
---|
| 250 | if (ierr.ne.0) then |
---|
| 251 | print *, NF_STRERROR(ierr) |
---|
| 252 | STOP |
---|
| 253 | ENDIF |
---|
| 254 | print*,'variable ', namedim, 'dimension ', lmdep |
---|
| 255 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 256 | if (ierr.ne.0) then |
---|
| 257 | print *, NF_STRERROR(ierr) |
---|
| 258 | STOP |
---|
| 259 | ENDIF |
---|
[71] | 260 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord) |
---|
[2] | 261 | if (ierr.ne.0) then |
---|
| 262 | print *, NF_STRERROR(ierr) |
---|
| 263 | STOP |
---|
| 264 | ENDIF |
---|
| 265 | c |
---|
| 266 | DO l = 1, lmdep |
---|
| 267 | dimfirst(1) = 1 |
---|
| 268 | dimfirst(2) = 1 |
---|
| 269 | dimfirst(3) = l |
---|
| 270 | c |
---|
| 271 | dimlast(1) = imdep |
---|
| 272 | dimlast(2) = jmdep |
---|
| 273 | dimlast(3) = 1 |
---|
| 274 | c |
---|
| 275 | PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) |
---|
| 276 | print*,dimfirst,dimlast |
---|
[71] | 277 | ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ) |
---|
[2] | 278 | if (ierr.ne.0) then |
---|
| 279 | print *, NF_STRERROR(ierr) |
---|
| 280 | STOP |
---|
| 281 | ENDIF |
---|
| 282 | |
---|
| 283 | CALL rugosite(imdep, jmdep, dlon, dlat, champ, |
---|
| 284 | . iim, jjp1, rlonv, rlatu, champint, mask) |
---|
| 285 | DO j = 1,jjp1 |
---|
| 286 | DO i = 1, iim |
---|
| 287 | champtime (i,j,l) = champint(i,j) |
---|
| 288 | ENDDO |
---|
| 289 | ENDDO |
---|
| 290 | ENDDO |
---|
| 291 | c |
---|
| 292 | DO l = 1, lmdep |
---|
| 293 | timeyear(l) = timecoord(l) |
---|
| 294 | ENDDO |
---|
| 295 | |
---|
| 296 | PRINT 222, timeyear |
---|
| 297 | 222 FORMAT(2x,' Time year ',10f6.1) |
---|
| 298 | c |
---|
| 299 | |
---|
| 300 | PRINT*, 'Interpolation temporelle dans l annee' |
---|
| 301 | |
---|
| 302 | |
---|
| 303 | DO j = 1, jjp1 |
---|
| 304 | DO i = 1, iim |
---|
| 305 | DO l = 1, lmdep |
---|
| 306 | ax(l) = timeyear(l) |
---|
| 307 | ay(l) = champtime (i,j,l) |
---|
| 308 | ENDDO |
---|
| 309 | CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) |
---|
| 310 | DO k = 1, 360 |
---|
| 311 | time = FLOAT(k-1) |
---|
| 312 | CALL SPLINT(ax,ay,yder,lmdep,time,by) |
---|
| 313 | champan(i,j,k) = by |
---|
| 314 | ENDDO |
---|
| 315 | ENDDO |
---|
| 316 | ENDDO |
---|
| 317 | DO k = 1, 360 |
---|
| 318 | DO j = 1, jjp1 |
---|
| 319 | champan(iip1,j,k) = champan(1,j,k) |
---|
| 320 | ENDDO |
---|
| 321 | ENDDO |
---|
| 322 | c |
---|
| 323 | DO k = 1, 360 |
---|
| 324 | CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k)) |
---|
| 325 | ENDDO |
---|
| 326 | c |
---|
| 327 | ierr = NF_CLOSE(ncid) |
---|
| 328 | c |
---|
| 329 | c |
---|
| 330 | C Traitement de la glace oceanique |
---|
| 331 | c |
---|
| 332 | PRINT*, 'Traitement de la glace oceanique' |
---|
| 333 | ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid) |
---|
| 334 | if (ierr.ne.0) then |
---|
| 335 | print *, NF_STRERROR(ierr) |
---|
| 336 | STOP |
---|
| 337 | ENDIF |
---|
| 338 | |
---|
| 339 | ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid) |
---|
| 340 | if (ierr.ne.0) then |
---|
| 341 | print *, NF_STRERROR(ierr) |
---|
| 342 | STOP |
---|
| 343 | ENDIF |
---|
| 344 | ierr = NF_INQ_VARDIMID (ncid,varid,ndimid) |
---|
| 345 | if (ierr.ne.0) then |
---|
| 346 | print *, NF_STRERROR(ierr) |
---|
| 347 | STOP |
---|
| 348 | ENDIF |
---|
| 349 | ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep) |
---|
| 350 | if (ierr.ne.0) then |
---|
| 351 | print *, NF_STRERROR(ierr) |
---|
| 352 | STOP |
---|
| 353 | ENDIF |
---|
| 354 | print*,'variable ', namedim, 'dimension ', imdep |
---|
| 355 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 356 | if (ierr.ne.0) then |
---|
| 357 | print *, NF_STRERROR(ierr) |
---|
| 358 | STOP |
---|
| 359 | ENDIF |
---|
[71] | 360 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon) |
---|
[2] | 361 | if (ierr.ne.0) then |
---|
| 362 | print *, NF_STRERROR(ierr) |
---|
| 363 | STOP |
---|
| 364 | ENDIF |
---|
| 365 | ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep) |
---|
| 366 | if (ierr.ne.0) then |
---|
| 367 | print *, NF_STRERROR(ierr) |
---|
| 368 | STOP |
---|
| 369 | ENDIF |
---|
| 370 | print*,'variable ', namedim, jmdep |
---|
| 371 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 372 | if (ierr.ne.0) then |
---|
| 373 | print *, NF_STRERROR(ierr) |
---|
| 374 | STOP |
---|
| 375 | ENDIF |
---|
[71] | 376 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat) |
---|
[2] | 377 | if (ierr.ne.0) then |
---|
| 378 | print *, NF_STRERROR(ierr) |
---|
| 379 | STOP |
---|
| 380 | ENDIF |
---|
| 381 | ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep) |
---|
| 382 | if (ierr.ne.0) then |
---|
| 383 | print *, NF_STRERROR(ierr) |
---|
| 384 | STOP |
---|
| 385 | ENDIF |
---|
| 386 | print*,'variable ', namedim, lmdep |
---|
| 387 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 388 | if (ierr.ne.0) then |
---|
| 389 | print *, NF_STRERROR(ierr) |
---|
| 390 | STOP |
---|
| 391 | ENDIF |
---|
[71] | 392 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord) |
---|
[2] | 393 | if (ierr.ne.0) then |
---|
| 394 | print *, NF_STRERROR(ierr) |
---|
| 395 | STOP |
---|
| 396 | ENDIF |
---|
| 397 | c |
---|
| 398 | DO l = 1, lmdep |
---|
| 399 | dimfirst(1) = 1 |
---|
| 400 | dimfirst(2) = 1 |
---|
| 401 | dimfirst(3) = l |
---|
| 402 | c |
---|
| 403 | dimlast(1) = imdep |
---|
| 404 | dimlast(2) = jmdep |
---|
| 405 | dimlast(3) = 1 |
---|
| 406 | c |
---|
| 407 | PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) |
---|
[71] | 408 | ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ) |
---|
[2] | 409 | if (ierr.ne.0) then |
---|
| 410 | print *, NF_STRERROR(ierr) |
---|
| 411 | STOP |
---|
| 412 | ENDIF |
---|
| 413 | |
---|
| 414 | CALL sea_ice(imdep, jmdep, dlon, dlat, champ, |
---|
| 415 | . iim, jjp1, rlonv, rlatu, champint) |
---|
| 416 | DO j = 1,jjp1 |
---|
| 417 | DO i = 1, iim |
---|
| 418 | champtime (i,j,l) = champint(i,j) |
---|
| 419 | ENDDO |
---|
| 420 | ENDDO |
---|
| 421 | ENDDO |
---|
| 422 | c |
---|
| 423 | DO l = 1, lmdep |
---|
| 424 | timeyear(l) = timecoord(l) |
---|
| 425 | ENDDO |
---|
| 426 | PRINT 222, timeyear |
---|
| 427 | c |
---|
| 428 | PRINT*, 'Interpolation temporelle' |
---|
| 429 | DO j = 1, jjp1 |
---|
| 430 | DO i = 1, iim |
---|
| 431 | DO l = 1, lmdep |
---|
| 432 | ax(l) = timeyear(l) |
---|
| 433 | ay(l) = champtime (i,j,l) |
---|
| 434 | ENDDO |
---|
| 435 | CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) |
---|
| 436 | DO k = 1, 360 |
---|
| 437 | time = FLOAT(k-1) |
---|
| 438 | CALL SPLINT(ax,ay,yder,lmdep,time,by) |
---|
| 439 | champan(i,j,k) = by |
---|
| 440 | ENDDO |
---|
| 441 | ENDDO |
---|
| 442 | ENDDO |
---|
| 443 | DO k = 1, 360 |
---|
| 444 | DO j = 1, jjp1 |
---|
| 445 | champan(iip1, j, k) = champan(1, j, k) |
---|
| 446 | ENDDO |
---|
| 447 | ENDDO |
---|
| 448 | c |
---|
| 449 | DO k = 1, 360 |
---|
| 450 | CALL gr_dyn_fi(1, iip1, jjp1, klon, |
---|
| 451 | . champan(1,1,k), phy_ice(1,k)) |
---|
| 452 | DO i = 1, klon |
---|
| 453 | phy_nat(i,k) = phy_nat0(i) |
---|
| 454 | IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN |
---|
| 455 | IF (NINT(phy_nat0(i)).EQ.0) THEN |
---|
| 456 | phy_nat(i,k) = 3.0 |
---|
| 457 | ELSE |
---|
| 458 | phy_nat(i,k) = 2.0 |
---|
| 459 | ENDIF |
---|
| 460 | ENDIF |
---|
| 461 | ENDDO |
---|
| 462 | ENDDO |
---|
| 463 | c |
---|
| 464 | ierr = NF_CLOSE(ncid) |
---|
| 465 | c |
---|
| 466 | c |
---|
| 467 | C Traitement de la sst |
---|
| 468 | c |
---|
| 469 | PRINT*, 'Traitement de la sst' |
---|
| 470 | ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid) |
---|
| 471 | if (ierr.ne.0) then |
---|
| 472 | print *, NF_STRERROR(ierr) |
---|
| 473 | STOP |
---|
| 474 | ENDIF |
---|
| 475 | |
---|
| 476 | ierr = NF_INQ_VARID(ncid,'SST',varid) |
---|
| 477 | if (ierr.ne.0) then |
---|
| 478 | print *, NF_STRERROR(ierr) |
---|
| 479 | STOP |
---|
| 480 | ENDIF |
---|
| 481 | ierr = NF_INQ_VARDIMID (ncid,varid,ndimid) |
---|
| 482 | if (ierr.ne.0) then |
---|
| 483 | print *, NF_STRERROR(ierr) |
---|
| 484 | STOP |
---|
| 485 | ENDIF |
---|
| 486 | ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep) |
---|
| 487 | if (ierr.ne.0) then |
---|
| 488 | print *, NF_STRERROR(ierr) |
---|
| 489 | STOP |
---|
| 490 | ENDIF |
---|
| 491 | print*,'variable ', namedim,'dimension ', imdep |
---|
| 492 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 493 | if (ierr.ne.0) then |
---|
| 494 | print *, NF_STRERROR(ierr) |
---|
| 495 | STOP |
---|
| 496 | ENDIF |
---|
[71] | 497 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon) |
---|
[2] | 498 | if (ierr.ne.0) then |
---|
| 499 | print *, NF_STRERROR(ierr) |
---|
| 500 | STOP |
---|
| 501 | ENDIF |
---|
| 502 | ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep) |
---|
| 503 | if (ierr.ne.0) then |
---|
| 504 | print *, NF_STRERROR(ierr) |
---|
| 505 | STOP |
---|
| 506 | ENDIF |
---|
| 507 | print*,'variable ', namedim, 'dimension ', jmdep |
---|
| 508 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 509 | if (ierr.ne.0) then |
---|
| 510 | print *, NF_STRERROR(ierr) |
---|
| 511 | STOP |
---|
| 512 | ENDIF |
---|
[71] | 513 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat) |
---|
[2] | 514 | if (ierr.ne.0) then |
---|
| 515 | print *, NF_STRERROR(ierr) |
---|
| 516 | STOP |
---|
| 517 | ENDIF |
---|
| 518 | ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep) |
---|
| 519 | if (ierr.ne.0) then |
---|
| 520 | print *, NF_STRERROR(ierr) |
---|
| 521 | STOP |
---|
| 522 | ENDIF |
---|
| 523 | print*,'variable ', namedim, 'dimension ', lmdep |
---|
| 524 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 525 | if (ierr.ne.0) then |
---|
| 526 | print *, NF_STRERROR(ierr) |
---|
| 527 | STOP |
---|
| 528 | ENDIF |
---|
[71] | 529 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord) |
---|
[2] | 530 | if (ierr.ne.0) then |
---|
| 531 | print *, NF_STRERROR(ierr) |
---|
| 532 | STOP |
---|
| 533 | ENDIF |
---|
| 534 | c |
---|
| 535 | DO l = 1, lmdep |
---|
| 536 | dimfirst(1) = 1 |
---|
| 537 | dimfirst(2) = 1 |
---|
| 538 | dimfirst(3) = l |
---|
| 539 | c |
---|
| 540 | dimlast(1) = imdep |
---|
| 541 | dimlast(2) = jmdep |
---|
| 542 | dimlast(3) = 1 |
---|
| 543 | c |
---|
| 544 | PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) |
---|
[71] | 545 | ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ) |
---|
[2] | 546 | if (ierr.ne.0) then |
---|
| 547 | print *, NF_STRERROR(ierr) |
---|
| 548 | STOP |
---|
| 549 | ENDIF |
---|
| 550 | CALL grille_m(imdep, jmdep, dlon, dlat, champ, |
---|
| 551 | . iim, jjp1, rlonv, rlatu, champint) |
---|
| 552 | |
---|
| 553 | DO j = 1,jjp1 |
---|
| 554 | DO i = 1, iim |
---|
| 555 | champtime (i,j,l) = champint(i,j) |
---|
| 556 | ENDDO |
---|
| 557 | ENDDO |
---|
| 558 | ENDDO |
---|
| 559 | c |
---|
| 560 | DO l = 1, lmdep |
---|
| 561 | timeyear(l) = timecoord(l) |
---|
| 562 | ENDDO |
---|
| 563 | print 222, timeyear |
---|
| 564 | c |
---|
| 565 | C interpolation temporelle |
---|
| 566 | DO j = 1, jjp1 |
---|
| 567 | DO i = 1, iim |
---|
| 568 | DO l = 1, lmdep |
---|
| 569 | ax(l) = timeyear(l) |
---|
| 570 | ay(l) = champtime (i,j,l) |
---|
| 571 | ENDDO |
---|
| 572 | CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) |
---|
| 573 | DO k = 1, 360 |
---|
| 574 | time = FLOAT(k-1) |
---|
| 575 | CALL SPLINT(ax,ay,yder,lmdep,time,by) |
---|
| 576 | champan(i,j,k) = by |
---|
| 577 | ENDDO |
---|
| 578 | ENDDO |
---|
| 579 | ENDDO |
---|
| 580 | DO k = 1, 360 |
---|
| 581 | DO j = 1, jjp1 |
---|
| 582 | champan(iip1,j,k) = champan(1,j,k) |
---|
| 583 | ENDDO |
---|
| 584 | ENDDO |
---|
| 585 | c |
---|
| 586 | DO k = 1, 360 |
---|
| 587 | CALL gr_dyn_fi(1, iip1, jjp1, klon, |
---|
| 588 | . champan(1,1,k), phy_sst(1,k)) |
---|
| 589 | ENDDO |
---|
| 590 | c |
---|
| 591 | ierr = NF_CLOSE(ncid) |
---|
| 592 | c |
---|
| 593 | c |
---|
| 594 | C Traitement de l'albedo |
---|
| 595 | c |
---|
| 596 | PRINT*, 'Traitement de l albedo' |
---|
| 597 | ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid) |
---|
| 598 | if (ierr.ne.0) then |
---|
| 599 | print *, NF_STRERROR(ierr) |
---|
| 600 | STOP |
---|
| 601 | ENDIF |
---|
| 602 | ierr = NF_INQ_VARID(ncid,'ALBEDO',varid) |
---|
| 603 | if (ierr.ne.0) then |
---|
| 604 | print *, NF_STRERROR(ierr) |
---|
| 605 | STOP |
---|
| 606 | ENDIF |
---|
| 607 | ierr = NF_INQ_VARDIMID (ncid,varid,ndimid) |
---|
| 608 | if (ierr.ne.0) then |
---|
| 609 | print *, NF_STRERROR(ierr) |
---|
| 610 | STOP |
---|
| 611 | ENDIF |
---|
| 612 | ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep) |
---|
| 613 | if (ierr.ne.0) then |
---|
| 614 | print *, NF_STRERROR(ierr) |
---|
| 615 | STOP |
---|
| 616 | ENDIF |
---|
| 617 | print*,'variable ', namedim, 'dimension ', imdep |
---|
| 618 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 619 | if (ierr.ne.0) then |
---|
| 620 | print *, NF_STRERROR(ierr) |
---|
| 621 | STOP |
---|
| 622 | ENDIF |
---|
[71] | 623 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon) |
---|
[2] | 624 | if (ierr.ne.0) then |
---|
| 625 | print *, NF_STRERROR(ierr) |
---|
| 626 | STOP |
---|
| 627 | ENDIF |
---|
| 628 | ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep) |
---|
| 629 | if (ierr.ne.0) then |
---|
| 630 | print *, NF_STRERROR(ierr) |
---|
| 631 | STOP |
---|
| 632 | ENDIF |
---|
| 633 | print*,'variable ', namedim, 'dimension ', jmdep |
---|
| 634 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 635 | if (ierr.ne.0) then |
---|
| 636 | print *, NF_STRERROR(ierr) |
---|
| 637 | STOP |
---|
| 638 | ENDIF |
---|
[71] | 639 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat) |
---|
[2] | 640 | if (ierr.ne.0) then |
---|
| 641 | print *, NF_STRERROR(ierr) |
---|
| 642 | STOP |
---|
| 643 | ENDIF |
---|
| 644 | ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep) |
---|
| 645 | if (ierr.ne.0) then |
---|
| 646 | print *, NF_STRERROR(ierr) |
---|
| 647 | STOP |
---|
| 648 | ENDIF |
---|
| 649 | print*,'variable ', namedim, 'dimension ', lmdep |
---|
| 650 | ierr = NF_INQ_VARID(ncid,namedim,dimid) |
---|
| 651 | if (ierr.ne.0) then |
---|
| 652 | print *, NF_STRERROR(ierr) |
---|
| 653 | STOP |
---|
| 654 | ENDIF |
---|
[71] | 655 | ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord) |
---|
[2] | 656 | if (ierr.ne.0) then |
---|
| 657 | print *, NF_STRERROR(ierr) |
---|
| 658 | STOP |
---|
| 659 | ENDIF |
---|
| 660 | c |
---|
| 661 | DO l = 1, lmdep |
---|
| 662 | dimfirst(1) = 1 |
---|
| 663 | dimfirst(2) = 1 |
---|
| 664 | dimfirst(3) = l |
---|
| 665 | c |
---|
| 666 | dimlast(1) = imdep |
---|
| 667 | dimlast(2) = jmdep |
---|
| 668 | dimlast(3) = 1 |
---|
| 669 | c |
---|
| 670 | PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) |
---|
[71] | 671 | ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ) |
---|
[2] | 672 | if (ierr.ne.0) then |
---|
| 673 | print *, NF_STRERROR(ierr) |
---|
| 674 | STOP |
---|
| 675 | ENDIF |
---|
| 676 | CALL grille_m(imdep, jmdep, dlon, dlat, champ, |
---|
| 677 | . iim, jjp1, rlonv, rlatu, champint) |
---|
| 678 | c |
---|
| 679 | DO j = 1,jjp1 |
---|
| 680 | DO i = 1, iim |
---|
| 681 | champtime (i, j, l) = champint(i, j) |
---|
| 682 | ENDDO |
---|
| 683 | ENDDO |
---|
| 684 | ENDDO |
---|
| 685 | c |
---|
| 686 | DO l = 1, lmdep |
---|
| 687 | timeyear(l) = timecoord(l) |
---|
| 688 | ENDDO |
---|
| 689 | print 222, timeyear |
---|
| 690 | c |
---|
| 691 | C interpolation temporelle |
---|
| 692 | DO j = 1, jjp1 |
---|
| 693 | DO i = 1, iim |
---|
| 694 | DO l = 1, lmdep |
---|
| 695 | ax(l) = timeyear(l) |
---|
| 696 | ay(l) = champtime (i, j, l) |
---|
| 697 | ENDDO |
---|
| 698 | CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) |
---|
| 699 | DO k = 1, 360 |
---|
| 700 | time = FLOAT(k-1) |
---|
| 701 | CALL SPLINT(ax,ay,yder,lmdep,time,by) |
---|
| 702 | champan(i,j,k) = by |
---|
| 703 | ENDDO |
---|
| 704 | ENDDO |
---|
| 705 | ENDDO |
---|
| 706 | DO k = 1, 360 |
---|
| 707 | DO j = 1, jjp1 |
---|
| 708 | champan(iip1, j, k) = champan(1, j, k) |
---|
| 709 | ENDDO |
---|
| 710 | ENDDO |
---|
| 711 | c |
---|
| 712 | DO k = 1, 360 |
---|
| 713 | CALL gr_dyn_fi(1, iip1, jjp1, klon, |
---|
| 714 | . champan(1,1,k), phy_alb(1,k)) |
---|
| 715 | ENDDO |
---|
| 716 | c |
---|
| 717 | ierr = NF_CLOSE(ncid) |
---|
| 718 | c |
---|
| 719 | c |
---|
| 720 | DO k = 1, 360 |
---|
| 721 | DO i = 1, klon |
---|
| 722 | phy_bil(i,k) = 0.0 |
---|
| 723 | ENDDO |
---|
| 724 | ENDDO |
---|
| 725 | c |
---|
| 726 | PRINT*, 'Ecriture du fichier limit' |
---|
| 727 | c |
---|
| 728 | ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid) |
---|
| 729 | c |
---|
| 730 | ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30, |
---|
| 731 | . "Fichier conditions aux limites") |
---|
| 732 | ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim) |
---|
| 733 | ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim) |
---|
| 734 | c |
---|
| 735 | dims(1) = ndim |
---|
| 736 | dims(2) = ntim |
---|
| 737 | c |
---|
| 738 | ccc ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim) |
---|
| 739 | ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim) |
---|
| 740 | ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17, |
---|
| 741 | . "Jour dans l annee") |
---|
| 742 | ccc ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT) |
---|
| 743 | ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT) |
---|
| 744 | ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23, |
---|
| 745 | . "Nature du sol (0,1,2,3)") |
---|
| 746 | ccc ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST) |
---|
| 747 | ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST) |
---|
| 748 | ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35, |
---|
| 749 | . "Temperature superficielle de la mer") |
---|
| 750 | ccc ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS) |
---|
| 751 | ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS) |
---|
| 752 | ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32, |
---|
| 753 | . "Reference flux de chaleur au sol") |
---|
| 754 | ccc ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB) |
---|
| 755 | ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB) |
---|
| 756 | ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19, |
---|
| 757 | . "Albedo a la surface") |
---|
| 758 | ccc ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG) |
---|
| 759 | ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG) |
---|
| 760 | ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8, |
---|
| 761 | . "Rugosite") |
---|
| 762 | c |
---|
| 763 | ierr = NF_ENDDEF(nid) |
---|
| 764 | c |
---|
| 765 | DO k = 1, 360 |
---|
| 766 | c |
---|
| 767 | debut(1) = 1 |
---|
| 768 | debut(2) = k |
---|
| 769 | epais(1) = klon |
---|
| 770 | epais(2) = 1 |
---|
| 771 | c |
---|
| 772 | #ifdef NC_DOUBLE |
---|
| 773 | ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k)) |
---|
| 774 | ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k)) |
---|
| 775 | ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k)) |
---|
| 776 | ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k)) |
---|
| 777 | ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k)) |
---|
| 778 | ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k)) |
---|
| 779 | #else |
---|
| 780 | ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k)) |
---|
| 781 | ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k)) |
---|
| 782 | ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k)) |
---|
| 783 | ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k)) |
---|
| 784 | ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k)) |
---|
| 785 | ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k)) |
---|
| 786 | #endif |
---|
| 787 | c |
---|
| 788 | ENDDO |
---|
| 789 | c |
---|
| 790 | ierr = NF_CLOSE(nid) |
---|
| 791 | c |
---|
| 792 | STOP |
---|
| 793 | END |
---|