Changeset 1549
- Timestamp:
- May 6, 2016, 12:30:29 PM (9 years ago)
- Location:
- trunk
- Files:
-
- 6 added
- 17 edited
- 4 moved
-
DOC/chantiers/commit_importants.log (modified) (1 diff)
-
LMDZ.COMMON/libf/dyn3d/gcm.F90 (modified) (1 diff)
-
LMDZ.COMMON/libf/dyn3d/leapfrog.F (modified) (4 diffs)
-
LMDZ.COMMON/libf/dyn3d_common/infotrac.F90 (modified) (9 diffs)
-
LMDZ.COMMON/libf/dyn3dpar/gcm.F (modified) (4 diffs)
-
LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F (modified) (4 diffs)
-
LMDZ.COMMON/libf/dynphy_lonlat/calfis.F (modified) (7 diffs)
-
LMDZ.COMMON/libf/dynphy_lonlat/calfis_p.F (modified) (15 diffs)
-
LMDZ.COMMON/libf/dynphy_lonlat/phytitan/callphysiq_mod.F90 (added)
-
LMDZ.COMMON/libf/dynphy_lonlat/phyvenus/callphysiq_mod.F90 (added)
-
LMDZ.COMMON/libf/misc/wxios.F90 (modified) (1 diff)
-
LMDZ.GENERIC/README (modified) (1 diff)
-
LMDZ.GENERIC/libf/dynphy_lonlat/calfis.F (modified) (2 diffs)
-
LMDZ.GENERIC/libf/dynphy_lonlat/phystd/callphysiq_mod.F90 (added)
-
LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F (modified) (3 diffs)
-
LMDZ.GENERIC/libf/phystd/physiq_mod.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phystd/physiq.F90) (2 diffs)
-
LMDZ.MARS/README (modified) (1 diff)
-
LMDZ.MARS/libf/dynphy_lonlat/calfis.F (modified) (2 diffs)
-
LMDZ.MARS/libf/dynphy_lonlat/phymars/callphysiq_mod.F90 (added)
-
LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F (modified) (3 diffs)
-
LMDZ.MARS/libf/phymars/physiq_mod.F (moved) (moved from trunk/LMDZ.MARS/libf/phymars/physiq.F) (2 diffs)
-
LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F (modified) (3 diffs)
-
LMDZ.TITAN/libf/phytitan/gr_fi_ecrit.F90 (added)
-
LMDZ.TITAN/libf/phytitan/physiq_mod.F (moved) (moved from trunk/LMDZ.TITAN/libf/phytitan/physiq.F) (2 diffs)
-
LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F (modified) (3 diffs)
-
LMDZ.VENUS/libf/phyvenus/gr_fi_ecrit.F90 (added)
-
LMDZ.VENUS/libf/phyvenus/physiq_mod.F (moved) (moved from trunk/LMDZ.VENUS/libf/phyvenus/physiq.F) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/DOC/chantiers/commit_importants.log
r1545 r1549 1730 1730 Also added checking in phyetat0 that the longitude/latitude read in the 1731 1731 restartphy.nc files match the ones provided by the dynamics. 1732 1733 ********************** 1734 **** commit_v1549 **** 1735 ********************** 1736 Ehouarn: Further adaptations to keep up with changes in LMDZ5 concerning 1737 physics/dynamics separation (up to rev r2420 of LMDZ5) 1738 * all physics packages: 1739 - added module callphysiq_mod.F90 in dynphy_lonlat/phy*** which contains 1740 the routine "call_physiq" which is called by calfis* and calls the 1741 physics. This way different "physiq" routine from different physics 1742 packages may be called: The calfis* routines now exposes all available 1743 fields that might be transmitted to physiq but which is actually send 1744 (ie: expected/needed by physiq) is decided in call_physiq. 1745 - turned "physiq.F[90]" into module "physiq_mod.F[90]" for better control 1746 of "physiq" arguments. for phyvenus/phytitan, extracted gr_fi_ecrit from 1747 physiq.F as gr_fi_ecrit.F90 (note that it can only work in serial). 1748 1749 * misc: 1750 - updated wxios.F90 to keep up with LMDZ5 modifications. 1751 1752 * dyn3d_common: 1753 - infotrac.F90 keep up with LMDZ5 modifications (cosmetics) 1754 1755 * dyn3d: 1756 - gcm.F90: cosmetic cleanup. 1757 - leapfrog.F90: fix computation of date as function of itau. 1758 1759 * dyn3dpar: 1760 - gcm.F: cosmetic cleanup. 1761 - leapfrog_p.F90: fix computation of date as function of itau. 1762 NB: physics are given the date corresponding to the end of the 1763 physics step. 1764 1765 * dynphy_lonlat: 1766 - calfis.F : added computation of relative wind vorticity. 1767 - calfis_p.F: added computation of relative wind vorticity (input required 1768 by Earth physics) -
trunk/LMDZ.COMMON/libf/dyn3d/gcm.F90
r1543 r1549 85 85 include "iniprint.h" 86 86 include "tracstoke.h" 87 #ifdef INCA88 ! Only INCA needs these informations (from the Earth's physics)89 !#include "indicesol.h"90 #endif91 92 87 93 88 REAL zdtvr -
trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F
r1508 r1549 298 298 1 CONTINUE ! Matsuno Forward step begins here 299 299 300 c date: (NB: date remains unchanged for Backward step) 301 c ----- 302 300 303 jD_cur = jD_ref + day_ini - day_ref + & 301 & itau/day_step304 & (itau+1)/day_step 302 305 jH_cur = jH_ref + start_time + & 303 & mod(itau ,day_step)/float(day_step)306 & mod(itau+1,day_step)/float(day_step) 304 307 jD_cur = jD_cur + int(jH_cur) 305 308 jH_cur = jH_cur - int(jH_cur) … … 349 352 c----------------------------------------------------------------------- 350 353 351 c date: 354 c date: (NB: only leapfrog step requires recomputing date) 352 355 c ----- 356 357 IF (leapf) THEN 358 jD_cur = jD_ref + day_ini - day_ref + 359 & (itau+1)/day_step 360 jH_cur = jH_ref + start_time + 361 & mod(itau+1,day_step)/float(day_step) 362 jD_cur = jD_cur + int(jH_cur) 363 jH_cur = jH_cur - int(jH_cur) 364 ENDIF 353 365 354 366 … … 516 528 517 529 jD_cur = jD_ref + day_ini - day_ref + & 518 & itau/day_step530 & (itau+1)/day_step 519 531 520 532 IF ((planet_type .eq."generic").or. … … 525 537 526 538 jH_cur = jH_ref + start_time + & 527 & mod(itau,day_step)/float(day_step) 539 & mod(itau+1,day_step)/float(day_step) 540 IF ((planet_type .eq."generic").or. 541 & (planet_type .eq."mars")) THEN 542 jH_cur = jH_ref + start_time + & 543 & mod(itau,day_step)/float(day_step) 544 ENDIF 528 545 jD_cur = jD_cur + int(jH_cur) 529 546 jH_cur = jH_cur - int(jH_cur) -
trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90
r1508 r1549 728 728 729 729 do iq=nqo+1,nqtot 730 write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)730 ! write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq) 731 731 do phase=1,nqo 732 732 do ixt= 1,niso_possibles 733 733 tnom_trac=trim(tnom_0(phase))//'_' 734 734 tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt)) 735 write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac735 ! write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac 736 736 IF (tnom_0(iq) == tnom_trac) then 737 write(lunout,*) 'Ce traceur est un isotope'737 ! write(lunout,*) 'Ce traceur est un isotope' 738 738 nb_iso(ixt,phase)=nb_iso(ixt,phase)+1 739 739 nb_isoind(phase)=nb_isoind(phase)+1 … … 742 742 indnum_fn_num(ixt)=iso_indnum(iq) 743 743 phase_num(iq)=phase 744 write(lunout,*) 'iso_num(iq)=',iso_num(iq)745 write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)746 write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)747 write(lunout,*) 'phase_num(iq)=',phase_num(iq)744 ! write(lunout,*) 'iso_num(iq)=',iso_num(iq) 745 ! write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq) 746 ! write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt) 747 ! write(lunout,*) 'phase_num(iq)=',phase_num(iq) 748 748 goto 20 749 749 else if (iqpere(iq).gt.0) then 750 750 if (tnom_0(iqpere(iq)) == tnom_trac) then 751 write(lunout,*) 'Ce traceur est le fils d''un isotope'751 ! write(lunout,*) 'Ce traceur est le fils d''un isotope' 752 752 ! c'est un traceur d'isotope 753 753 nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1 … … 756 756 zone_num(iq)=nb_traciso(ixt,phase) 757 757 phase_num(iq)=phase 758 write(lunout,*) 'iso_num(iq)=',iso_num(iq)759 write(lunout,*) 'phase_num(iq)=',phase_num(iq)760 write(lunout,*) 'zone_num(iq)=',zone_num(iq)758 ! write(lunout,*) 'iso_num(iq)=',iso_num(iq) 759 ! write(lunout,*) 'phase_num(iq)=',phase_num(iq) 760 ! write(lunout,*) 'zone_num(iq)=',zone_num(iq) 761 761 goto 20 762 762 endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then … … 767 767 enddo !do iq=1,nqtot 768 768 769 write(lunout,*) 'iso_num=',iso_num770 write(lunout,*) 'iso_indnum=',iso_indnum771 write(lunout,*) 'zone_num=',zone_num772 write(lunout,*) 'phase_num=',phase_num773 write(lunout,*) 'indnum_fn_num=',indnum_fn_num769 ! write(lunout,*) 'iso_num=',iso_num 770 ! write(lunout,*) 'iso_indnum=',iso_indnum 771 ! write(lunout,*) 'zone_num=',zone_num 772 ! write(lunout,*) 'phase_num=',phase_num 773 ! write(lunout,*) 'indnum_fn_num=',indnum_fn_num 774 774 775 775 do ixt= 1,niso_possibles … … 824 824 ! dimensions isotopique: 825 825 ntraciso=niso*(ntraceurs_zone+1) 826 WRITE(lunout,*) 'niso=',niso827 WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso826 ! WRITE(lunout,*) 'niso=',niso 827 ! WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso 828 828 829 829 ! flags isotopiques: … … 833 833 ok_isotopes=.false. 834 834 endif 835 WRITE(lunout,*) 'ok_isotopes=',ok_isotopes835 ! WRITE(lunout,*) 'ok_isotopes=',ok_isotopes 836 836 837 837 if (ok_isotopes) then … … 843 843 alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/) 844 844 endif !if (ok_isotopes) then 845 WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif846 WRITE(lunout,*) 'ok_init_iso=',ok_init_iso845 ! WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif 846 ! WRITE(lunout,*) 'ok_init_iso=',ok_init_iso 847 847 848 848 if (ntraceurs_zone.gt.0) then … … 851 851 ok_isotrac=.false. 852 852 endif 853 WRITE(lunout,*) 'ok_isotrac=',ok_isotrac853 ! WRITE(lunout,*) 'ok_isotrac=',ok_isotrac 854 854 855 855 ! remplissage du tableau iqiso(ntraciso,phase) … … 875 875 index_trac(:,:)=0.0 876 876 endif !if (ok_isotrac) then 877 write(lunout,*) 'index_trac=',index_trac877 ! write(lunout,*) 'index_trac=',index_trac 878 878 879 879 ! Finalize : -
trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F
r1543 r1549 28 28 29 29 30 #ifdef INCA31 ! Only INCA needs these informations (from the Earth's physics)32 USE indice_sol_mod33 #endif34 35 30 ! Ehouarn: the following are needed with (parallel) physics: 36 31 #ifdef CPP_PHYS … … 86 81 #include "iniprint.h" 87 82 #include "tracstoke.h" 88 #ifdef INCA89 ! Only INCA needs these informations (from the Earth's physics)90 #include "indicesol.h"91 #endif92 83 93 84 … … 258 249 endif 259 250 #endif 260 c-----------------------------------------------------------------------261 262 IF (type_trac == 'inca') THEN263 #ifdef INCA264 call init_const_lmdz(265 $ nbtr,anneeref,dayref,266 $ iphysiq,day_step,nday,267 $ nbsrf, is_oce,is_sic,268 $ is_ter,is_lic, calend)269 270 call init_inca_para(271 $ iim,jjm+1,llm,klon_glo,mpi_size,272 $ distrib_phys,COMM_LMDZ)273 #endif274 END IF275 276 251 c----------------------------------------------------------------------- 277 252 c Initialisation des traceurs … … 507 482 508 483 c----------------------------------------------------------------------- 509 c Initialisation des dimensions d'INCA :510 c --------------------------------------511 IF (type_trac == 'inca') THEN512 #ifdef INCA513 !$OMP PARALLEL514 CALL init_inca_dim(klon_omp,llm,iim,jjm,515 $ rlonu,rlatu,rlonv,rlatv)516 !$OMP END PARALLEL517 #endif518 END IF519 520 c-----------------------------------------------------------------------521 484 c Initialisation des I/O : 522 485 c ------------------------ -
trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F
r1508 r1549 313 313 1 CONTINUE ! Matsuno Forward step begins here 314 314 315 c date: (NB: date remains unchanged for Backward step) 316 c ----- 317 315 318 jD_cur = jD_ref + day_ini - day_ref + & 316 & itau/day_step319 & (itau+1)/day_step 317 320 jH_cur = jH_ref + start_time + & 318 & mod(itau ,day_step)/float(day_step)321 & mod(itau+1,day_step)/float(day_step) 319 322 if (jH_cur > 1.0 ) then 320 323 jD_cur = jD_cur +1. … … 414 417 c----------------------------------------------------------------------- 415 418 416 c date: 419 c date: (NB: only leapfrog step requires recomputing date) 417 420 c ----- 421 422 IF (leapf) THEN 423 jD_cur = jD_ref + day_ini - day_ref + 424 & (itau+1)/day_step 425 jH_cur = jH_ref + start_time + 426 & mod(itau+1,day_step)/float(day_step) 427 if (jH_cur > 1.0 ) then 428 jD_cur = jD_cur +1. 429 jH_cur = jH_cur -1. 430 endif 431 ENDIF 418 432 419 433 … … 858 872 859 873 jD_cur = jD_ref + day_ini - day_ref 860 $ + itau/day_step874 $ + (itau+1)/day_step 861 875 862 876 IF ((planet_type .eq."generic").or. … … 867 881 868 882 jH_cur = jH_ref + start_time + & 869 & mod(itau,day_step)/float(day_step) 870 ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes) 883 & mod(itau+1,day_step)/float(day_step) 884 IF ((planet_type .eq."generic").or. 885 & (planet_type .eq."mars")) THEN 886 jH_cur = jH_ref + start_time + & 887 & mod(itau,day_step)/float(day_step) 888 ENDIF 871 889 if (jH_cur > 1.0 ) then 872 890 jD_cur = jD_cur +1. -
trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis.F
r1459 r1549 33 33 USE write_field 34 34 USE cpdet_mod, only: t2tpot,tpot2t 35 35 #ifdef CPP_PHYS 36 USE callphysiq_mod, ONLY: call_physiq 37 #endif 38 36 39 ! used only for zonal averages 37 40 USE moyzon_mod … … 145 148 REAL zphi(ngridmx,llm),zphis(ngridmx) 146 149 150 REAL zrot(iip1,jjm,llm) ! AdlC May 2014 147 151 REAL zufi(ngridmx,llm), zvfi(ngridmx,llm) 152 REAL zrfi(ngridmx,llm) ! relative wind vorticity 148 153 REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot) 149 154 ! ADAPTATION GCM POUR CP(T) … … 572 577 573 578 579 C Alvaro de la Camara (May 2014) 580 C 46.1 Calcul de la vorticite et passage sur la grille physique 581 C -------------------------------------------------------------- 582 DO l=1,llm 583 do i=1,iim 584 do j=1,jjm 585 zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l) 586 $ + pucov(i,j+1,l) - pucov(i,j,l)) 587 $ / (cu(i,j)+cu(i,j+1)) 588 $ / (cv(i+1,j)+cv(i,j)) *4 589 enddo 590 enddo 591 ENDDO 592 574 593 c 46.champ v: 575 594 c ----------- … … 584 603 c $ ( pdvcov(i,j-1,l)/cv(i,j-1) + pdvcov(i,j,l)/cv(i,j) ) 585 604 ENDDO 605 zrfi(ig0 + 1,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l) 606 & +zrot(1,j-1,l)+zrot(1,j,l)) 607 DO i=2,iim 608 zrfi(ig0 + i,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l) 609 $ +zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014 610 ENDDO 586 611 ENDDO 587 612 ENDDO … … 613 638 zvfi(1,l) = SSUM(iim,zsin,1)/pi 614 639 ! pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi 615 640 zrfi(1, l) = 0. 616 641 ENDDO 617 642 … … 642 667 zvfi(ngridmx,l) = SSUM(iim,zsin,1)/pi 643 668 ! pcvgv(ngridmx,l) = SSUM(iim,zsinbis,1)/pi 644 669 zrfi(ngridmx, l) = 0. 645 670 ENDDO 646 671 c … … 674 699 lafin_split=lafin.and.isplit==nsplit_phys 675 700 676 if (planet_type.eq."earth") then 677 CALL physiq (ngridmx, 678 . llm, 679 . debut_split, 680 . lafin_split, 681 . jD_cur, 682 . jH_cur_split, 683 . zdt_split, 684 . zplev, 685 . zplay, 686 . zphi, 687 . zphis, 688 . presnivs, 689 . zufi, 690 . zvfi, 691 . ztfi, 692 . zqfi, 693 . flxwfi, 694 . zdufi, 695 . zdvfi, 696 . zdtfi, 697 . zdqfi, 698 . zdpsrf, 699 . pducov) 700 701 else if ( planet_type=="generic" ) then 702 703 CALL physiq (ngridmx, !! ngrid 704 . llm, !! nlayer 705 . nqtot, !! nq 706 . tname, !! tracer names from dynamical core (given in infotrac) 707 . debut_split, !! firstcall 708 . lafin_split, !! lastcall 709 . jD_cur, !! pday. see leapfrog 710 . jH_cur_split, !! ptime "fraction of day" 711 . zdt_split, !! ptimestep 712 . zplev, !! pplev 713 . zplay, !! pplay 714 . zphi, !! pphi 715 . zufi, !! pu 716 . zvfi, !! pv 717 . ztfi, !! pt 718 . zqfi, !! pq 719 . flxwfi, !! pw !! or 0. anyway this is for diagnostic. not used in physiq. 720 . zdufi, !! pdu 721 . zdvfi, !! pdv 722 . zdtfi, !! pdt 723 . zdqfi, !! pdq 724 . zdpsrf, !! pdpsrf 725 . tracerdyn) !! tracerdyn <-- utilite ??? 726 727 else if ( planet_type=="mars" ) then 728 729 CALL physiq (ngridmx, ! ngrid 730 . llm, ! nlayer 731 . nqtot, ! nq 732 . debut_split, ! firstcall 733 . lafin_split, ! lastcall 734 . jD_cur, ! pday 735 . jH_cur_split, ! ptime 736 . zdt_split, ! ptimestep 737 . zplev, ! pplev 738 . zplay, ! pplay 739 . zphi, ! pphi 740 . zufi, ! pu 741 . zvfi, ! pv 742 . ztfi, ! pt 743 . zqfi, ! pq 744 . flxwfi, ! pw 745 . zdufi, ! pdu 746 . zdvfi, ! pdv 747 . zdtfi, ! pdt 748 . zdqfi, ! pdq 749 . zdpsrf, ! pdpsrf 750 . tracerdyn) ! tracerdyn (somewhat obsolete) 751 752 else if ((planet_type=="titan").or.(planet_type=="venus")) then 753 754 CALL physiq (ngridmx, 755 . llm, 756 . nqtot, 757 . debut_split, 758 . lafin_split, 759 . jD_cur, 760 . jH_cur_split, 761 . zdt_split, 762 . zplev, 763 . zplay, 764 . zpk, 765 . zphi, 766 . zphis, 767 . presnivs, 768 . zufi, 769 . zvfi, 770 . ztfi, 771 . zqfi, 772 . flxwfi, 773 . zdufi, 774 . zdvfi, 775 . zdtfi, 776 . zdqfi, 777 . zdpsrf) 778 779 else ! unknown "planet_type" 780 781 write(lunout,*) "calfis_p: error, unknown planet_type: ", 782 & trim(planet_type) 783 stop 784 785 endif ! planet_type 701 CALL call_physiq(ngridmx,llm,nqtot,tname, 702 & debut_split,lafin_split, 703 & jD_cur,jH_cur_split,zdt_split, 704 & zplev,zplay, 705 & zpk,zphi,zphis, 706 & presnivs, 707 & zufi,zvfi,zrfi,ztfi,zqfi, 708 & flxwfi,pducov, 709 & zdufi,zdvfi,zdtfi,zdqfi,zdpsrf, 710 & tracerdyn) 711 712 ! if (planet_type.eq."earth") then 713 ! CALL physiq (ngridmx, 714 ! . llm, 715 ! . debut_split, 716 ! . lafin_split, 717 ! . jD_cur, 718 ! . jH_cur_split, 719 ! . zdt_split, 720 ! . zplev, 721 ! . zplay, 722 ! . zphi, 723 ! . zphis, 724 ! . presnivs, 725 ! . zufi, 726 ! . zvfi, 727 ! . ztfi, 728 ! . zqfi, 729 ! . flxwfi, 730 ! . zdufi, 731 ! . zdvfi, 732 ! . zdtfi, 733 ! . zdqfi, 734 ! . zdpsrf, 735 ! . pducov) 736 ! 737 ! else if ( planet_type=="generic" ) then 738 ! 739 ! CALL physiq (ngridmx, !! ngrid 740 ! . llm, !! nlayer 741 ! . nqtot, !! nq 742 ! . tname, !! tracer names from dynamical core (given in infotrac) 743 ! . debut_split, !! firstcall 744 ! . lafin_split, !! lastcall 745 ! . jD_cur, !! pday. see leapfrog 746 ! . jH_cur_split, !! ptime "fraction of day" 747 ! . zdt_split, !! ptimestep 748 ! . zplev, !! pplev 749 ! . zplay, !! pplay 750 ! . zphi, !! pphi 751 ! . zufi, !! pu 752 ! . zvfi, !! pv 753 ! . ztfi, !! pt 754 ! . zqfi, !! pq 755 ! . flxwfi, !! pw !! or 0. anyway this is for diagnostic. not used in physiq. 756 ! . zdufi, !! pdu 757 ! . zdvfi, !! pdv 758 ! . zdtfi, !! pdt 759 ! . zdqfi, !! pdq 760 ! . zdpsrf, !! pdpsrf 761 ! . tracerdyn) !! tracerdyn <-- utilite ??? 762 ! 763 ! else if ( planet_type=="mars" ) then 764 ! 765 ! CALL physiq (ngridmx, ! ngrid 766 ! . llm, ! nlayer 767 ! . nqtot, ! nq 768 ! . debut_split, ! firstcall 769 ! . lafin_split, ! lastcall 770 ! . jD_cur, ! pday 771 ! . jH_cur_split, ! ptime 772 ! . zdt_split, ! ptimestep 773 ! . zplev, ! pplev 774 ! . zplay, ! pplay 775 ! . zphi, ! pphi 776 ! . zufi, ! pu 777 ! . zvfi, ! pv 778 ! . ztfi, ! pt 779 ! . zqfi, ! pq 780 ! . flxwfi, ! pw 781 ! . zdufi, ! pdu 782 ! . zdvfi, ! pdv 783 ! . zdtfi, ! pdt 784 ! . zdqfi, ! pdq 785 ! . zdpsrf, ! pdpsrf 786 ! . tracerdyn) ! tracerdyn (somewhat obsolete) 787 ! 788 ! else if ((planet_type=="titan").or.(planet_type=="venus")) then 789 ! 790 ! CALL physiq (ngridmx, 791 ! . llm, 792 ! . nqtot, 793 ! . debut_split, 794 ! . lafin_split, 795 ! . jD_cur, 796 ! . jH_cur_split, 797 ! . zdt_split, 798 ! . zplev, 799 ! . zplay, 800 ! . zpk, 801 ! . zphi, 802 ! . zphis, 803 ! . presnivs, 804 ! . zufi, 805 ! . zvfi, 806 ! . ztfi, 807 ! . zqfi, 808 ! . flxwfi, 809 ! . zdufi, 810 ! . zdvfi, 811 ! . zdtfi, 812 ! . zdqfi, 813 ! . zdpsrf) 814 ! 815 ! else ! unknown "planet_type" 816 ! 817 ! write(lunout,*) "calfis_p: error, unknown planet_type: ", 818 ! & trim(planet_type) 819 ! stop 820 ! 821 ! endif ! planet_type 786 822 787 823 zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split -
trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis_p.F
r1543 r1549 36 36 #endif 37 37 #ifdef CPP_PARA 38 USE parallel_lmdz, ONLY : omp_chunk, using_mpi, AllGather_Field 38 USE parallel_lmdz, ONLY: omp_chunk, using_mpi, AllGather_Field, 39 & jjb_u,jje_u,jjb_v,jje_v, 40 & jj_begin_dyn=>jj_begin,jj_end_dyn=>jj_end 39 41 USE Write_Field 40 42 Use Write_field_p … … 49 51 USE comconst_mod, ONLY: daysec,dtvr,dtphys,kappa,cpp,g,rad,pi 50 52 USE logic_mod, ONLY: moyzon_ch,moyzon_mu 53 #ifdef CPP_PHYS 54 USE callphysiq_mod, ONLY: call_physiq 55 #endif 51 56 52 57 IMPLICIT NONE … … 159 164 REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:) 160 165 166 ! REAL zrot(iip1,jjb_v:jje_v,llm) ! AdlC May 2014 167 REAL :: zrot(iip1,jjm,llm) 161 168 REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:) 162 169 REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:) … … 170 177 ! REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:) 171 178 c 172 REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:) 179 REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:), zrfi(:,:) 173 180 REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:) 174 181 REAL,ALLOCATABLE,SAVE :: zdpsrf(:) … … 183 190 REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 184 191 REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:) 192 REAL,ALLOCATABLE,SAVE :: zrfi_omp(:,:) 185 193 REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:) 186 194 REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:) … … 216 224 c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp, 217 225 c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, 218 c$OMP+ z qfi_omp,zdufi_omp,zdvfi_omp,226 c$OMP+ zrfi_omp,zqfi_omp,zdufi_omp,zdvfi_omp, 219 227 c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp, 220 228 c$OMP+ zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp) … … 244 252 integer :: k,kstart,kend 245 253 INTEGER :: offset 254 INTEGER :: jjb,jje 246 255 247 256 LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of … … 294 303 ! ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm)) 295 304 ! ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2)) 296 ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm) )305 ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm),zrfi(klon,llm)) 297 306 ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot)) 298 307 ALLOCATE(zdpsrf(klon)) … … 610 619 c$OMP END DO NOWAIT 611 620 612 c 46.champ v: 621 c 622 C Alvaro de la Camara (May 2014) 623 C 46.1 Calcul de la vorticite et passage sur la grille physique 624 C -------------------------------------------------------------- 625 626 jjb=jj_begin_dyn-1 627 jje=jj_end_dyn+1 628 if (is_north_pole) jjb=1 629 if (is_south_pole) jje=jjm 630 631 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 632 633 DO l=1,llm 634 do i=1,iim 635 do j=jjb,jje 636 zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l) 637 $ + pucov(i,j+1,l) - pucov(i,j,l)) 638 $ / (cu(i,j)+cu(i,j+1)) 639 $ / (cv(i+1,j)+cv(i,j)) *4 640 enddo 641 enddo 642 ENDDO 643 644 645 c 46.2champ v: 613 646 c ----------- 614 647 … … 623 656 $ + pvcov(i,j,l)/cv(i,j) ) 624 657 658 if (j==1 .OR. j==jjp1) then ! AdlC MAY 2014 659 zrfi(ig0,l) = 0 ! AdlC MAY 2014 660 else 661 if(i==1)then 662 zrfi(ig0,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l) 663 $ +zrot(1,j-1,l)+zrot(1,j,l)) ! AdlC MAY 2014 664 else 665 zrfi(ig0,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l) 666 $ +zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014 667 endif 668 endif 669 670 625 671 ENDDO 626 672 ENDDO … … 648 694 zufi(1,l) = SSUM(iim,zcos,1)/pi 649 695 zvfi(1,l) = SSUM(iim,zsin,1)/pi 696 zrfi(1,l) = 0. 650 697 651 698 ENDDO … … 675 722 zufi(klon,l) = SSUM(iim,zcos,1)/pi 676 723 zvfi(klon,l) = SSUM(iim,zsin,1)/pi 724 zrfi(klon,l) = 0. 677 725 ENDDO 678 726 c$OMP END DO NOWAIT … … 706 754 allocate(zufi_omp(klon,llm)) 707 755 allocate(zvfi_omp(klon,llm)) 756 allocate(zrfi_omp(klon,llm)) ! LG Ari 2014 708 757 allocate(ztfi_omp(klon,llm)) 709 758 allocate(zqfi_omp(klon,llm,nqtot)) … … 775 824 do l=1,llm 776 825 do i=1,klon 826 zrfi_omp(i,l)=zrfi(offset+i,l) 827 enddo 828 enddo 829 830 831 do l=1,llm 832 do i=1,klon 777 833 ztfi_omp(i,l)=ztfi(offset+i,l) 778 834 enddo … … 880 936 lafin_split=lafin.and.isplit==nsplit_phys 881 937 882 883 if (planet_type=="earth") then 884 CALL physiq (klon, 885 . llm, 886 . debut_split, 887 . lafin_split, 888 . jD_cur, 889 . jH_cur_split, 890 . zdt_split, 891 . zplev_omp, 892 . zplay_omp, 893 . zphi_omp, 894 . zphis_omp, 895 . presnivs_omp, 896 . zufi_omp, 897 . zvfi_omp, 898 . ztfi_omp, 899 . zqfi_omp, 900 . flxwfi_omp, 901 . zdufi_omp, 902 . zdvfi_omp, 903 . zdtfi_omp, 904 . zdqfi_omp, 905 . zdpsrf_omp, 906 . pducov) 907 908 else if ( planet_type=="generic" ) then 909 910 CALL physiq (klon, !! ngrid 911 . llm, !! nlayer 912 . nqtot, !! nq 913 . tname, !! tracer names from dynamical core (given in infotrac) 914 . debut_split, !! firstcall 915 . lafin_split, !! lastcall 916 . jD_cur, !! pday. see leapfrog_p 917 . jH_cur_split, !! ptime "fraction of day" 918 . zdt_split, !! ptimestep 919 . zplev_omp, !! pplev 920 . zplay_omp, !! pplay 921 . zphi_omp, !! pphi 922 . zufi_omp, !! pu 923 . zvfi_omp, !! pv 924 . ztfi_omp, !! pt 925 . zqfi_omp, !! pq 926 . flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq. 927 . zdufi_omp, !! pdu 928 . zdvfi_omp, !! pdv 929 . zdtfi_omp, !! pdt 930 . zdqfi_omp, !! pdq 931 . zdpsrf_omp, !! pdpsrf 932 . tracerdyn) !! tracerdyn <-- utilite ??? 933 934 else if ( planet_type=="mars" ) then 935 936 CALL physiq (klon, ! ngrid 937 . llm, ! nlayer 938 . nqtot, ! nq 939 . debut_split, ! firstcall 940 . lafin_split, ! lastcall 941 . jD_cur, ! pday 942 . jH_cur_split, ! ptime 943 . zdt_split, ! ptimestep 944 . zplev_omp, ! pplev 945 . zplay_omp, ! pplay 946 . zphi_omp, ! pphi 947 . zufi_omp, ! pu 948 . zvfi_omp, ! pv 949 . ztfi_omp, ! pt 950 . zqfi_omp, ! pq 951 . flxwfi_omp, ! pw 952 . zdufi_omp, ! pdu 953 . zdvfi_omp, ! pdv 954 . zdtfi_omp, ! pdt 955 . zdqfi_omp, ! pdq 956 . zdpsrf_omp, ! pdpsrf 957 . tracerdyn) ! tracerdyn (somewhat obsolete) 958 959 else if ((planet_type=="titan").or.(planet_type=="venus")) then 960 961 CALL physiq (klon, 962 . llm, 963 . nqtot, 964 . debut_split, 965 . lafin_split, 966 . jD_cur, 967 . jH_cur_split, 968 . zdt_split, 969 . zplev_omp, 970 . zplay_omp, 971 . zpk_omp, 972 . zphi_omp, 973 . zphis_omp, 974 . presnivs_omp, 975 . zufi_omp, 976 . zvfi_omp, 977 . ztfi_omp, 978 . zqfi_omp, 979 . flxwfi_omp, 980 . zdufi_omp, 981 . zdvfi_omp, 982 . zdtfi_omp, 983 . zdqfi_omp, 984 . zdpsrf_omp) 985 986 else ! unknown "planet_type" 987 988 write(lunout,*) "calfis_p: error, unknown planet_type: ", 989 & trim(planet_type) 990 stop 991 992 endif ! planet_type 938 CALL call_physiq(klon,llm,nqtot,tname, 939 & debut_split,lafin_split, 940 & jD_cur,jH_cur_split,zdt_split, 941 & zplev_omp,zplay_omp, 942 & zpk_omp,zphi_omp,zphis_omp, 943 & presnivs_omp, 944 & zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp, 945 & flxwfi_omp,pducov, 946 & zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp, 947 & zdpsrf_omp,tracerdyn) 948 949 ! if (planet_type=="earth") then 950 ! CALL physiq (klon, 951 ! . llm, 952 ! . debut_split, 953 ! . lafin_split, 954 ! . jD_cur, 955 ! . jH_cur_split, 956 ! . zdt_split, 957 ! . zplev_omp, 958 ! . zplay_omp, 959 ! . zphi_omp, 960 ! . zphis_omp, 961 ! . presnivs_omp, 962 ! . zufi_omp, 963 ! . zvfi_omp, 964 ! . ztfi_omp, 965 ! . zqfi_omp, 966 ! . flxwfi_omp, 967 ! . zdufi_omp, 968 ! . zdvfi_omp, 969 ! . zdtfi_omp, 970 ! . zdqfi_omp, 971 ! . zdpsrf_omp, 972 ! . pducov) 973 ! 974 ! else if ( planet_type=="generic" ) then 975 ! 976 ! CALL physiq (klon, !! ngrid 977 ! . llm, !! nlayer 978 ! . nqtot, !! nq 979 ! . tname, !! tracer names from dynamical core (given in infotrac) 980 ! . debut_split, !! firstcall 981 ! . lafin_split, !! lastcall 982 ! . jD_cur, !! pday. see leapfrog_p 983 ! . jH_cur_split, !! ptime "fraction of day" 984 ! . zdt_split, !! ptimestep 985 ! . zplev_omp, !! pplev 986 ! . zplay_omp, !! pplay 987 ! . zphi_omp, !! pphi 988 ! . zufi_omp, !! pu 989 ! . zvfi_omp, !! pv 990 ! . ztfi_omp, !! pt 991 ! . zqfi_omp, !! pq 992 ! . flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq. 993 ! . zdufi_omp, !! pdu 994 ! . zdvfi_omp, !! pdv 995 ! . zdtfi_omp, !! pdt 996 ! . zdqfi_omp, !! pdq 997 ! . zdpsrf_omp, !! pdpsrf 998 ! . tracerdyn) !! tracerdyn <-- utilite ??? 999 ! 1000 ! else if ( planet_type=="mars" ) then 1001 ! 1002 ! CALL physiq (klon, ! ngrid 1003 ! . llm, ! nlayer 1004 ! . nqtot, ! nq 1005 ! . debut_split, ! firstcall 1006 ! . lafin_split, ! lastcall 1007 ! . jD_cur, ! pday 1008 ! . jH_cur_split, ! ptime 1009 ! . zdt_split, ! ptimestep 1010 ! . zplev_omp, ! pplev 1011 ! . zplay_omp, ! pplay 1012 ! . zphi_omp, ! pphi 1013 ! . zufi_omp, ! pu 1014 ! . zvfi_omp, ! pv 1015 ! . ztfi_omp, ! pt 1016 ! . zqfi_omp, ! pq 1017 ! . flxwfi_omp, ! pw 1018 ! . zdufi_omp, ! pdu 1019 ! . zdvfi_omp, ! pdv 1020 ! . zdtfi_omp, ! pdt 1021 ! . zdqfi_omp, ! pdq 1022 ! . zdpsrf_omp, ! pdpsrf 1023 ! . tracerdyn) ! tracerdyn (somewhat obsolete) 1024 ! 1025 ! else if ((planet_type=="titan").or.(planet_type=="venus")) then 1026 ! 1027 ! CALL physiq (klon, 1028 ! . llm, 1029 ! . nqtot, 1030 ! . debut_split, 1031 ! . lafin_split, 1032 ! . jD_cur, 1033 ! . jH_cur_split, 1034 ! . zdt_split, 1035 ! . zplev_omp, 1036 ! . zplay_omp, 1037 ! . zpk_omp, 1038 ! . zphi_omp, 1039 ! . zphis_omp, 1040 ! . presnivs_omp, 1041 ! . zufi_omp, 1042 ! . zvfi_omp, 1043 ! . ztfi_omp, 1044 ! . zqfi_omp, 1045 ! . flxwfi_omp, 1046 ! . zdufi_omp, 1047 ! . zdvfi_omp, 1048 ! . zdtfi_omp, 1049 ! . zdqfi_omp, 1050 ! . zdpsrf_omp) 1051 ! 1052 ! else ! unknown "planet_type" 1053 ! 1054 ! write(lunout,*) "calfis_p: error, unknown planet_type: ", 1055 ! & trim(planet_type) 1056 ! stop 1057 ! 1058 ! endif ! planet_type 993 1059 zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split 994 1060 zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split -
trunk/LMDZ.COMMON/libf/misc/wxios.F90
r1508 r1549 191 191 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap") 192 192 IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an' 193 CASE(' earth_366d')193 CASE('gregorian') 194 194 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian") 195 195 IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien' -
trunk/LMDZ.GENERIC/README
r1546 r1549 1215 1215 mass flux should be on the physics grid, not the dynamics grid. 1216 1216 Moreover values at the poles needed to be correctly recomputed. 1217 1218 == 06/05/2016 == EM 1219 - turn physiq.F90 into module physiq_mod.F90 -
trunk/LMDZ.GENERIC/libf/dynphy_lonlat/calfis.F
r1546 r1549 9 9 USE comvert_mod, ONLY: preff 10 10 USE comconst_mod, ONLY: dtphys,kappa,cpp,pi 11 USE physiq_mod, ONLY: physiq 12 11 13 IMPLICIT NONE 12 14 c======================================================================= … … 130 132 131 133 EXTERNAL gr_dyn_fi,gr_fi_dyn 132 EXTERNAL physiq,multipl133 134 REAL SSUM 134 135 EXTERNAL SSUM -
trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F
r1543 r1549 32 32 use mod_interface_dyn_phys, only: init_interface_dyn_phys 33 33 use inifis_mod, only: inifis 34 use physiq_mod, only: physiq 34 35 implicit none 35 36 … … 96 97 REAL du(llm),dv(llm),dtemp(llm) 97 98 REAL dudyn(llm),dvdyn(llm),dtempdyn(llm) 98 REAL dpsurf 99 REAL dpsurf(1) 99 100 REAL,ALLOCATABLE :: dq(:,:) 100 101 REAL,ALLOCATABLE :: dqdyn(:,:) … … 949 950 c ---------------------------------------------------------- 950 951 951 psurf=psurf+dtphys*dpsurf ! evolution de la pression de surface952 psurf=psurf+dtphys*dpsurf(1) ! evolution de la pression de surface 952 953 DO ilevel=1,nlevel 953 954 plev(ilevel)=ap(ilevel)+psurf*bp(ilevel) -
trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90
r1548 r1549 1 module physiq_mod 2 3 implicit none 4 5 contains 6 1 7 subroutine physiq(ngrid,nlayer,nq, & 2 8 nametrac, & … … 2132 2138 2133 2139 end subroutine physiq 2140 2141 end module physiq_mod -
trunk/LMDZ.MARS/README
r1547 r1549 2287 2287 Moreover values at the poles needed to be correctly recomputed. 2288 2288 2289 == 06/05/2016 == EM 2290 - turn physiq.F into module physiq_mod.F -
trunk/LMDZ.MARS/libf/dynphy_lonlat/calfis.F
r1547 r1549 9 9 USE comvert_mod, ONLY: preff 10 10 USE comconst_mod, ONLY: dtphys,cpp,kappa,pi 11 USE physiq_mod, ONLY: physiq 11 12 12 13 IMPLICIT NONE … … 128 129 129 130 EXTERNAL gr_dyn_fi,gr_fi_dyn 130 EXTERNAL physiq,multipl131 131 REAL SSUM 132 132 EXTERNAL SSUM -
trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F
r1543 r1549 27 27 use mod_interface_dyn_phys, only: init_interface_dyn_phys 28 28 USE phys_state_var_init_mod, ONLY: phys_state_var_init 29 USE physiq_mod, ONLY: physiq 29 30 IMPLICIT NONE 30 31 … … 95 96 REAL du(nlayer),dv(nlayer),dtemp(nlayer) 96 97 REAL dudyn(nlayer),dvdyn(nlayer),dtempdyn(nlayer) 97 REAL dpsurf 98 REAL dpsurf(1) 98 99 REAL,ALLOCATABLE :: dq(:,:) 99 100 REAL,ALLOCATABLE :: dqdyn(:,:) … … 792 793 c ---------------------------------------------------------- 793 794 794 psurf=psurf+dtphys*dpsurf ! surface pressure change795 psurf=psurf+dtphys*dpsurf(1) ! surface pressure change 795 796 DO ilevel=1,nlevel 796 797 plev(ilevel)=ap(ilevel)+psurf*bp(ilevel) -
trunk/LMDZ.MARS/libf/phymars/physiq_mod.F
r1548 r1549 1 MODULE physiq_mod 2 3 IMPLICIT NONE 4 5 CONTAINS 6 1 7 SUBROUTINE physiq( 2 8 $ ngrid,nlayer,nq … … 2639 2645 2640 2646 icount=icount+1 2641 RETURN 2642 END 2647 2648 END SUBROUTINE physiq 2649 2650 END MODULE physiq_mod -
trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F
r1548 r1549 13 13 USE iniphysiq_mod, ONLY: iniphysiq 14 14 USE mod_const_mpi, ONLY: comm_lmdz 15 USE physiq_mod, ONLY: physiq 15 16 IMPLICIT NONE 16 17 … … 67 68 REAL du(llm),dv(llm),dtemp(llm) 68 69 REAL dudyn(llm),dvdyn(llm),dtempdyn(llm) 69 REAL dpsurf 70 REAL dpsurf(1) 70 71 REAL,allocatable :: dq(:,:) 71 72 … … 439 440 c ---------------------------------------------------------- 440 441 441 psurf=psurf+dtphys*dpsurf ! evolution de la pression de surface442 psurf=psurf+dtphys*dpsurf(1) ! evolution de la pression de surface 442 443 DO ilevel=1,nlevel 443 444 plev(ilevel)=ap(ilevel)+psurf*bp(ilevel) -
trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F
r1548 r1549 1 1 ! 2 ! $ Header: /home/cvsroot/LMDZ4/libf/phylmd/physiq.F,v 1.8 2005/02/24 09:58:18 fairhead Exp$2 ! $Id: $ 3 3 ! 4 c 4 MODULE physiq_mod 5 6 IMPLICIT NONE 7 8 CONTAINS 9 5 10 SUBROUTINE physiq (nlon,nlev,nqmax, 6 11 . debut,lafin,rjourvrai,gmtime,pdtphys, … … 1622 1627 ENDIF 1623 1628 1624 RETURN 1625 END 1626 1627 1628 1629 *********************************************************************** 1630 *********************************************************************** 1631 *********************************************************************** 1632 *********************************************************************** 1633 *********************************************************************** 1634 *********************************************************************** 1635 *********************************************************************** 1636 *********************************************************************** 1637 1638 SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit) 1639 IMPLICIT none 1640 c 1641 c Tranformer une variable de la grille physique a 1642 c la grille d'ecriture 1643 c 1644 INTEGER nfield,nlon,iim,jjmp1, jjm 1645 REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield) 1646 c 1647 INTEGER i, n, ig 1648 c 1649 jjm = jjmp1 - 1 1650 DO n = 1, nfield 1651 DO i=1,iim 1652 ecrit(i,n) = fi(1,n) 1653 ecrit(i+jjm*iim,n) = fi(nlon,n) 1654 ENDDO 1655 DO ig = 1, nlon - 2 1656 ecrit(iim+ig,n) = fi(1+ig,n) 1657 ENDDO 1658 ENDDO 1659 RETURN 1660 END 1629 END SUBROUTINE physiq 1630 1631 END MODULE physiq_mod 1632 -
trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F
r1543 r1549 14 14 USE iniphysiq_mod, ONLY: iniphysiq 15 15 USE mod_const_mpi, ONLY: comm_lmdz 16 USE physiq_mod, ONLY: physiq 16 17 IMPLICIT NONE 17 18 … … 68 69 REAL du(llm),dv(llm),dtemp(llm) 69 70 REAL dudyn(llm),dvdyn(llm),dtempdyn(llm) 70 REAL dpsurf 71 REAL dpsurf(1) 71 72 REAL,allocatable :: dq(:,:) 72 73 … … 449 450 c ---------------------------------------------------------- 450 451 451 psurf=psurf+dtphys*dpsurf ! evolution de la pression de surface452 psurf=psurf+dtphys*dpsurf(1) ! evolution de la pression de surface 452 453 DO ilevel=1,nlevel 453 454 plev(ilevel)=ap(ilevel)+psurf*bp(ilevel) -
trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F
r1548 r1549 1 1 ! 2 ! $ Header: /home/cvsroot/LMDZ4/libf/phylmd/physiq.F,v 1.8 2005/02/24 09:58:18 fairhead Exp$2 ! $Id: $ 3 3 ! 4 c 4 MODULE physiq_mod 5 6 IMPLICIT NONE 7 8 CONTAINS 9 5 10 SUBROUTINE physiq (nlon,nlev,nqmax, 6 11 . debut,lafin,rjourvrai,gmtime,pdtphys, … … 1767 1772 ENDIF 1768 1773 1769 RETURN 1770 END 1771 1772 1773 1774 *********************************************************************** 1775 *********************************************************************** 1776 *********************************************************************** 1777 *********************************************************************** 1778 *********************************************************************** 1779 *********************************************************************** 1780 *********************************************************************** 1781 *********************************************************************** 1782 1783 SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit) 1784 IMPLICIT none 1785 c 1786 c Tranformer une variable de la grille physique a 1787 c la grille d'ecriture 1788 c 1789 INTEGER nfield,nlon,iim,jjmp1, jjm 1790 REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield) 1791 c 1792 INTEGER i, n, ig 1793 c 1794 jjm = jjmp1 - 1 1795 DO n = 1, nfield 1796 DO i=1,iim 1797 ecrit(i,n) = fi(1,n) 1798 ecrit(i+jjm*iim,n) = fi(nlon,n) 1799 ENDDO 1800 DO ig = 1, nlon - 2 1801 ecrit(iim+ig,n) = fi(1+ig,n) 1802 ENDDO 1803 ENDDO 1804 RETURN 1805 END 1774 END SUBROUTINE physiq 1775 1776 END MODULE physiq_mod 1777
Note: See TracChangeset
for help on using the changeset viewer.
