Changeset 2408 for LMDZ5/branches/testing/libf/phylmd/read_pstoke0.F90
- Timestamp:
- Dec 14, 2015, 11:43:09 AM (9 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2293-2295,2297,2299-2302,2305-2313,2315,2317-2380,2382-2396
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/read_pstoke0.F90
r1999 r2408 18 18 USE netcdf 19 19 USE dimphy 20 USE control_mod21 20 USE indice_sol_mod 21 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev 22 22 23 23 IMPLICIT NONE 24 24 25 25 include "netcdf.inc" 26 include "dimensions.h"27 include "paramet.h"28 include "comconst.h"29 include "comgeom.h"30 include "temps.h"31 include "ener.h"32 include "logic.h"33 include "description.h"34 include "serre.h"35 ! ccc#include "dimphy.h"36 26 37 27 INTEGER kon, kev, zkon, zkev 38 PARAMETER (kon=iim*(jjm-1)+2, kev=llm) 39 REAL phisfi(kon) 40 REAL phisfi2(iim, jjm+1), airefi2(iim, jjm+1) 41 42 REAL mfu(kon, kev), mfd(kon, kev) 43 REAL en_u(kon, kev), de_u(kon, kev) 44 REAL en_d(kon, kev), de_d(kon, kev) 45 REAL coefh(kon, kev) 28 ! PARAMETER (kon=iim*(jjm-1)+2, kev=llm) 29 REAL :: phisfi(nbp_lon*(nbp_lat-2)+2) !phisfi(kon) 30 REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(nbp_lon, nbp_lat) 31 REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(nbp_lon, nbp_lat) 32 33 REAL :: mfu(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfu(kon, kev) 34 REAL :: mfd(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfd(kon, kev) 35 REAL :: en_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_u(kon, kev) 36 REAL :: de_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_u(kon, kev) 37 REAL :: en_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_d(kon, kev) 38 REAL :: de_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_d(kon, kev) 39 REAL :: coefh(nbp_lon*(nbp_lat-2)+2,nbp_lev) !coefh(kon, kev) 46 40 47 41 ! abd 25 11 02 48 42 ! Thermiques 49 REAL fm_therm(kon, kev), en_therm(kon, kev) 50 REAL t(kon, kev) 51 52 REAL mfu2(iim, jjm+1, kev), mfd2(iim, jjm+1, kev) 53 REAL en_u2(iim, jjm+1, kev), de_u2(iim, jjm+1, kev) 54 REAL en_d2(iim, jjm+1, kev), de_d2(iim, jjm+1, kev) 55 REAL coefh2(iim, jjm+1, kev) 56 REAL t2(iim, jjm+1, kev) 43 REAL :: fm_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !fm_therm(kon, kev) 44 REAL :: en_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_therm(kon, kev) 45 REAL :: t(nbp_lon*(nbp_lat-2)+2,nbp_lev) !t(kon, kev) 46 47 REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(nbp_lon, nbp_lat, kev) 48 REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(nbp_lon, nbp_lat, kev) 49 REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(nbp_lon, nbp_lat, kev) 50 REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(nbp_lon, nbp_lat, kev) 51 REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(nbp_lon, nbp_lat, kev) 52 REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(nbp_lon, nbp_lat, kev) 53 REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(nbp_lon, nbp_lat, kev) 54 REAL,ALLOCATABLE :: t2(:,:,:) !t2(nbp_lon, nbp_lat, kev) 57 55 ! Thermiques 58 REAL fm_therm2(iim, jjm+1, kev)59 REAL en_therm2(iim, jjm+1, kev)60 61 REAL 56 REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(nbp_lon, nbp_lat, kev) 57 REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(nbp_lon, nbp_lat, kev) 58 59 REAL,ALLOCATABLE :: pl(:) !pl(kev) 62 60 INTEGER irec 63 61 INTEGER xid, yid, zid, tid … … 65 63 INTEGER ncrec, nckon, nckev, ncim, ncjm 66 64 67 REAL airefi(kon)65 REAL :: airefi(nbp_lon*(nbp_lat-2)+2) !airefi(kon) 68 66 CHARACTER *20 namedim 69 67 … … 72 70 ! dim de phis?? 73 71 74 REAL frac_impa(kon, kev), frac_nucl(kon, kev) 75 REAL frac_impa2(iim, jjm+1, kev), frac_nucl2(iim, jjm+1, kev) 76 REAL pyu1(kon), pyv1(kon) 77 REAL pyu12(iim, jjm+1), pyv12(iim, jjm+1) 78 REAL ftsol(kon, nbsrf) 79 REAL psrf(kon, nbsrf) 80 REAL ftsol1(kon), ftsol2(kon), ftsol3(kon), ftsol4(kon) 81 REAL psrf1(kon), psrf2(kon), psrf3(kon), psrf4(kon) 82 REAL ftsol12(iim, jjm+1), ftsol22(iim, jjm+1), ftsol32(iim, jjm+1), & 83 ftsol42(iim, jjm+1) 84 REAL psrf12(iim, jjm+1), psrf22(iim, jjm+1), psrf32(iim, jjm+1), & 85 psrf42(iim, jjm+1) 86 87 INTEGER ncidp 88 SAVE ncidp 89 INTEGER varidmfu, varidmfd, varidps, varidenu, variddeu 90 INTEGER varidt 91 INTEGER varidend, varidded, varidch, varidfi, varidfn 72 REAL :: frac_impa(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_impa(kon, kev) 73 REAL :: frac_nucl(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_nucl(kon, kev) 74 REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(nbp_lon, nbp_lat, kev) 75 REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(nbp_lon, nbp_lat, kev) 76 REAL :: pyu1(nbp_lon*(nbp_lat-2)+2) !pyu1(kon) 77 REAL :: pyv1(nbp_lon*(nbp_lat-2)+2) !pyv1(kon) 78 REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat) 79 REAL :: ftsol(nbp_lon*(nbp_lat-2)+2,nbp_lev) !ftsol(kon, nbsrf) 80 REAL :: psrf(nbp_lon*(nbp_lat-2)+2,nbp_lev) !psrf(kon, nbsrf) 81 REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(kon), ftsol2(kon) 82 REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(kon), ftsol4(kon) 83 REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(kon), psrf2(kon) 84 REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(kon), psrf4(kon) 85 REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(nbp_lon, nbp_lat) 86 REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(nbp_lon, nbp_lat) 87 REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(nbp_lon, nbp_lat) 88 REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(nbp_lon, nbp_lat) 89 REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(nbp_lon, nbp_lat) 90 REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(nbp_lon, nbp_lat) 91 REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(nbp_lon, nbp_lat) 92 REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(nbp_lon, nbp_lat) 93 94 INTEGER,SAVE :: ncidp 95 INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu 96 INTEGER,SAVE :: varidt 97 INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn 92 98 ! therm 93 INTEGER varidfmth, varidenth 94 INTEGER varidyu1, varidyv1, varidpl, varidai, varididvt 95 INTEGER varidfts1, varidfts2, varidfts3, varidfts4 96 INTEGER varidpsr1, varidpsr2, varidpsr3, varidpsr4 97 SAVE varidmfu, varidmfd, varidps, varidenu, variddeu 98 SAVE varidt 99 SAVE varidend, varidded, varidch, varidfi, varidfn 100 ! therm 101 SAVE varidfmth, varidenth 102 SAVE varidyu1, varidyv1, varidpl, varidai, varididvt 103 SAVE varidfts1, varidfts2, varidfts3, varidfts4 104 SAVE varidpsr1, varidpsr2, varidpsr3, varidpsr4 99 INTEGER,SAVE :: varidfmth, varidenth 100 INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt 101 INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4 102 INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4 105 103 106 104 INTEGER l, i 107 105 INTEGER start(4), count(4), status 108 106 REAL rcode 109 LOGICAL first 110 SAVE first 111 DATA first/.TRUE./ 112 113 107 LOGICAL,SAVE :: first=.TRUE. 108 109 ! Allocate arrays 110 kon=nbp_lon*(nbp_lat-2)+2 111 kev=nbp_lev 112 113 ALLOCATE(phisfi2(nbp_lon, nbp_lat)) 114 ALLOCATE(airefi2(nbp_lon, nbp_lat)) 115 ALLOCATE(mfu2(nbp_lon, nbp_lat, kev)) 116 ALLOCATE(mfd2(nbp_lon, nbp_lat, kev)) 117 ALLOCATE(en_u2(nbp_lon, nbp_lat, kev)) 118 ALLOCATE(de_u2(nbp_lon, nbp_lat, kev)) 119 ALLOCATE(en_d2(nbp_lon, nbp_lat, kev)) 120 ALLOCATE(de_d2(nbp_lon, nbp_lat, kev)) 121 ALLOCATE(coefh2(nbp_lon, nbp_lat, kev)) 122 ALLOCATE(t2(nbp_lon, nbp_lat, kev)) 123 ALLOCATE(fm_therm2(nbp_lon, nbp_lat, kev)) 124 ALLOCATE(en_therm2(nbp_lon, nbp_lat, kev)) 125 ALLOCATE(pl(kev)) 126 ALLOCATE(frac_impa2(nbp_lon, nbp_lat, kev)) 127 ALLOCATE(frac_nucl2(nbp_lon, nbp_lat, kev)) 128 ALLOCATE(pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat)) 129 ALLOCATE(ftsol1(kon), ftsol2(kon)) 130 ALLOCATE(ftsol3(kon), ftsol4(kon)) 131 ALLOCATE(psrf1(kon), psrf2(kon)) 132 ALLOCATE(psrf3(kon), psrf4(kon)) 133 ALLOCATE(ftsol12(nbp_lon, nbp_lat)) 134 ALLOCATE(ftsol22(nbp_lon, nbp_lat)) 135 ALLOCATE(ftsol32(nbp_lon, nbp_lat)) 136 ALLOCATE(ftsol42(nbp_lon, nbp_lat)) 137 ALLOCATE(psrf12(nbp_lon, nbp_lat)) 138 ALLOCATE(psrf22(nbp_lon, nbp_lat)) 139 ALLOCATE(psrf32(nbp_lon, nbp_lat)) 140 ALLOCATE(psrf42(nbp_lon, nbp_lat)) 114 141 115 142 ! --------------------------------------------- … … 248 275 status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2) 249 276 #endif 250 CALL gr_ecrit_fi(1, kon, iim, jjm+1, phisfi2, phisfi)277 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi) 251 278 252 279 ! **** Aires des mails aux sol ************************************ … … 257 284 status = nf_get_vara_real(ncidp, varidai, start, count, airefi2) 258 285 #endif 259 CALL gr_ecrit_fi(1, kon, iim, jjm+1, airefi2, airefi)286 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi) 260 287 ELSE 261 288 … … 288 315 status = nf_get_vara_real(ncidp, varidt, start, count, t2) 289 316 #endif 290 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, t2, t)317 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t) 291 318 292 319 ! **** Flux pour la convection (Tiedtk) … … 298 325 status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2) 299 326 #endif 300 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, mfu2, mfu)327 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu) 301 328 302 329 ! mfd … … 306 333 status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2) 307 334 #endif 308 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, mfd2, mfd)335 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd) 309 336 310 337 ! en_u … … 314 341 status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2) 315 342 #endif 316 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, en_u2, en_u)343 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u) 317 344 318 345 ! de_u … … 322 349 status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2) 323 350 #endif 324 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, de_u2, de_u)351 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u) 325 352 326 353 ! en_d … … 330 357 status = nf_get_vara_real(ncidp, varidend, start, count, en_d2) 331 358 #endif 332 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, en_d2, en_d)359 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d) 333 360 334 361 ! de_d … … 338 365 status = nf_get_vara_real(ncidp, varidded, start, count, de_d2) 339 366 #endif 340 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, de_d2, de_d)367 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d) 341 368 342 369 ! **** Coefficient de mellange turbulent … … 349 376 status = nf_get_vara_real(ncidp, varidch, start, count, coefh2) 350 377 #endif 351 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, coefh2, coefh)378 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh) 352 379 ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ ') 353 380 ! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ ') … … 362 389 status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2) 363 390 #endif 364 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, fm_therm2, fm_therm)391 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm) 365 392 PRINT *, 'LECTURE de en_therm a irec =', irec 366 393 #ifdef NC_DOUBLE … … 369 396 status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2) 370 397 #endif 371 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, en_therm2, en_therm)398 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm) 372 399 373 400 ! **** Coefficients de lessivage … … 379 406 status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2) 380 407 #endif 381 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, frac_impa2, frac_impa)408 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa) 382 409 383 410 ! frac_nucl … … 388 415 status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2) 389 416 #endif 390 CALL gr_ecrit_fi(kev, kon, iim, jjm+1, frac_nucl2, frac_nucl)417 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl) 391 418 392 419 ! **** Vents aux sol ******************************************** … … 404 431 status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12) 405 432 #endif 406 CALL gr_ecrit_fi(1, kon, iim, jjm+1, pyu12, pyu1)433 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1) 407 434 408 435 ! pyv1 … … 413 440 status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12) 414 441 #endif 415 CALL gr_ecrit_fi(1, kon, iim, jjm+1, pyv12, pyv1)442 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1) 416 443 417 444 ! **** Temerature au sol ******************************************** … … 423 450 status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12) 424 451 #endif 425 CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol12, ftsol1)452 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1) 426 453 427 454 ! ftsol2 … … 432 459 status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22) 433 460 #endif 434 CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol22, ftsol2)461 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2) 435 462 436 463 ! ftsol3 … … 441 468 status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32) 442 469 #endif 443 CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol32, ftsol3)470 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3) 444 471 445 472 ! ftsol4 … … 449 476 status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42) 450 477 #endif 451 CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol42, ftsol4)478 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4) 452 479 453 480 ! **** Nature sol ******************************************** … … 459 486 #endif 460 487 ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC') 461 CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf12, psrf1)488 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1) 462 489 463 490 ! psrf2 … … 468 495 #endif 469 496 ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC') 470 CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf22, psrf2)497 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2) 471 498 472 499 ! psrf3 … … 476 503 status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32) 477 504 #endif 478 CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf32, psrf3)505 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3) 479 506 480 507 ! psrf4 … … 484 511 status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42) 485 512 #endif 486 CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf42, psrf4)513 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4) 487 514 488 515 DO i = 1, kon
Note: See TracChangeset
for help on using the changeset viewer.