Changeset 259 for LMDZ.3.3/trunk/libf/dyn3d/startvar.F
- Timestamp:
- Jul 19, 2001, 2:57:21 PM (23 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/trunk/libf/dyn3d/startvar.F
r24 r259 1 C 2 C $Header$ 3 C 1 4 MODULE startvar 2 5 ! … … 10 13 ! 11 14 ! - A 2D variable on the dynamical grid : 12 ! CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex) 13 ! 15 ! CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar ) 14 16 ! 15 17 ! - A 1D variable on the physical grid : 16 ! CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp )18 ! CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar ) 17 19 ! 18 20 ! 19 21 ! - A 3D variable on the dynamical grid : 20 ! CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp )22 ! CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar ) 21 23 ! 22 24 ! … … 57 59 REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: lat_phys, lat_rug, 58 60 . lat_alb, lat_rel, lat_dyn 59 REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: lev _dyn61 REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: levdyn_ini 60 62 REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: relief, zstd, zsig, 61 63 . zgam, zthe, zpic, zval … … 70 72 ! 71 73 SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in, 72 . champ, val_exp )74 . champ, val_exp, jml2, lon_in2, lat_in2 , interbar ) 73 75 ! 74 76 ! There is a big mess with the size in logitude, should it be iml or iml+1. … … 79 81 ! 80 82 CHARACTER*(*), INTENT(in) :: varname 81 INTEGER, INTENT(in) :: iml, jml 83 INTEGER, INTENT(in) :: iml, jml ,jml2 82 84 REAL, INTENT(in) :: lon_in(iml), lat_in(jml) 85 REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) 83 86 REAL, INTENT(inout) :: champ(iml,jml) 84 87 REAL, INTENT(in) :: val_exp 88 LOGICAL interbar 85 89 ! 86 90 ! This routine only works if the variable does not exist or is constant … … 97 101 IF ( .NOT.ALLOCATED(relief)) THEN 98 102 ! 99 CALL start_init_orog( iml, jml, lon_in, lat_in) 103 CALL start_init_orog( iml, jml, lon_in, lat_in, 104 . jml2,lon_in2,lat_in2, interbar ) 100 105 ! 101 106 ENDIF … … 117 122 IF ( .NOT.ALLOCATED(rugo)) THEN 118 123 ! 119 CALL start_init_orog( iml, jml, lon_in, lat_in) 124 CALL start_init_orog( iml, jml, lon_in, lat_in, 125 . jml2,lon_in2,lat_in2 , interbar ) 120 126 ! 121 127 ENDIF … … 137 143 IF ( .NOT.ALLOCATED(masque)) THEN 138 144 ! 139 CALL start_init_orog( iml, jml, lon_in, lat_in) 145 CALL start_init_orog( iml, jml, lon_in, lat_in, 146 . jml2,lon_in2,lat_in2 , interbar ) 140 147 ! 141 148 ENDIF … … 157 164 IF ( .NOT.ALLOCATED(phis)) THEN 158 165 ! 159 CALL start_init_orog( iml, jml, lon_in, lat_in) 166 CALL start_init_orog( iml, jml, lon_in, lat_in, 167 . jml2,lon_in2, lat_in2 , interbar ) 160 168 ! 161 169 ENDIF … … 177 185 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 178 186 ! 179 CALL start_init_dyn( iml, jml, lon_in, lat_in) 187 CALL start_init_dyn( iml, jml, lon_in, lat_in, 188 . jml2,lon_in2, lat_in2 , interbar ) 180 189 ! 181 190 ENDIF … … 231 240 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 232 241 ! 233 SUBROUTINE start_init_orog( iml, jml, lon_in, lat_in) 234 ! 235 INTEGER, INTENT(in) :: iml, jml 242 SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 , 243 , lat_in2 , interbar ) 244 ! 245 INTEGER, INTENT(in) :: iml, jml, jml2 236 246 REAL, INTENT(in) :: lon_in(iml), lat_in(jml) 247 REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) 248 LOGICAL interbar 237 249 ! 238 250 ! LOCAL 239 251 ! 240 REAL :: lev(1), date, dt 252 LOGICAL interbar2 253 REAL :: lev(1), date, dt,chmin,chmax 241 254 INTEGER :: itau(1), fid 242 255 INTEGER :: llm_tmp, ttm_tmp 243 256 INTEGER :: i, j 244 257 INTEGER :: iret 258 CHARACTER*25 title 245 259 REAL, ALLOCATABLE :: relief_hi(:,:) 246 260 REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) 261 REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) 247 262 REAL, ALLOCATABLE :: tmp_var(:,:) 248 263 INTEGER, ALLOCATABLE :: tmp_int(:,:) … … 274 289 ! 275 290 ALLOCATE(lon_rad(iml_rel)) 291 ALLOCATE(lon_ini(iml_rel)) 292 276 293 IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 277 lon_rad(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0 278 ELSE 279 lon_rad(:) = lon_rel(:,1) 280 ENDIF 294 lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0 295 ELSE 296 lon_ini(:) = lon_rel(:,1) 297 ENDIF 298 281 299 ALLOCATE(lat_rad(jml_rel)) 300 ALLOCATE(lat_ini(jml_rel)) 301 282 302 IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 283 lat_rad(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0 284 ELSE 285 lat_rad(:) = lat_rel(1,:) 286 ENDIF 287 ! 288 ! 303 lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0 304 ELSE 305 lat_ini(:) = lat_rel(1,:) 306 ENDIF 307 ! 308 ! 309 310 title='RELIEF' 311 312 interbar2 = .FALSE. 313 CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini, 314 . lon_rad, lat_rad, relief_hi , interbar2 ) 315 289 316 IF ( check ) WRITE(*,*) 'Computes all the parameters needed', 290 317 .' for the gravity wave drag code' … … 337 364 rugo(iml,j) = tmp_var(1,j) 338 365 ENDDO 366 c 367 cc *** rugo n'est pas utilise pour l'instant ****** 339 368 ! 340 369 ! Build land-sea mask … … 348 377 ! 349 378 SUBROUTINE startget_phys1d(varname, iml, jml, lon_in, 350 .lat_in, nbindex, champ, val_exp )379 .lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar) 351 380 ! 352 381 CHARACTER*(*), INTENT(in) :: varname 353 INTEGER, INTENT(in) :: iml, jml, nbindex 382 INTEGER, INTENT(in) :: iml, jml, nbindex, jml2 354 383 REAL, INTENT(in) :: lon_in(iml), lat_in(jml) 384 REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) 355 385 REAL, INTENT(inout) :: champ(nbindex) 356 386 REAL, INTENT(in) :: val_exp 387 LOGICAL interbar 357 388 ! 358 389 ! … … 364 395 CASE ('tsol') 365 396 IF ( .NOT.ALLOCATED(tsol)) THEN 366 CALL start_init_phys( iml, jml, lon_in, lat_in) 397 CALL start_init_phys( iml, jml, lon_in, lat_in, 398 . jml2, lon_in2, lat_in2, interbar ) 367 399 ENDIF 368 400 IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 374 406 CASE ('qsol') 375 407 IF ( .NOT.ALLOCATED(qsol)) THEN 376 CALL start_init_phys( iml, jml, lon_in, lat_in) 408 CALL start_init_phys( iml, jml, lon_in, lat_in, 409 . jml2, lon_in2,lat_in2 , interbar ) 377 410 ENDIF 378 411 IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 384 417 CASE ('psol') 385 418 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 386 CALL start_init_dyn( iml, jml, lon_in, lat_in) 419 CALL start_init_dyn( iml, jml, lon_in, lat_in, 420 . jml2, lon_in2,lat_in2 , interbar ) 387 421 ENDIF 388 422 IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN … … 394 428 CASE ('zmea') 395 429 IF ( .NOT.ALLOCATED(relief)) THEN 396 CALL start_init_orog( iml, jml, lon_in, lat_in) 430 CALL start_init_orog( iml, jml, lon_in, lat_in, 431 . jml2, lon_in2,lat_in2 , interbar ) 397 432 ENDIF 398 433 IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 404 439 CASE ('zstd') 405 440 IF ( .NOT.ALLOCATED(zstd)) THEN 406 CALL start_init_orog( iml, jml, lon_in, lat_in) 441 CALL start_init_orog( iml, jml, lon_in, lat_in, 442 . jml2, lon_in2,lat_in2 , interbar ) 407 443 ENDIF 408 444 IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 414 450 CASE ('zsig') 415 451 IF ( .NOT.ALLOCATED(zsig)) THEN 416 CALL start_init_orog( iml, jml, lon_in, lat_in) 452 CALL start_init_orog( iml, jml, lon_in, lat_in, 453 . jml2, lon_in2,lat_in2 , interbar ) 417 454 ENDIF 418 455 IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 424 461 CASE ('zgam') 425 462 IF ( .NOT.ALLOCATED(zgam)) THEN 426 CALL start_init_orog( iml, jml, lon_in, lat_in) 463 CALL start_init_orog( iml, jml, lon_in, lat_in, 464 . jml2, lon_in2,lat_in2 , interbar ) 427 465 ENDIF 428 466 IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 434 472 CASE ('zthe') 435 473 IF ( .NOT.ALLOCATED(zthe)) THEN 436 CALL start_init_orog( iml, jml, lon_in, lat_in) 474 CALL start_init_orog( iml, jml, lon_in, lat_in, 475 . jml2, lon_in2,lat_in2 , interbar ) 437 476 ENDIF 438 477 IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 444 483 CASE ('zpic') 445 484 IF ( .NOT.ALLOCATED(zpic)) THEN 446 CALL start_init_orog( iml, jml, lon_in, lat_in) 485 CALL start_init_orog( iml, jml, lon_in, lat_in, 486 . jml2, lon_in2,lat_in2 , interbar ) 447 487 ENDIF 448 488 IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 454 494 CASE ('zval') 455 495 IF ( .NOT.ALLOCATED(zval)) THEN 456 CALL start_init_orog( iml, jml, lon_in, lat_in) 496 CALL start_init_orog( iml, jml, lon_in, lat_in, 497 . jml2, lon_in2,lat_in2 , interbar ) 457 498 ENDIF 458 499 IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN … … 462 503 ENDIF 463 504 CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ) 464 505 CASE ('rads') 465 506 champ(:) = 0.0 466 507 CASE ('snow') … … 493 534 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 494 535 ! 495 SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in) 496 ! 497 INTEGER, INTENT(in) :: iml, jml 536 SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2, 537 . lon_in2, lat_in2 , interbar ) 538 ! 539 INTEGER, INTENT(in) :: iml, jml ,jml2 498 540 REAL, INTENT(in) :: lon_in(iml), lat_in(jml) 541 REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) 542 LOGICAL interbar 499 543 ! 500 544 ! LOCAL … … 505 549 INTEGER :: i, j 506 550 ! 551 CHARACTER*25 title 507 552 CHARACTER*120 :: physfname 508 553 LOGICAL :: check=.TRUE. 509 554 ! 510 555 REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) 556 REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) 511 557 REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:) 512 558 ! … … 533 579 ! 534 580 ALLOCATE(lon_rad(iml_phys)) 581 ALLOCATE(lon_ini(iml_phys)) 582 535 583 IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 536 lon_rad(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0 537 ELSE 538 lon_rad(:) = lon_phys(:,1) 539 ENDIF 584 lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0 585 ELSE 586 lon_ini(:) = lon_phys(:,1) 587 ENDIF 588 540 589 ALLOCATE(lat_rad(jml_phys)) 590 ALLOCATE(lat_ini(jml_phys)) 591 541 592 IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 542 lat_rad(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0 543 ELSE 544 lat_rad(:) = lat_phys(1,:) 545 ENDIF 593 lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0 594 ELSE 595 lat_ini(:) = lat_phys(1,:) 596 ENDIF 597 598 546 599 ! 547 600 ! We get the two standard varibales … … 552 605 ! 553 606 ! 607 554 608 CALL flinget(fid_phys, 'ST', iml_phys, jml_phys, 555 609 .llm_tmp, ttm_tmp, 1, 1, var_ana) 556 CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad, 557 . var_ana, iml-1, jml, lon_in, lat_in, tmp_var) 610 611 title='ST' 612 CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, 613 . lon_rad, lat_rad, var_ana , interbar ) 614 615 IF ( interbar ) THEN 616 WRITE(6,*) '-------------------------------------------------', 617 ,'--------------' 618 WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', 619 , ' pour ST $$$ ' 620 WRITE(6,*) '-------------------------------------------------', 621 ,'--------------' 622 CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad , 623 , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var ) 624 ELSE 625 CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad, 626 . var_ana, iml-1, jml, lon_in, lat_in, tmp_var ) 627 ENDIF 628 558 629 CALL gr_int_dyn(tmp_var, tsol, iml-1, jml) 559 630 ! … … 563 634 CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, 564 635 . llm_tmp, ttm_tmp, 1, 1, var_ana) 565 CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad, 566 . var_ana, iml-1, jml, lon_in, lat_in, tmp_var) 567 CALL gr_int_dyn(tmp_var, qsol, iml-1, jml) 568 ! 569 CALL flinclo(fid_phys) 636 637 title='CDSW' 638 CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, 639 . lon_rad, lat_rad, var_ana, interbar ) 640 641 IF ( interbar ) THEN 642 WRITE(6,*) '-------------------------------------------------', 643 ,'--------------' 644 WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', 645 , ' pour CDSW $$$ ' 646 WRITE(6,*) '-------------------------------------------------', 647 ,'--------------' 648 CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad , 649 , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var ) 650 ELSE 651 CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad, 652 . var_ana, iml-1, jml, lon_in, lat_in, tmp_var ) 653 ENDIF 654 c 655 CALL gr_int_dyn(tmp_var, qsol, iml-1, jml) 656 ! 657 CALL flinclo(fid_phys) 570 658 ! 571 659 END SUBROUTINE start_init_phys … … 576 664 ! 577 665 SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in, 578 . lml, pls, workvar, champ, val_exp) 666 . lml, pls, workvar, champ, val_exp,jml2, lon_in2, lat_in2 , 667 , interbar ) 579 668 ! 580 669 ! ARGUMENTS 581 670 ! 582 671 CHARACTER*(*), INTENT(in) :: varname 583 INTEGER, INTENT(in) :: iml, jml, lml 672 INTEGER, INTENT(in) :: iml, jml, lml, jml2 584 673 REAL, INTENT(in) :: lon_in(iml), lat_in(jml) 674 REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) 585 675 REAL, INTENT(in) :: pls(iml, jml, lml) 586 676 REAL, INTENT(in) :: workvar(iml, jml, lml) 587 677 REAL, INTENT(inout) :: champ(iml, jml, lml) 588 678 REAL, INTENT(in) :: val_exp 679 LOGICAL interbar 589 680 ! 590 681 ! LOCAL … … 592 683 INTEGER :: il, ij, ii 593 684 REAL :: xppn, xpps 594 !595 ! C'est vraiment une galere de devoir rajouter tant de commons just pour avoir les aires.596 ! Il faudrait mettre une structure plus flexible et moins dangereuse.597 685 ! 598 686 #include "dimensions.h" … … 609 697 CASE ('u') 610 698 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 611 CALL start_init_dyn( iml, jml, lon_in, lat_in) 699 CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 , 700 . lon_in2,lat_in2 , interbar ) 612 701 ENDIF 613 702 CALL start_inter_3d('U', iml, jml, lml, lon_in, 614 . lat_in, pls, champ)703 . lat_in, jml2, lon_in2, lat_in2, pls, champ,interbar ) 615 704 DO il=1,lml 616 705 DO ij=1,jml … … 623 712 CASE ('v') 624 713 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 625 CALL start_init_dyn( iml, jml, lon_in, lat_in) 714 CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2, 715 . lon_in2, lat_in2 , interbar ) 626 716 ENDIF 627 CALL start_inter_3d('V', iml, jml, lml, lon_in, 628 . lat_in, pls, champ)717 CALL start_inter_3d('V', iml, jml, lml, lon_in, 718 . lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar ) 629 719 DO il=1,lml 630 720 DO ij=1,jml … … 637 727 CASE ('t') 638 728 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 639 CALL start_init_dyn( iml, jml, lon_in, lat_in) 729 CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 , 730 . lon_in2, lat_in2 ,interbar ) 640 731 ENDIF 641 732 CALL start_inter_3d('TEMP', iml, jml, lml, lon_in, 642 . lat_in, pls, champ)733 . lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar ) 643 734 644 735 CASE ('tpot') 645 736 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 646 CALL start_init_dyn( iml, jml, lon_in, lat_in) 737 CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 , 738 . lon_in2, lat_in2 , interbar ) 647 739 ENDIF 648 740 CALL start_inter_3d('TEMP', iml, jml, lml, lon_in, 649 . lat_in, pls, champ)741 . lat_in, jml2, lon_in2, lat_in2, pls, champ, interbar ) 650 742 IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) ) 651 743 . THEN … … 672 764 CASE ('q') 673 765 IF ( .NOT.ALLOCATED(psol_dyn)) THEN 674 CALL start_init_dyn( iml, jml, lon_in, lat_in) 766 CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 , 767 . lon_in2, lat_in2 , interbar ) 675 768 ENDIF 676 769 CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in, 677 . pls, champ)770 . jml2, lon_in2, lat_in2, pls, champ, interbar ) 678 771 IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) ) 679 772 . THEN … … 710 803 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 711 804 ! 712 SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in) 713 ! 714 INTEGER, INTENT(in) :: iml, jml 805 SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 , 806 , lat_in2 , interbar ) 807 ! 808 INTEGER, INTENT(in) :: iml, jml, jml2 715 809 REAL, INTENT(in) :: lon_in(iml), lat_in(jml) 810 REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2) 811 LOGICAL interbar 716 812 ! 717 813 ! LOCAL … … 726 822 ! 727 823 REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) 824 REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) 728 825 REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:) 729 826 REAL, ALLOCATABLE :: xppn(:), xpps(:) 730 827 LOGICAL :: allo 731 828 ! 732 ! Ce n'est pas tres pratique d'avoir a charger 3 include pour avoir la grille du modele733 829 ! 734 830 #include "dimensions.h" 735 831 #include "paramet.h" 736 832 #include "comgeom2.h" 833 834 CHARACTER*25 title 835 737 836 ! 738 837 physfname = 'ECDYN.nc' … … 747 846 ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret) 748 847 ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret) 749 ALLOCATE (lev _dyn(llm_dyn), stat=iret)848 ALLOCATE (levdyn_ini(llm_dyn), stat=iret) 750 849 ! 751 850 CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn, 752 . lon_dyn, lat_dyn, lev _dyn, ttm_dyn,851 . lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, 753 852 . itau, date, dt, fid_dyn) 754 853 ! … … 764 863 DEALLOCATE(lon_rad, stat=iret) 765 864 endif 766 ALLOCATE(lon_rad(iml_dyn), stat=iret) 865 866 ALLOCATE(lon_rad(iml_dyn), stat=iret) 867 ALLOCATE(lon_ini(iml_dyn)) 767 868 768 869 IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 769 lon_rad(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0 770 ELSE 771 lon_rad(:) = lon_dyn(:,1) 772 ENDIF 870 lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0 871 ELSE 872 lon_ini(:) = lon_dyn(:,1) 873 ENDIF 874 773 875 ALLOCATE(lat_rad(jml_dyn)) 876 ALLOCATE(lat_ini(jml_dyn)) 877 774 878 IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 775 lat_rad(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0 776 ELSE 777 lat_rad(:) = lat_dyn(1,:) 778 ENDIF 779 ! 879 lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0 880 ELSE 881 lat_ini(:) = lat_dyn(1,:) 882 ENDIF 883 ! 884 885 780 886 ALLOCATE(z(iml, jml)) 781 887 ALLOCATE(tmp_var(iml-1,jml)) … … 783 889 CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 784 890 . 1, 1, var_ana) 785 CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana, 891 c 892 title='Z' 893 CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini, 894 . lon_rad, lat_rad, var_ana, interbar ) 895 c 896 IF ( interbar ) THEN 897 WRITE(6,*) '-------------------------------------------------', 898 ,'--------------' 899 WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', 900 , ' pour Z $$$ ' 901 WRITE(6,*) '-------------------------------------------------', 902 ,'--------------' 903 CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad , 904 , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var) 905 ELSE 906 CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana, 786 907 . iml-1, jml, lon_in, lat_in, tmp_var) 908 ENDIF 909 787 910 CALL gr_int_dyn(tmp_var, z, iml-1, jml) 788 911 ! … … 791 914 CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 792 915 . 1, 1, var_ana) 793 CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana, 794 . iml-1, jml, lon_in, lat_in, tmp_var) 916 917 title='SP' 918 CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini, 919 . lon_rad, lat_rad, var_ana, interbar ) 920 921 IF ( interbar ) THEN 922 WRITE(6,*) '-------------------------------------------------', 923 ,'--------------' 924 WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', 925 , ' pour SP $$$ ' 926 WRITE(6,*) '-------------------------------------------------', 927 ,'--------------' 928 CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad , 929 , var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var) 930 ELSE 931 CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana, 932 . iml-1, jml, lon_in, lat_in, tmp_var ) 933 ENDIF 934 795 935 CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml) 796 936 ! … … 800 940 ! coming out of the restart file. In case we dor have it we will initialize it. 801 941 ! 802 CALL start_init_phys( iml, jml, lon_in, lat_in) 942 CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2, 943 . lat_in2 , interbar ) 803 944 ELSE 804 945 IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN … … 814 955 ! coming out of the restart file. In case we dor have it we will initialize it. 815 956 ! 816 CALL start_init_orog( iml, jml, lon_in, lat_in) 957 CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 , 958 . lat_in2 , interbar ) 817 959 ! 818 960 ELSE … … 860 1002 ! 861 1003 SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in, 862 . lat_in, pls_in, var3d)1004 . lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar ) 863 1005 ! 864 1006 ! This subroutine gets a variables from a 3D file and does the interpolations needed … … 868 1010 ! 869 1011 CHARACTER*(*) :: varname 870 INTEGER :: iml, jml, lml 1012 INTEGER :: iml, jml, lml, jml2 871 1013 REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml) 1014 REAL :: lon_in2(iml) , lat_in2(jml2) 872 1015 REAL :: var3d(iml, jml, lml) 1016 LOGICAL interbar 1017 real chmin,chmax 873 1018 ! 874 1019 ! LOCAL 875 1020 ! 876 INTEGER :: ii, ij, il 1021 CHARACTER*25 title 1022 INTEGER :: ii, ij, il, jsort,i,j,l 877 1023 REAL :: bx, by 878 1024 REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:) 1025 REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:) 879 1026 REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:) 880 1027 REAL, ALLOCATABLE :: ax(:), ay(:), yder(:) 1028 REAL, ALLOCATABLE :: varrr(:,:,:) 881 1029 INTEGER, ALLOCATABLE :: lind(:) 882 1030 ! … … 886 1034 ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn)) 887 1035 ENDIF 1036 ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn)) 888 1037 ! 889 1038 ! … … 900 1049 ! 901 1050 ALLOCATE(lon_rad(iml_dyn)) 1051 ALLOCATE(lon_ini(iml_dyn)) 1052 902 1053 IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 903 lon_rad(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0 904 ELSE 905 lon_rad(:) = lon_dyn(:,1) 906 ENDIF 1054 lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0 1055 ELSE 1056 lon_ini(:) = lon_dyn(:,1) 1057 ENDIF 1058 907 1059 ALLOCATE(lat_rad(jml_dyn)) 1060 ALLOCATE(lat_ini(jml_dyn)) 1061 1062 ALLOCATE(lev_dyn(llm_dyn)) 1063 908 1064 IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN 909 lat_rad(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0 910 ELSE 911 lat_rad(:) = lat_dyn(1,:) 912 ENDIF 913 ! 1065 lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0 1066 ELSE 1067 lat_ini(:) = lat_dyn(1,:) 1068 ENDIF 1069 ! 1070 1071 CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini, 1072 . lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d , 1073 , interbar ) 1074 914 1075 ALLOCATE(var_tmp2d(iml-1, jml)) 915 1076 ALLOCATE(var_tmp3d(iml, jml, llm_dyn)) … … 919 1080 ALLOCATE(lind(llm_dyn)) 920 1081 ! 1082 921 1083 DO il=1,llm_dyn 922 1084 ! 923 CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad, 924 .var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d) 1085 IF( interbar ) THEN 1086 IF( il.EQ.1 ) THEN 1087 WRITE(6,*) '-------------------------------------------------', 1088 ,'--------------' 1089 WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ', 1090 , ' pour ', varname 1091 WRITE(6,*) '-------------------------------------------------', 1092 ,'--------------' 1093 ENDIF 1094 CALL inter_barxy ( iml_dyn, jml_dyn -1,lon_rad, lat_rad, 1095 , var_ana3d(:,:,il),iml-1, jml2, lon_in2, lat_in2,jml,var_tmp2d ) 1096 ELSE 1097 CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad, 1098 . var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d ) 1099 ENDIF 925 1100 ! 926 1101 CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml) … … 928 1103 ENDDO 929 1104 ! 930 ! IF needed we return the vertical axis. The spline interpolation931 ! Requires the coordinate to be in increasing order.932 !933 IF ( lev_dyn(1) .LT. lev_dyn(llm_dyn)) THEN934 DO il=1,llm_dyn935 lind(il) = il936 ENDDO937 ELSE938 1105 DO il=1,llm_dyn 939 1106 lind(il) = llm_dyn-il+1 940 1107 ENDDO 941 ENDIF 942 ! 1108 ! 1109 c 1110 c ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere 1111 c vers le sol ... 1112 c 943 1113 DO ij=1,jml 944 1114 DO ii=1,iml-1 945 1115 ! 946 ax(:) = lev_dyn(lind(:)) * 1001116 ax(:) = lev_dyn(lind(:)) 947 1117 ay(:) = var_tmp3d(ii, ij, lind(:)) 948 1118 ! 1119 949 1120 CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder) 950 1121 ! … … 959 1130 ENDDO 960 1131 1132 do il=1,lml 1133 call minmax(iml*jml,var3d(1,1,il),chmin,chmax) 1134 SELECTCASE(varname) 1135 CASE('U') 1136 WRITE(*,*) ' U min max l ',il,chmin,chmax 1137 CASE('V') 1138 WRITE(*,*) ' V min max l ',il,chmin,chmax 1139 CASE('TEMP') 1140 WRITE(*,*) ' TEMP min max l ',il,chmin,chmax 1141 CASE('R') 1142 WRITE(*,*) ' R min max l ',il,chmin,chmax 1143 END SELECT 1144 enddo 1145 961 1146 DEALLOCATE(lon_rad) 962 1147 DEALLOCATE(lat_rad)
Note: See TracChangeset
for help on using the changeset viewer.