Changeset 1707 for LMDZ5/branches/testing/libf/phylmd/phyaqua.F
- Timestamp:
- Jan 11, 2013, 10:19:19 AM (11 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/phyaqua.F (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 1670-1692,1694-1703,1705-1706
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/phyaqua.F
r1530 r1707 16 16 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 17 17 18 use comgeomphy 19 use dimphy 18 use comgeomphy, only : rlatd,rlond 19 use dimphy, only : klon 20 20 use surface_data, only : type_ocean,ok_veget 21 21 use pbl_surface_mod, only : pbl_surface_init 22 22 USE fonte_neige_mod, only : fonte_neige_init 23 23 use phys_state_var_mod 24 use control_mod 25 24 use control_mod, only : dayref,nday,iphysiq 26 25 27 26 USE IOIPSL … … 35 34 #include "dimsoil.h" 36 35 #include "indicesol.h" 37 38 integer nlon,iflag_phys 36 #include "temps.h" 37 38 integer,intent(in) :: nlon,iflag_phys 39 39 cIM ajout latfi, lonfi 40 REAL, DIMENSION (nlon) :: lonfi, latfi 40 real,intent(in) :: lonfi(nlon),latfi(nlon) 41 41 42 INTEGER type_profil,type_aqua 42 43 … … 71 72 ! integer demih_pas 72 73 73 integer day_ini74 75 74 CHARACTER*80 ans,file_forctl, file_fordat, file_start 76 75 character*100 file,var … … 88 87 REAL phy_flic(nlon,360) 89 88 90 integer, save:: read_climoz ! read ozone climatology89 integer, save:: read_climoz=0 ! read ozone climatology 91 90 92 91 … … 131 130 type_aqua=iflag_phys/100 132 131 type_profil=iflag_phys-type_aqua*100 133 print*,'type_aqua, type_profil',type_aqua, type_profil 134 135 if (klon.ne.nlon) stop'probleme de dimensions dans iniaqua' 132 print*,'iniaqua:type_aqua, type_profil',type_aqua, type_profil 133 134 if (klon.ne.nlon) then 135 write(*,*)"iniaqua: klon=",klon," nlon=",nlon 136 stop'probleme de dimensions dans iniaqua' 137 endif 136 138 call phys_state_var_init(read_climoz) 137 139 … … 154 156 155 157 day_ini=dayref 158 day_end=day_ini+nday 156 159 airefi=1. 157 160 zcufi=1. … … 171 174 radsol=0. 172 175 qsol_f=10. 173 CALL getin('albedo',albedo) 176 ! CALL getin('albedo',albedo) ! albedo is set below, depending on type_aqua 174 177 alb_ocean=.true. 175 178 CALL getin('alb_ocean',alb_ocean) … … 180 183 qsol(:) = qsol_f 181 184 rugsrel = 0.0 ! (rugsrel = rugoro) 185 rugoro = 0.0 186 u_ancien = 0.0 187 v_ancien = 0.0 182 188 agesno = 50.0 183 189 ! Relief plat … … 308 314 . evap, frugs, agesno, tsoil) 309 315 310 print*,' avant phyredem dans iniaqua'316 print*,'iniaqua: before phyredem' 311 317 312 318 falb1=albedo … … 329 335 CALL phyredem ("startphy.nc") 330 336 331 print*,' apresphyredem'337 print*,'iniaqua: after phyredem' 332 338 call phys_state_var_end 333 339 … … 450 456 RETURN 451 457 END 458 459 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 460 452 461 subroutine writelim 453 462 s (klon,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice, 454 463 s phy_fter,phy_foce,phy_flic,phy_fsic) 455 464 c 465 use mod_phys_lmdz_para, only: is_mpi_root,is_omp_root 466 use mod_grid_phy_lmdz, only : klon_glo 467 use mod_phys_lmdz_transfert_para, only : gather 456 468 !#include "dimensions.h" 457 469 !#include "dimphy.h" 458 470 #include "netcdf.inc" 459 471 460 integer klon 461 REAL phy_nat(klon,360) 462 REAL phy_alb(klon,360) 463 REAL phy_sst(klon,360) 464 REAL phy_bil(klon,360) 465 REAL phy_rug(klon,360) 466 REAL phy_ice(klon,360) 467 REAL phy_fter(klon,360) 468 REAL phy_foce(klon,360) 469 REAL phy_flic(klon,360) 470 REAL phy_fsic(klon,360) 471 472 integer,intent(in) :: klon 473 real,intent(in) :: phy_nat(klon,360) 474 real,intent(in) :: phy_alb(klon,360) 475 real,intent(in) :: phy_sst(klon,360) 476 real,intent(in) :: phy_bil(klon,360) 477 real,intent(in) :: phy_rug(klon,360) 478 real,intent(in) :: phy_ice(klon,360) 479 real,intent(in) :: phy_fter(klon,360) 480 real,intent(in) :: phy_foce(klon,360) 481 real,intent(in) :: phy_flic(klon,360) 482 real,intent(in) :: phy_fsic(klon,360) 483 484 real :: phy_glo(klon_glo,360) ! temporary variable, to store phy_***(:) 485 ! on the whole physics grid 472 486 INTEGER ierr 473 487 INTEGER dimfirst(3) … … 480 494 INTEGER id_FTER,id_FOCE,id_FSIC,id_FLIC 481 495 482 PRINT*, 'Ecriture du fichier limit' 483 c 484 ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid) 485 c 486 ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30, 496 if (is_mpi_root.and.is_omp_root) then 497 498 PRINT*, 'writelim: Ecriture du fichier limit' 499 c 500 ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid) 501 c 502 ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30, 487 503 . "Fichier conditions aux limites") 488 ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim) 489 ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim) 490 c 491 dims(1) = ndim 492 dims(2) = ntim 504 !! ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim) 505 ierr = NF_DEF_DIM (nid, "points_physiques", klon_glo, ndim) 506 ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim) 507 c 508 dims(1) = ndim 509 dims(2) = ntim 493 510 c 494 511 ccc ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim) 495 ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)496 ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,512 ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim) 513 ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17, 497 514 . "Jour dans l annee") 498 515 ccc ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT) 499 ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)500 ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,516 ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT) 517 ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23, 501 518 . "Nature du sol (0,1,2,3)") 502 519 ccc ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST) 503 ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)504 ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,520 ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST) 521 ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35, 505 522 . "Temperature superficielle de la mer") 506 523 ccc ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS) 507 ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)508 ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,524 ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS) 525 ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32, 509 526 . "Reference flux de chaleur au sol") 510 527 ccc ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB) 511 ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)512 ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,528 ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB) 529 ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19, 513 530 . "Albedo a la surface") 514 531 ccc ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG) 515 ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)516 ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,532 ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG) 533 ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8, 517 534 . "Rugosite") 518 535 519 ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER) 520 ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 8,"Frac. Terre") 521 ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE) 522 ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 8,"Frac. Terre") 523 ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC) 524 ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 8,"Frac. Terre") 525 ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC) 526 ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 8,"Frac. Terre") 527 c 528 ierr = NF_ENDDEF(nid) 529 c 530 DO k = 1, 360 531 c 532 debut(1) = 1 533 debut(2) = k 534 epais(1) = klon 535 epais(2) = 1 536 c 537 print*,'Instant ',k 538 #ifdef NC_DOUBLE 539 print*,'NC DOUBLE' 540 ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k)) 541 ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k)) 542 ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k)) 543 ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k)) 544 ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k)) 545 ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k)) 546 ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais,phy_fter(1,k)) 547 ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais,phy_foce(1,k)) 548 ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais,phy_fsic(1,k)) 549 ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais,phy_flic(1,k)) 550 #else 551 print*,'NC PAS DOUBLE' 552 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k)) 553 ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k)) 554 ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k)) 555 ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k)) 556 ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k)) 557 ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k)) 558 ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais,phy_fter(1,k)) 559 ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais,phy_foce(1,k)) 560 ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais,phy_fsic(1,k)) 561 ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais,phy_flic(1,k)) 562 563 #endif 564 c 565 ENDDO 566 c 567 ierr = NF_CLOSE(nid) 568 c 569 return 536 ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER) 537 ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 8,"Frac. Terre") 538 ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE) 539 ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 8,"Frac. Terre") 540 ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC) 541 ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 8,"Frac. Terre") 542 ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC) 543 ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 8,"Frac. Terre") 544 c 545 ierr = NF_ENDDEF(nid) 546 c 547 548 ! write the 'times' 549 do k=1,360 550 #ifdef NC_DOUBLE 551 ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k)) 552 #else 553 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k)) 554 #endif 555 enddo 556 557 endif ! of if (is_mpi_root.and.is_omp_root) 558 559 ! write the fields, after having collected them on master 560 561 call gather(phy_nat,phy_glo) 562 if (is_mpi_root.and.is_omp_root) then 563 #ifdef NC_DOUBLE 564 ierr=NF_PUT_VAR_DOUBLE(nid,id_NAT,phy_glo) 565 #else 566 ierr=NF_PUT_VAR_REAL(nid,id_NAT,phy_glo) 567 #endif 568 if(ierr.ne.NF_NOERR) then 569 write(*,*) "writelim error with phy_nat" 570 write(*,*) NF_STRERROR(ierr) 571 endif 572 endif 573 574 call gather(phy_sst,phy_glo) 575 if (is_mpi_root.and.is_omp_root) then 576 #ifdef NC_DOUBLE 577 ierr=NF_PUT_VAR_DOUBLE(nid,id_SST,phy_glo) 578 #else 579 ierr=NF_PUT_VAR_REAL(nid,id_SST,phy_glo) 580 #endif 581 if(ierr.ne.NF_NOERR) then 582 write(*,*) "writelim error with phy_sst" 583 write(*,*) NF_STRERROR(ierr) 584 endif 585 endif 586 587 call gather(phy_bil,phy_glo) 588 if (is_mpi_root.and.is_omp_root) then 589 #ifdef NC_DOUBLE 590 ierr=NF_PUT_VAR_DOUBLE(nid,id_BILS,phy_glo) 591 #else 592 ierr=NF_PUT_VAR_REAL(nid,id_BILS,phy_glo) 593 #endif 594 if(ierr.ne.NF_NOERR) then 595 write(*,*) "writelim error with phy_bil" 596 write(*,*) NF_STRERROR(ierr) 597 endif 598 endif 599 600 call gather(phy_alb,phy_glo) 601 if (is_mpi_root.and.is_omp_root) then 602 #ifdef NC_DOUBLE 603 ierr=NF_PUT_VAR_DOUBLE(nid,id_ALB,phy_glo) 604 #else 605 ierr=NF_PUT_VAR_REAL(nid,id_ALB,phy_glo) 606 #endif 607 if(ierr.ne.NF_NOERR) then 608 write(*,*) "writelim error with phy_alb" 609 write(*,*) NF_STRERROR(ierr) 610 endif 611 endif 612 613 call gather(phy_rug,phy_glo) 614 if (is_mpi_root.and.is_omp_root) then 615 #ifdef NC_DOUBLE 616 ierr=NF_PUT_VAR_DOUBLE(nid,id_RUG,phy_glo) 617 #else 618 ierr=NF_PUT_VAR_REAL(nid,id_RUG,phy_glo) 619 #endif 620 if(ierr.ne.NF_NOERR) then 621 write(*,*) "writelim error with phy_rug" 622 write(*,*) NF_STRERROR(ierr) 623 endif 624 endif 625 626 call gather(phy_fter,phy_glo) 627 if (is_mpi_root.and.is_omp_root) then 628 #ifdef NC_DOUBLE 629 ierr=NF_PUT_VAR_DOUBLE(nid,id_FTER,phy_glo) 630 #else 631 ierr=NF_PUT_VAR_REAL(nid,id_FTER,phy_glo) 632 #endif 633 if(ierr.ne.NF_NOERR) then 634 write(*,*) "writelim error with phy_fter" 635 write(*,*) NF_STRERROR(ierr) 636 endif 637 endif 638 639 call gather(phy_foce,phy_glo) 640 if (is_mpi_root.and.is_omp_root) then 641 #ifdef NC_DOUBLE 642 ierr=NF_PUT_VAR_DOUBLE(nid,id_FOCE,phy_glo) 643 #else 644 ierr=NF_PUT_VAR_REAL(nid,id_FOCE,phy_glo) 645 #endif 646 if(ierr.ne.NF_NOERR) then 647 write(*,*) "writelim error with phy_foce" 648 write(*,*) NF_STRERROR(ierr) 649 endif 650 endif 651 652 call gather(phy_fsic,phy_glo) 653 if (is_mpi_root.and.is_omp_root) then 654 #ifdef NC_DOUBLE 655 ierr=NF_PUT_VAR_DOUBLE(nid,id_FSIC,phy_glo) 656 #else 657 ierr=NF_PUT_VAR_REAL(nid,id_FSIC,phy_glo) 658 #endif 659 if(ierr.ne.NF_NOERR) then 660 write(*,*) "writelim error with phy_fsic" 661 write(*,*) NF_STRERROR(ierr) 662 endif 663 endif 664 665 call gather(phy_flic,phy_glo) 666 if (is_mpi_root.and.is_omp_root) then 667 #ifdef NC_DOUBLE 668 ierr=NF_PUT_VAR_DOUBLE(nid,id_FLIC,phy_glo) 669 #else 670 ierr=NF_PUT_VAR_REAL(nid,id_FLIC,phy_glo) 671 #endif 672 if(ierr.ne.NF_NOERR) then 673 write(*,*) "writelim error with phy_flic" 674 write(*,*) NF_STRERROR(ierr) 675 endif 676 endif 677 678 ! close file: 679 if (is_mpi_root.and.is_omp_root) then 680 ierr = NF_CLOSE(nid) 681 endif 682 570 683 end 684 685 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 571 686 572 687 SUBROUTINE profil_sst(nlon, rlatd, type_profil, phy_sst)
Note: See TracChangeset
for help on using the changeset viewer.
