Changeset 2336 for trunk/LMDZ.GENERIC
- Timestamp:
- Jun 5, 2020, 9:44:36 AM (5 years ago)
- Location:
- trunk/LMDZ.GENERIC
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.GENERIC/README
r2309 r2336 1576 1576 == 05/05/2020 (r2308) == JVO 1577 1577 Fix a nasty copy-paste bug from r2297 in n-layer aerosol scheme 1578 1579 == 05/06/2020 == EM 1580 Update start2archive/newstart programs to handle recently introduced 1581 non-orographic GW variables in (re-)start files. -
trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/lect_start_archive.F
r1478 r2336 3 3 & t,ucov,vcov,ps,h,phisold_newgrid, 4 4 & q,qsurf,surfith,nid, 5 & rnat,pctsrf_sic,tslab,tsea_ice,sea_ice )6 7 ! USE surfdat_h 5 & rnat,pctsrf_sic,tslab,tsea_ice,sea_ice, 6 & du_nonoro_gwd,dv_nonoro_gwd,east_gwstress,west_gwstress) 7 8 8 USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat 9 9 USE tracer_h, ONLY: igcm_co2_ice 10 10 USE infotrac, ONLY: tname, nqtot 11 11 USE slab_ice_h, ONLY: noceanmx 12 ! USE control_mod13 ! to use 'getin'14 12 USE callkeys_mod, ONLY: ok_slab_ocean 15 13 USE comvert_mod, ONLY: ap,bp,aps,bps,preff … … 18 16 c======================================================================= 19 17 c 20 c 21 c Auteur: 05/1997 , 12/2003 : coord hybride FF 22 c ------ 23 c 24 c 25 c Objet: Lecture des variables d'un fichier "start_archive" 26 c Plus besoin de régler ancienne valeurs grace 27 c a l'allocation dynamique de memoire (Yann Wanherdrick) 28 c 29 c 18 c Routine to load variables from the "start_archive.nc" file 30 19 c 31 20 c======================================================================= … … 33 22 implicit none 34 23 35 #include "dimensions.h" 36 !#include "dimphys.h" 37 !#include "planete.h" 38 #include "paramet.h" 39 #include "comgeom2.h" 40 !#include "control.h" 41 #include "netcdf.inc" 42 !#include"advtrac.h" 24 include "dimensions.h" 25 include "paramet.h" 26 include "comgeom2.h" 27 include "netcdf.inc" 28 43 29 c======================================================================= 44 30 c Declarations … … 62 48 CHARACTER*2 str2 63 49 64 ! REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions 65 66 ! REAL dimlast(4) ! tableau contenant les derniers elements des dimensions 67 68 ! REAL dimcycl(4) ! tableau contenant les periodes des dimensions 69 ! CHARACTER*120 dimsource 70 ! CHARACTER*16 dimname 71 ! CHARACTER*80 dimtitle 72 ! CHARACTER*40 dimunits 73 ! INTEGER dimtype 74 75 ! INTEGER dimord(4) ! tableau contenant l''ordre 76 ! data dimord /1,2,3,4/ ! de sortie des dimensions 77 78 ! INTEGER vardim(4) 79 REAL date 50 REAL,INTENT(OUT) :: date 80 51 INTEGER memo 81 52 ! character (len=50) :: tmpname … … 83 54 c Variable histoire 84 55 c------------------ 85 REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants 86 REAL h(iip1,jjp1,llm),ps(iip1,jjp1) 87 REAL q(iip1,jjp1,llm,nqtot),qtot(iip1,jjp1,llm) 88 89 c autre variables dynamique nouvelle grille 90 c------------------------------------------ 91 92 c!-*- 93 ! integer klatdat,klongdat 94 ! PARAMETER (klatdat=180,klongdat=360) 56 REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants 57 REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1) 58 REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) 95 59 96 60 c Physique sur grille scalaire … … 99 63 c variable physique 100 64 c------------------ 101 REAL tsurf(ngrid) ! surface temperature102 REAL tsoil(ngrid,nsoilmx) ! soil temperature65 REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature 66 REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature 103 67 REAL co2ice(ngrid) ! CO2 ice layer 104 REAL emis(ngrid)105 REAL q2(ngrid,llm+1),qsurf(ngrid,nqtot)106 REAL tslab(ngrid,noceanmx)107 REAL rnat(ngrid),pctsrf_sic(ngrid)108 REAL tsea_ice(ngrid),sea_ice(ngrid)68 REAL,INTENT(OUT) :: emis(ngrid) 69 REAL,INTENT(OUT) :: q2(ngrid,llm+1),qsurf(ngrid,nqtot) 70 REAL,INTENT(OUT) :: tslab(ngrid,noceanmx) 71 REAL ,INTENT(OUT) ::rnat(ngrid),pctsrf_sic(ngrid) 72 REAL,INTENT(OUT) :: tsea_ice(ngrid),sea_ice(ngrid) 109 73 c REAL phisfi(ngrid) 74 REAL,INTENT(OUT):: du_nonoro_gwd(ngrid,llm) 75 REAL,INTENT(OUT):: dv_nonoro_gwd(ngrid,llm) 76 REAL,INTENT(OUT):: east_gwstress(ngrid,llm) 77 REAL,INTENT(OUT):: west_gwstress(ngrid,llm) 110 78 111 79 INTEGER i,j,l 112 INTEGER nid,nvarid 80 INTEGER,INTENT(IN) :: nid 81 INTEGER :: nvarid 113 82 c REAL year_day,periheli,aphelie,peri_day 114 83 c REAL obliquit,z0,emin_turb,lmixmin … … 122 91 c------------------------------------------------------ 123 92 real us(iip1,jjp1,llm),vs(iip1,jjp1,llm) 124 REAL phisold_newgrid(iip1,jjp1)125 REAL t(iip1,jjp1,llm)93 REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1) 94 REAL,INTENT(OUT) :: t(iip1,jjp1,llm) 126 95 real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx) 127 96 real inertiedatS(iip1,jjp1,nsoilmx) … … 132 101 real pctsrf_sicS(iip1,jjp1),tsea_iceS(iip1,jjp1) 133 102 real rnatS(iip1,jjp1), sea_iceS(iip1,jjp1) 103 real du_nonoro_gwdS(iip1,jjp1,llm),dv_nonoro_gwdS(iip1,jjp1,llm) 104 real east_gwstressS(iip1,jjp1,llm),west_gwstressS(iip1,jjp1,llm) 134 105 135 106 real ptotal, co2icetotal … … 163 134 real, dimension(:,:), allocatable :: rnatold,pctsrf_sicold 164 135 real, dimension(:,:), allocatable :: tsea_iceold,sea_iceold 165 136 real,allocatable :: du_nonoro_gwdold(:,:,:) 137 real,allocatable :: dv_nonoro_gwdold(:,:,:) 138 real,allocatable :: east_gwstressold(:,:,:) 139 real,allocatable :: west_gwstressold(:,:,:) 166 140 167 141 real tab_cntrl(100) … … 181 155 real, dimension(:), allocatable :: newval 182 156 183 real surfith(iip1,jjp1) ! surface thermal inertia157 real,intent(out) :: surfith(iip1,jjp1) ! surface thermal inertia 184 158 ! surface thermal inertia at old horizontal grid resolution 185 159 real, dimension(:,:), allocatable :: surfithold … … 319 293 allocate(sea_iceold(imold+1,jmold+1)) 320 294 295 allocate(du_nonoro_gwdold(imold+1,jmold+1,lmold)) 296 allocate(dv_nonoro_gwdold(imold+1,jmold+1,lmold)) 297 allocate(east_gwstressold(imold+1,jmold+1,lmold)) 298 allocate(west_gwstressold(imold+1,jmold+1,lmold)) 299 321 300 allocate(var (imold+1,jmold+1,llm)) 322 301 allocate(varp1 (imold+1,jmold+1,llm+1)) 323 302 324 write(*,*) ' q2',ngrid,llm+1325 write(*,*) ' q2S',iip1,jjp1,llm+1326 write(*,*) ' q2old',imold+1,jmold+1,lmold+1303 write(*,*) 'lect_start_archive: q2',ngrid,llm+1 304 write(*,*) 'lect_start_archive: q2S',iip1,jjp1,llm+1 305 write(*,*) 'lect_start_archive: q2old',imold+1,jmold+1,lmold+1 327 306 328 307 !----------------------------------------------------------------------- … … 337 316 ierr = NF_INQ_VARID (nid, "controle", nvarid) 338 317 IF (ierr .NE. NF_NOERR) THEN 339 PRINT*, "Lect_start_archive: champ <controle> est absent"318 PRINT*, "Lect_start_archive: champ <controle> not found" 340 319 CALL abort 341 320 ENDIF … … 358 337 ierr = NF_INQ_VARID (nid, "rlonv", nvarid) 359 338 IF (ierr .NE. NF_NOERR) THEN 360 PRINT*, "lect_start_archive: Le champ <rlonv> est absent"339 PRINT*, "lect_start_archive: Field <rlonv> not found" 361 340 CALL abort 362 341 ENDIF … … 367 346 #endif 368 347 IF (ierr .NE. NF_NOERR) THEN 369 PRINT*, "lect_start_archive: Lecture echouee pour<rlonv>"348 PRINT*, "lect_start_archive: Failed loading <rlonv>" 370 349 CALL abort 371 350 ENDIF … … 373 352 ierr = NF_INQ_VARID (nid, "rlatu", nvarid) 374 353 IF (ierr .NE. NF_NOERR) THEN 375 PRINT*, "lect_start_archive: Le champ <rlatu> est absent"354 PRINT*, "lect_start_archive: Field <rlatu> not found" 376 355 CALL abort 377 356 ENDIF … … 382 361 #endif 383 362 IF (ierr .NE. NF_NOERR) THEN 384 PRINT*, "lect_start_archive: Lecture echouee pour<rlatu>"363 PRINT*, "lect_start_archive: Failed loading <rlatu>" 385 364 CALL abort 386 365 ENDIF … … 388 367 ierr = NF_INQ_VARID (nid, "rlonu", nvarid) 389 368 IF (ierr .NE. NF_NOERR) THEN 390 PRINT*, "lect_start_archive: Le champ <rlonu> est absent"369 PRINT*, "lect_start_archive: Field <rlonu> not found" 391 370 CALL abort 392 371 ENDIF … … 397 376 #endif 398 377 IF (ierr .NE. NF_NOERR) THEN 399 PRINT*, "lect_start_archive: Lecture echouee pour<rlonu>"378 PRINT*, "lect_start_archive: Failed loading <rlonu>" 400 379 CALL abort 401 380 ENDIF … … 403 382 ierr = NF_INQ_VARID (nid, "rlatv", nvarid) 404 383 IF (ierr .NE. NF_NOERR) THEN 405 PRINT*, "lect_start_archive: Le champ <rlatv> est absent"384 PRINT*, "lect_start_archive: Field <rlatv> not found" 406 385 CALL abort 407 386 ENDIF … … 412 391 #endif 413 392 IF (ierr .NE. NF_NOERR) THEN 414 PRINT*, "lect_start_archive: Lecture echouee pour<rlatv>"393 PRINT*, "lect_start_archive: Failed loading <rlatv>" 415 394 CALL abort 416 395 ENDIF … … 423 402 ierr = NF_INQ_VARID (nid, "aps", nvarid) 424 403 IF (ierr .NE. NF_NOERR) THEN 425 PRINT*, "lect_start_archive: Le champ <aps> est absent"404 PRINT*, "lect_start_archive: Field <aps> not found" 426 405 apsold=0 427 406 PRINT*, "<aps> set to 0" … … 433 412 #endif 434 413 IF (ierr .NE. NF_NOERR) THEN 435 PRINT*, "lect_start_archive: Lecture echouee pour<aps>"414 PRINT*, "lect_start_archive: Failed loading <aps>" 436 415 ENDIF 437 416 ENDIF … … 439 418 ierr = NF_INQ_VARID (nid, "bps", nvarid) 440 419 IF (ierr .NE. NF_NOERR) THEN 441 PRINT*, "lect_start_archive: Le champ <bps> est absent"420 PRINT*, "lect_start_archive: Field <bps> not found" 442 421 PRINT*, "It must be an old start_archive, lets look for sig_s" 443 422 ierr = NF_INQ_VARID (nid, "sig_s", nvarid) … … 453 432 #endif 454 433 IF (ierr .NE. NF_NOERR) THEN 455 PRINT*, "lect_start_archive: Lecture echouee pour<bps>"434 PRINT*, "lect_start_archive: Failed loading <bps>" 456 435 CALL abort 457 436 END IF … … 542 521 ierr = NF_INQ_VARID (nid, "phisinit", nvarid) 543 522 IF (ierr .NE. NF_NOERR) THEN 544 PRINT*, "lect_start_archive: Le champ <phisinit> est absent"523 PRINT*, "lect_start_archive: Field <phisinit> not found" 545 524 CALL abort 546 525 ENDIF … … 551 530 #endif 552 531 IF (ierr .NE. NF_NOERR) THEN 553 PRINT*, "lect_start_archive: Lecture echouee pour<phisinit>"532 PRINT*, "lect_start_archive: Failed loading <phisinit>" 554 533 CALL abort 555 534 ENDIF … … 571 550 ierr = NF_INQ_DIMID (nid, "temps", nvarid) 572 551 IF (ierr .NE. NF_NOERR) THEN 573 PRINT*, "lect_start_archive: Le champ <Time> est absent"552 PRINT*, "lect_start_archive: Field <Time> not found" 574 553 CALL abort 575 554 endif … … 586 565 #endif 587 566 IF (ierr .NE. NF_NOERR) THEN 588 PRINT*, "lect_start_archive: Lecture echouee pour<Time>"567 PRINT*, "lect_start_archive: Failed loading <Time>" 589 568 CALL abort 590 569 ENDIF … … 592 571 write(*,*) 593 572 write(*,*) 594 write(*,*) ' Differentes dates des etats initiaux stockes:'595 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '573 write(*,*) 'Available dates for the stored initial conditions:' 574 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 596 575 pi=2.*ASIN(1.) 597 576 do i=1,timelen 598 577 c call solarlong(timelist(i),sollong(i)) 599 578 c sollong(i) = sollong(i)*180./pi 600 write(*,*) ' etat initial au jour martien' ,int(timelist(i))579 write(*,*) 'initial state for day ' ,int(timelist(i)) 601 580 c write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)), 602 581 c . sollong(i) … … 606 585 607 586 write(*,*) 608 write(*,*) 'Choi x de ladate'587 write(*,*) 'Choice for the date' 609 588 123 read(*,*,iostat=ierr) date 610 589 if(ierr.ne.0) goto 123 … … 619 598 write(*,*) 620 599 write(*,*) 621 write(*,*) 'He alors... Y sait pas lire !?!'600 write(*,*) "Wrong value... can't you read !?!" 622 601 write(*,*) 623 write(*,*) ' Differentes dates des etats initiaux stockes:'624 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '602 write(*,*) 'Available dates for the stored initial conditions:' 603 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 625 604 do i=1,timelen 626 write(*,*) ' etat initial au jour martien' ,nint(timelist(i))605 write(*,*) 'initial state for day ' ,nint(timelist(i)) 627 606 c write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)) 628 607 end do … … 642 621 count=(/imold+1,jmold+1,1,0/) 643 622 644 ! CO2ice is now in qsurf(igcm_co2_ice) ...645 ! ierr = NF_INQ_VARID (nid, "co2ice", nvarid)646 ! IF (ierr .NE. NF_NOERR) THEN647 ! PRINT*, "lect_start_archive: Le champ <co2ice> est absent"648 ! CALL abort649 ! ENDIF650 !#ifdef NC_DOUBLE651 ! ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)652 !#else653 ! ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)654 !#endif655 ! IF (ierr .NE. NF_NOERR) THEN656 ! PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"657 ! PRINT*, NF_STRERROR(ierr)658 ! CALL abort659 ! ENDIF660 c661 623 ierr = NF_INQ_VARID (nid, "emis", nvarid) 662 624 IF (ierr .NE. NF_NOERR) THEN 663 PRINT*, "lect_start_archive: Le champ <emis> est absent"625 PRINT*, "lect_start_archive: Field <emis> not found" 664 626 CALL abort 665 627 ENDIF … … 670 632 #endif 671 633 IF (ierr .NE. NF_NOERR) THEN 672 PRINT*, "lect_start_archive: Lecture echouee pour<emis>"634 PRINT*, "lect_start_archive: Failed loading <emis>" 673 635 CALL abort 674 636 ENDIF … … 676 638 ierr = NF_INQ_VARID (nid, "ps", nvarid) 677 639 IF (ierr .NE. NF_NOERR) THEN 678 PRINT*, "lect_start_archive: Le champ <ps> est absent"640 PRINT*, "lect_start_archive: Field <ps> not found" 679 641 CALL abort 680 642 ENDIF … … 685 647 #endif 686 648 IF (ierr .NE. NF_NOERR) THEN 687 PRINT*, "lect_start_archive: Lecture echouee pour<ps>"649 PRINT*, "lect_start_archive: Failed loading <ps>" 688 650 CALL abort 689 651 ENDIF … … 691 653 ierr = NF_INQ_VARID (nid, "tsurf", nvarid) 692 654 IF (ierr .NE. NF_NOERR) THEN 693 PRINT*, "lect_start_archive: Le champ <tsurf> est absent"655 PRINT*, "lect_start_archive: Field <tsurf> not found" 694 656 CALL abort 695 657 ENDIF … … 700 662 #endif 701 663 IF (ierr .NE. NF_NOERR) THEN 702 PRINT*, "lect_start_archive: Lecture echouee pour<tsurf>"664 PRINT*, "lect_start_archive: Failed loading <tsurf>" 703 665 CALL abort 704 666 ENDIF … … 706 668 ierr = NF_INQ_VARID (nid, "q2surf", nvarid) 707 669 IF (ierr .NE. NF_NOERR) THEN 708 PRINT*, "lect_start_archive: Le champ <q2surf> est absent"670 PRINT*, "lect_start_archive: Field <q2surf> not found" 709 671 CALL abort 710 672 ENDIF … … 715 677 #endif 716 678 IF (ierr .NE. NF_NOERR) THEN 717 PRINT*, "lect_start_archive: Lecture echouee pour<q2surf>"679 PRINT*, "lect_start_archive: Failed loading <q2surf>" 718 680 CALL abort 719 681 ENDIF … … 734 696 #endif 735 697 IF (ierr .NE. NF_NOERR) THEN 736 PRINT*, "lect_start_archive: Lecture echouee pour<tslab>"698 PRINT*, "lect_start_archive: Failed loading <tslab>" 737 699 ENDIF 738 700 … … 744 706 ierr = NF_INQ_VARID (nid, "rnat", nvarid) 745 707 IF (ierr .NE. NF_NOERR) THEN 746 PRINT*, "lect_start_archive: Le champ <rnat> est absent"708 PRINT*, "lect_start_archive: Field <rnat> not found" 747 709 ENDIF 748 710 #ifdef NC_DOUBLE … … 752 714 #endif 753 715 IF (ierr .NE. NF_NOERR) THEN 754 PRINT*, "lect_start_archive: Lecture echouee pour<rnat>"716 PRINT*, "lect_start_archive: Failed loading <rnat>" 755 717 ENDIF 756 718 c 757 719 ierr = NF_INQ_VARID (nid, "pctsrf_sic", nvarid) 758 720 IF (ierr .NE. NF_NOERR) THEN 759 PRINT*, "lect_start_archive: Le champ <pctsrf_sic> est absent"721 PRINT*, "lect_start_archive: Field <pctsrf_sic> not found" 760 722 ENDIF 761 723 #ifdef NC_DOUBLE … … 765 727 #endif 766 728 IF (ierr .NE. NF_NOERR) THEN 767 PRINT*, "lect_start_archive: Lecture echouee pour<pctsrf_sic>"729 PRINT*, "lect_start_archive: Failed loading <pctsrf_sic>" 768 730 ENDIF 769 731 c 770 732 ierr = NF_INQ_VARID (nid, "tsea_ice", nvarid) 771 733 IF (ierr .NE. NF_NOERR) THEN 772 PRINT*, "lect_start_archive: Le champ <tsea_ice> est absent"734 PRINT*, "lect_start_archive: Field <tsea_ice> not found" 773 735 ENDIF 774 736 #ifdef NC_DOUBLE … … 778 740 #endif 779 741 IF (ierr .NE. NF_NOERR) THEN 780 PRINT*, "lect_start_archive: Lecture echouee pour<tsea_ice>"742 PRINT*, "lect_start_archive: Failed loading <tsea_ice>" 781 743 ENDIF 782 744 c 783 745 ierr = NF_INQ_VARID (nid, "sea_ice", nvarid) 784 746 IF (ierr .NE. NF_NOERR) THEN 785 PRINT*, "lect_start_archive: Le champ <sea_ice> est absent"747 PRINT*, "lect_start_archive: Field <sea_ice> not found" 786 748 ENDIF 787 749 #ifdef NC_DOUBLE … … 791 753 #endif 792 754 IF (ierr .NE. NF_NOERR) THEN 793 PRINT*, "lect_start_archive: Lecture echouee pour<sea_ice>"755 PRINT*, "lect_start_archive: Failed loading <sea_ice>" 794 756 ENDIF 795 757 … … 801 763 802 764 ! Surface tracers: 803 do iq=1,nqtot 804 ! initialize all surface tracers to zero 805 call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq)) 806 enddo 807 808 809 ! print*,'tname=',tname 810 ! print*,'nid',nid 811 ! print*,'nvarid',nvarid 812 ! stop 765 ! initialize all surface tracers to zero 766 qsurfold(1:imold+1,1:jmold+1,1:nqtot)=0 813 767 814 768 DO iq=1,nqtot … … 843 797 & " Failed loading <",trim(txt),">" 844 798 write (*,*) trim(txt),' is set to 0' 845 ! call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))846 799 ENDIF 847 800 … … 905 858 endif ! of if (olddepthdef) 906 859 907 !908 ! Read soil thermal inertias909 !910 ! if (.not.olddepthdef) then ! no thermal inertia data in "old" archives911 ! ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)912 ! if (ierr.ne.NF_NOERR) then913 ! write(*,*)"lect_start_archive: Cannot find <inertiedat>"914 ! call abort915 ! else916 !#ifdef NC_DOUBLE917 ! ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)918 !#else919 ! ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)920 !#endif921 ! endif ! of if (ierr.ne.NF_NOERR)922 ! endif923 924 860 c----------------------------------------------------------------------- 925 861 c 5.3 Lecture des champs 3D (t,u,v, q2atm,q) … … 932 868 ierr = NF_INQ_VARID (nid,"temp", nvarid) 933 869 IF (ierr .NE. NF_NOERR) THEN 934 PRINT*, "lect_start_archive: Le champ <temp> est absent"870 PRINT*, "lect_start_archive: Field <temp> not found" 935 871 CALL abort 936 872 ENDIF … … 941 877 #endif 942 878 IF (ierr .NE. NF_NOERR) THEN 943 PRINT*, "lect_start_archive: Lecture echouee pour<temp>"879 PRINT*, "lect_start_archive: Failed loading <temp>" 944 880 CALL abort 945 881 ENDIF … … 947 883 ierr = NF_INQ_VARID (nid,"u", nvarid) 948 884 IF (ierr .NE. NF_NOERR) THEN 949 PRINT*, "lect_start_archive: Le champ <u> est absent"885 PRINT*, "lect_start_archive: Field <u> not found" 950 886 CALL abort 951 887 ENDIF … … 956 892 #endif 957 893 IF (ierr .NE. NF_NOERR) THEN 958 PRINT*, "lect_start_archive: Lecture echouee pour<u>"894 PRINT*, "lect_start_archive: Failed loading <u>" 959 895 CALL abort 960 896 ENDIF … … 962 898 ierr = NF_INQ_VARID (nid,"v", nvarid) 963 899 IF (ierr .NE. NF_NOERR) THEN 964 PRINT*, "lect_start_archive: Le champ <v> est absent"900 PRINT*, "lect_start_archive: Field <v> not found" 965 901 CALL abort 966 902 ENDIF … … 971 907 #endif 972 908 IF (ierr .NE. NF_NOERR) THEN 973 PRINT*, "lect_start_archive: Lecture echouee pour<v>"909 PRINT*, "lect_start_archive: Failed loading <v>" 974 910 CALL abort 975 911 ENDIF … … 977 913 ierr = NF_INQ_VARID (nid,"q2atm", nvarid) 978 914 IF (ierr .NE. NF_NOERR) THEN 979 PRINT*, "lect_start_archive: Le champ <q2atm> est absent"915 PRINT*, "lect_start_archive: Field <q2atm> not found" 980 916 CALL abort 981 917 ENDIF … … 986 922 #endif 987 923 IF (ierr .NE. NF_NOERR) THEN 988 PRINT*, "lect_start_archive: Lecture echouee pour<q2atm>"924 PRINT*, "lect_start_archive: Failed loading <q2atm>" 989 925 CALL abort 990 926 ENDIF … … 992 928 993 929 ! Tracers: 994 do iq=1,nqtot 995 call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) ) 996 enddo 930 qold(1:imold+1,1:jmold+1,1:lmold,1:nqtot)=0. 997 931 998 932 DO iq=1,nqtot … … 1025 959 ENDDO ! of DO iq=1,nqtot 1026 960 961 ! Non-orographic GWs: 962 write(*,*)"lect_start_archive: loading du_nonoro_gwd" 963 ierr = NF_INQ_VARID (nid,"du_nonoro_gwd", nvarid) 964 IF (ierr .NE. NF_NOERR) THEN 965 PRINT*, "lect_start_archive: Field <du_nonoro_gwd> not found" 966 PRINT*, "Setting it to zero" 967 du_nonoro_gwdold(:,:,:)=0 968 ENDIF 969 #ifdef NC_DOUBLE 970 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,du_nonoro_gwdold) 971 #else 972 ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,du_nonoro_gwdold) 973 #endif 974 IF (ierr .NE. NF_NOERR) THEN 975 PRINT*, "lect_start_archive: Failed loading <du_nonoro_gwd>" 976 CALL abort 977 ENDIF 978 979 write(*,*)"lect_start_archive: loading dv_nonoro_gwd" 980 ierr = NF_INQ_VARID (nid,"dv_nonoro_gwd", nvarid) 981 IF (ierr .NE. NF_NOERR) THEN 982 PRINT*, "lect_start_archive: Field <dv_nonoro_gwd> not found" 983 PRINT*, "Setting it to zero" 984 dv_nonoro_gwdold(:,:,:)=0 985 ENDIF 986 #ifdef NC_DOUBLE 987 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,dv_nonoro_gwdold) 988 #else 989 ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,dv_nonoro_gwdold) 990 #endif 991 IF (ierr .NE. NF_NOERR) THEN 992 PRINT*, "lect_start_archive: Failed loading <dv_nonoro_gwd>" 993 CALL abort 994 ENDIF 995 996 write(*,*)"lect_start_archive: loading east_gwstress" 997 ierr = NF_INQ_VARID (nid,"east_gwstress", nvarid) 998 IF (ierr .NE. NF_NOERR) THEN 999 PRINT*, "lect_start_archive: Field <east_gwstress> not found" 1000 PRINT*, "Setting it to zero" 1001 east_gwstressold(:,:,:)=0 1002 ENDIF 1003 #ifdef NC_DOUBLE 1004 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,east_gwstressold) 1005 #else 1006 ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,east_gwstressold) 1007 #endif 1008 IF (ierr .NE. NF_NOERR) THEN 1009 PRINT*, "lect_start_archive: Failed loading <east_gwstress>" 1010 CALL abort 1011 ENDIF 1012 1013 write(*,*)"lect_start_archive: loading west_gwstress" 1014 ierr = NF_INQ_VARID (nid,"west_gwstress", nvarid) 1015 IF (ierr .NE. NF_NOERR) THEN 1016 PRINT*, "lect_start_archive: Field <west_gwstress> not found" 1017 PRINT*, "Setting it to zero" 1018 west_gwstressold(:,:,:)=0 1019 ENDIF 1020 #ifdef NC_DOUBLE 1021 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,west_gwstressold) 1022 #else 1023 ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,west_gwstressold) 1024 #endif 1025 IF (ierr .NE. NF_NOERR) THEN 1026 PRINT*, "lect_start_archive: Failed loading <west_gwstress>" 1027 CALL abort 1028 ENDIF 1027 1029 1028 1030 !======================================================================= … … 1106 1108 1107 1109 write(*,*) 1108 write(*,*)' Ancienne grille: masse de l atm:',ptotalold1109 write(*,*)'N ouvelle grille: masse de l atm:',ptotal1110 write(*,*)'Old grid: atmospheric mass :',ptotalold 1111 write(*,*)'New grid: atmospheric mass :',ptotal 1110 1112 write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold 1111 1113 write(*,*) 1112 write(*,*)' Ancienne grille: masse de la glace CO2:',co2icetotalold1113 write(*,*)'N ouvelle grille: masse de la glace CO2:',co2icetotal1114 write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold 1115 write(*,*)'New grid: mass of CO2 ice:',co2icetotal 1114 1116 if (co2icetotalold.ne.0.) then 1115 1117 write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold … … 1325 1327 & rlonuold,rlatvold,rlonu,rlatv) 1326 1328 write (*,*) 'lect_start_archive: t ', t(1,jjp1,1) ! INFO 1329 1330 ! Non-orographic GW 1331 call interp_vert 1332 & (du_nonoro_gwdold,var,lmold,llm,apsold,bpsold,aps,bps, 1333 & psold,(imold+1)*(jmold+1)) 1334 call interp_horiz(var,du_nonoro_gwdS,imold,jmold,iim,jjm,llm, 1335 & rlonuold,rlatvold,rlonu,rlatv) 1336 call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,du_nonoro_gwdS,du_nonoro_gwd) 1337 1338 call interp_vert 1339 & (dv_nonoro_gwdold,var,lmold,llm,apsold,bpsold,aps,bps, 1340 & psold,(imold+1)*(jmold+1)) 1341 call interp_horiz(var,dv_nonoro_gwdS,imold,jmold,iim,jjm,llm, 1342 & rlonuold,rlatvold,rlonu,rlatv) 1343 call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,dv_nonoro_gwdS,dv_nonoro_gwd) 1344 1345 call interp_vert 1346 & (east_gwstressold,var,lmold,llm,apsold,bpsold,aps,bps, 1347 & psold,(imold+1)*(jmold+1)) 1348 call interp_horiz(var,east_gwstressS,imold,jmold,iim,jjm,llm, 1349 & rlonuold,rlatvold,rlonu,rlatv) 1350 call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,east_gwstressS,east_gwstress) 1351 1352 call interp_vert 1353 & (west_gwstressold,var,lmold,llm,apsold,bpsold,aps,bps, 1354 & psold,(imold+1)*(jmold+1)) 1355 call interp_horiz(var,west_gwstressS,imold,jmold,iim,jjm,llm, 1356 & rlonuold,rlatvold,rlonu,rlatv) 1357 call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,west_gwstressS,west_gwstress) 1327 1358 1328 1359 c q2 : pbl wind variance … … 1488 1519 deallocate(sea_iceold) 1489 1520 1490 ! write(*,*)'lect_start_archive: END'1491 return1492 1521 end -
trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/newstart.F
r1807 r2336 23 23 USE surfdat_h, ONLY: phisfi, albedodat, 24 24 & zmea, zstd, zsig, zgam, zthe 25 USE nonoro_gwd_ran_mod, ONLY: du_nonoro_gwd, dv_nonoro_gwd, 26 & east_gwstress, west_gwstress 25 27 use datafile_mod, only: datadir, surfdir 26 28 use ioipsl_getin_p_mod, only: getin_p … … 38 40 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 39 41 use tabfi_mod, only: tabfi 42 use dimphy, only: init_dimphy 40 43 use iniphysiq_mod, only: iniphysiq 44 use phys_state_var_mod, only: phys_state_var_init 41 45 use phyetat0_mod, only: phyetat0 42 46 implicit none … … 283 287 call initracer(ngridmx,nqtot,tname) 284 288 285 ! Take care of arrays in common modules 286 ! ALLOCATE ARRAYS in surfdat_h (if not already done, e.g. when using start_archive) 287 IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngridmx)) 288 IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngridmx)) 289 IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngridmx)) 290 IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngridmx)) 291 IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngridmx)) 292 IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngridmx)) 293 IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngridmx)) 289 ! Initialize dimphy module (klon,klev,..) 290 call init_dimphy(ngridmx,llm) 291 ! Allocate saved arrays (as in firstcall of physiq) 292 call phys_state_var_init(nqtot) 294 293 295 294 c----------------------------------------------------------------------- … … 552 551 & t,ucov,vcov,ps,teta,phisold_newgrid,q,qsurf, 553 552 & surfith,nid, 554 & rnat,pctsrf_sic,tslab,tsea_ice,sea_ice) 553 & rnat,pctsrf_sic,tslab,tsea_ice,sea_ice, 554 & du_nonoro_gwd,dv_nonoro_gwd,east_gwstress,west_gwstress) 555 555 write(*,*) "OK, read start_archive file" 556 556 ! copy soil thermal inertia … … 1128 1128 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi) 1129 1129 1130 c$$$ do ig=1,ngridmx1131 c$$$ j=(ig-2)/iim +21132 c$$$ if(ig.eq.1) j=11133 c$$$ if (rlatu(j)*180./pi.gt.80.) then1134 c$$$1135 c$$$ qsurf(ig,igcm_h2o_ice)=1.e51136 c$$$ qsurf(ig,igcm_h2o_vap)=0.0!1.e51137 c$$$1138 c$$$ write(*,*) 'ig=',ig,' H2O ice mass (kg/m2)= ',1139 c$$$ & qsurf(ig,igcm_h2o_ice)1140 c$$$1141 c$$$ write(*,*)' ==> Ice mesh South boundary (deg)= ',1142 c$$$ & rlatv(j)*180./pi1143 c$$$ end if1144 c$$$ enddo1145 1146 1130 c watercaps : H20 ice on permanent southern cap 1147 1131 c ------------------------------------------------- … … 1169 1153 ENDDO 1170 1154 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi) 1171 1172 c$$$ do ig=1,ngridmx1173 c$$$ j=(ig-2)/iim +21174 c$$$ if(ig.eq.1) j=11175 c$$$ if (rlatu(j)*180./pi.lt.-80.) then1176 c$$$ qsurf(ig,igcm_h2o_ice)=1.e51177 c$$$ qsurf(ig,igcm_h2o_vap)=0.0 !1.e51178 c$$$1179 c$$$ write(*,*) 'ig=',ig,' H2O ice mass (kg/m2)= ',1180 c$$$ & qsurf(ig,igcm_h2o_ice)1181 c$$$ write(*,*)' ==> Ice mesh North boundary (deg)= ',1182 c$$$ & rlatv(j-1)*180./pi1183 c$$$ end if1184 c$$$ enddo1185 1155 1186 1156 -
trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/start2archive.F
r1694 r2336 22 22 USE comsoil_h 23 23 24 ! USE comgeomfi_h, ONLY: lati, long, area25 ! use control_mod26 ! use comgeomphy, only: initcomgeomphy27 24 use slab_ice_h, only: noceanmx 28 ! to use 'getin' 29 USE ioipsl_getincom 25 USE ioipsl_getincom, only: getin 30 26 USE planete_mod, only: year_day 31 27 USE mod_const_mpi, ONLY: COMM_LMDZ … … 37 33 USE temps_mod, ONLY: day_ini 38 34 USE iniphysiq_mod, ONLY: iniphysiq 35 use phys_state_var_mod, only: phys_state_var_init 39 36 use phyetat0_mod, only: phyetat0 37 use nonoro_gwd_ran_mod, only: du_nonoro_gwd, dv_nonoro_gwd, 38 & east_gwstress, west_gwstress 40 39 implicit none 41 40 … … 45 44 include "comdissip.h" 46 45 include "comgeom.h" 47 !#include "control.h" 48 49 !#include "dimphys.h" 50 !#include "planete.h" 51 !#include"advtrac.h" 46 52 47 include "netcdf.inc" 53 48 c----------------------------------------------------------------------- … … 111 106 REAL tslabS(ip1jmp1,noceanmx),tsea_iceS(ip1jmp1) 112 107 108 ! For non-orographic GW 109 REAL du_nonoro_gwdS(ip1jmp1,llm),dv_nonoro_gwdS(ip1jmp1,llm) 110 REAL east_gwstressS(ip1jmp1,llm),west_gwstressS(ip1jmp1,llm) 113 111 114 112 c Variables intermediaires : vent naturel, mais pas coord scalaire … … 234 232 Lmodif=0 235 233 234 ! Allocate saved arrays (as in firstcall of physiq) 235 call phys_state_var_init(nqtot) 236 236 237 ! Initialize tracer names, indexes and properties 237 238 CALL initracer(ngridmx,nqtot,tname) … … 357 358 call gr_fi_dyn(noceanmx,ngridmx,iip1,jjp1,tslab,tslabS) 358 359 360 call gr_fi_dyn(llm,ngridmx,iip1,jjp1,du_nonoro_gwd,du_nonoro_gwdS) 361 call gr_fi_dyn(llm,ngridmx,iip1,jjp1,dv_nonoro_gwd,dv_nonoro_gwdS) 362 call gr_fi_dyn(llm,ngridmx,iip1,jjp1,east_gwstress,east_gwstressS) 363 call gr_fi_dyn(llm,ngridmx,iip1,jjp1,west_gwstress,west_gwstressS) 359 364 c======================================================================= 360 365 c Info pour controler … … 370 375 ENDDO 371 376 ENDDO 372 write(*,*)' Ancienne grille : masse de l''atm:',ptotal377 write(*,*)'Old grid: : atmospheric mass :',ptotal 373 378 ! write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal 374 379 … … 519 524 IF(ierr.EQ.0) THEN 520 525 521 522 write(*,*) "Use slab-ocean ?" 523 ok_slab_ocean=.false. ! default value 524 call getin("ok_slab_ocean",ok_slab_ocean) 525 write(*,*) "ok_slab_ocean = ",ok_slab_ocean 526 527 if(ok_slab_ocean) then 528 call write_archive(nid,ntime,'rnat' 529 & ,'rnat','',2,rnatS) 530 call write_archive(nid,ntime,'pctsrf_sic' 531 & ,'pctsrf_sic','',2,pctsrf_sicS) 532 call write_archive(nid,ntime,'sea_ice' 533 & ,'sea_ice','',2,sea_iceS) 534 call write_archive(nid,ntime,'tslab' 535 & ,'tslab','',-2,tslabS) 536 call write_archive(nid,ntime,'tsea_ice' 537 & ,'tsea_ice','',2,tsea_iceS) 538 endif !ok_slab_ocean 539 ENDIF 526 write(*,*) "Use slab-ocean ?" 527 ok_slab_ocean=.false. ! default value 528 call getin("ok_slab_ocean",ok_slab_ocean) 529 write(*,*) "ok_slab_ocean = ",ok_slab_ocean 530 531 if(ok_slab_ocean) then 532 call write_archive(nid,ntime,'rnat' 533 & ,'rnat','',2,rnatS) 534 call write_archive(nid,ntime,'pctsrf_sic' 535 & ,'pctsrf_sic','',2,pctsrf_sicS) 536 call write_archive(nid,ntime,'sea_ice' 537 & ,'sea_ice','',2,sea_iceS) 538 call write_archive(nid,ntime,'tslab' 539 & ,'tslab','',-2,tslabS) 540 call write_archive(nid,ntime,'tsea_ice' 541 & ,'tsea_ice','',2,tsea_iceS) 542 endif !ok_slab_ocean 543 544 ENDIF ! of IF(ierr.EQ.0) 545 546 ! Non-orographic gavity waves 547 call write_archive(nid,ntime,"du_nonoro_gwd", 548 & "Zonal wind tendency due to GW",'m.s-1',3,du_nonoro_gwdS) 549 call write_archive(nid,ntime,"dv_nonoro_gwd", 550 & "Meridional wind tendency due to GW",'m.s-1', 551 & 3,dv_nonoro_gwdS) 552 call write_archive(nid,ntime,"east_gwstress", 553 & "Eastward stress profile due to GW",'kg.m-1.s-2', 554 & 3,east_gwstressS) 555 call write_archive(nid,ntime,"west_gwstress", 556 & "Westward stress profile due to GW",'kg.m-1.s-2', 557 & 3,west_gwstressS) 558 540 559 c----------------------------------------------------------------------- 541 560 c Fin -
trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/write_archive.F
r1478 r2336 37 37 implicit none 38 38 39 #include "dimensions.h"40 #include "paramet.h"41 #include "comgeom.h"42 #include "netcdf.inc"39 include "dimensions.h" 40 include "paramet.h" 41 include "comgeom.h" 42 include "netcdf.inc" 43 43 44 44 c----------------------------------------------------------------------- … … 83 83 84 84 write (*,*) "=====================" 85 write (*,*) " creation de",nom85 write (*,*) "defining ",nom 86 86 call def_var(nid,nom,titre,unite,4,id,varid,ierr) 87 87 … … 113 113 114 114 if (ierr.ne.NF_NOERR) then 115 write(*,*) "***** PUT_VAR matterin write_archive"116 write(*,*) "***** with ", nom," ",nf_STRERROR(ierr)115 write(*,*) "***** PUT_VAR problem in write_archive" 116 write(*,*) "***** with ",trim(nom)," ",nf_STRERROR(ierr) 117 117 call abort 118 118 endif … … 140 140 ! define the variable 141 141 write(*,*)"=====================" 142 write(*,*)"defining ",nom142 write(*,*)"defining variable ",trim(nom) 143 143 call def_var(nid,nom,titre,unite,4,id,varid,ierr) 144 144 … … 182 182 ! define the variable 183 183 write(*,*)"=====================" 184 write(*,*)"defining ",nom184 write(*,*)"defining variable ",trim(nom) 185 185 call def_var(nid,nom,titre,unite,4,id,varid,ierr) 186 186 … … 222 222 223 223 write (*,*) "=====================" 224 write (*,*) " creation de ",nom224 write (*,*) "defining variable ",trim(nom) 225 225 226 226 call def_var(nid,nom,titre,unite,3,id,varid,ierr) … … 243 243 244 244 if (ierr.ne.NF_NOERR) then 245 write(*,*) "***** PUT_VAR matterin write_archive"245 write(*,*) "***** PUT_VAR problem in write_archive" 246 246 write(*,*) "***** with ",nom,nf_STRERROR(ierr) 247 247 call abort … … 264 264 265 265 write (*,*) "=====================" 266 write (*,*) " creation de ",nom266 write (*,*) "defining variable ",trim(nom) 267 267 268 268 call def_var(nid,nom,titre,unite,1,id,varid,ierr) … … 279 279 #endif 280 280 if (ierr.ne.NF_NOERR) then 281 write(*,*) "***** PUT_VAR matterin write_archive"281 write(*,*) "***** PUT_VAR problem in write_archive" 282 282 write(*,*) "***** with ",nom,nf_STRERROR(ierr) 283 283 call abort … … 289 289 endif ! of if (dim.eq.3) else if (dim.eq.-3) .... 290 290 291 return292 291 end 293 292
Note: See TracChangeset
for help on using the changeset viewer.