Changeset 1056 for trunk/LMDZ.TITAN/libf
- Timestamp:
- Oct 7, 2013, 6:42:03 PM (11 years ago)
- Location:
- trunk/LMDZ.TITAN/libf/phytitan
- Files:
-
- 33 added
- 7 deleted
- 30 edited
-
YOEGWD.h (added)
-
aerprod.h (deleted)
-
brume3D.F (modified) (6 diffs)
-
calchim.F (modified) (11 diffs)
-
clesphys.h (modified) (2 diffs)
-
coefkzmin.F (added)
-
comg1d.h (deleted)
-
comgeomphy.F90 (modified) (1 diff)
-
common_mod.F90 (added)
-
conf_phys.F90 (modified) (2 diffs)
-
diagmuphy.h (deleted)
-
dimphy.F90 (modified) (2 diffs)
-
drag_noro.F (added)
-
grid_noro.F (added)
-
gwprofil.F (added)
-
gwstress.F (added)
-
ini_archive.F (added)
-
ini_histday.h (modified) (2 diffs)
-
ini_histins.h (modified) (3 diffs)
-
ini_histmth.h (modified) (3 diffs)
-
iniphysiq.F (modified) (1 diff)
-
init_phys_lmdz.F90 (modified) (2 diffs)
-
interface_surf.F90 (modified) (4 diffs)
-
interp_vert.F (added)
-
iophy.F90 (added)
-
iostart.F90 (added)
-
mod_phys_lmdz_mpi_data.F90 (added)
-
mod_phys_lmdz_mpi_transfert.F90 (added)
-
mod_phys_lmdz_omp_data.F90 (added)
-
mod_phys_lmdz_omp_transfert.F90 (added)
-
mod_phys_lmdz_para.F90 (added)
-
mod_phys_lmdz_transfert_para.F90 (added)
-
muphys3D.F (modified) (7 diffs)
-
n_acethylene.F (modified) (2 diffs)
-
n_ethane.F (modified) (1 diff)
-
n_methane.F (modified) (1 diff)
-
newstart.F (added)
-
optci.F (modified) (5 diffs)
-
optci_1pt_3.F (modified) (8 diffs)
-
optcv.F (modified) (5 diffs)
-
optcv_1pt_3.F (modified) (4 diffs)
-
orodrag.F (added)
-
orosetup.F (added)
-
phyetat0.F (deleted)
-
phyetat0.F90 (added)
-
phyredem.F (deleted)
-
phyredem.F90 (added)
-
phys_state_var_mod.F90 (added)
-
physiq.F (modified) (55 diffs)
-
phytrac.F (modified) (27 diffs)
-
radlwsw.F (modified) (6 diffs)
-
radtitan.F (modified) (4 diffs)
-
rcm1d.F (modified) (2 diffs)
-
readstart.F (added)
-
scal_wind.F (added)
-
snuages3D.F (modified) (1 diff)
-
start2archive.F (added)
-
startvar.F90 (added)
-
sugwd.F (added)
-
tholin_cvd.F (added)
-
titan_for.h (deleted)
-
wind_scal.F (added)
-
write_archive.F (added)
-
write_field_phy.F90 (added)
-
write_histday.h (modified) (11 diffs)
-
write_histins.h (modified) (12 diffs)
-
write_histmth.h (modified) (11 diffs)
-
writeg1d.F (deleted)
-
writerestart.F (added)
-
writerestartphy.F (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.TITAN/libf/phytitan/brume3D.F
r474 r1056 50 50 integer xnz,xnrad,ngrid 51 51 integer li,lf,ihor 52 real dt 52 real dt,g 53 53 real c0(nz,nrad),c(nz,nrad,2) 54 54 real k(nz,nrad,nrad),knu … … 72 72 data itime/0/ 73 73 74 * initialisation75 * --------------76 77 * effet saisonnier78 * ----------------79 80 81 xsaison=0.82 xsaison=pmu0*4.*pfract83 !=Pi si fract=1/2 (equinoxe) et84 ! si mu0(ihor)=1 sous le soleil85 ! exactement.86 87 c xsaison=0.88 c if (ihor.le.9.or.ihor.ge.41) xsaison=8. ! rapport des surfaces89 c xsaison=1.90 91 74 * controles 92 75 * --------- … … 104 87 dt=x1 105 88 106 if (itime.eq.0) then 107 ITIME=1 89 * initialisation unique 90 * -------------- 91 92 c if (itime.eq.0) then 93 c ITIME=1 94 c endif 95 96 * initialisation 97 * -------------- 98 108 99 call init 109 100 call calcoag 110 endif 101 102 * effet saisonnier 103 * ---------------- 104 105 106 xsaison=0. 107 xsaison=pmu0*4.*pfract 108 !=Pi si fract=1/2 (equinoxe) et 109 ! si mu0(ihor)=1 sous le soleil 110 ! exactement. 111 112 c xsaison=0. 113 c if (ihor.le.9.or.ihor.ge.41) xsaison=8. ! rapport des surfaces 114 c xsaison=1. 111 115 112 116 do i=1,nz,1 113 117 do j=1,nrad 114 118 v1=vitesse(i,j,0) 115 c ho que c'est moche ! -> taused = RT/(Mn2*g)*1/vaer = H/v 116 taused(i,j)= (8.314*t(i)/28.e-3/1.35)/v1119 g=g0*(rtit/(rtit+z(i)))**2 120 taused(i,j)=rgp*t(i)/(mn2*g)/v1 117 121 enddo 118 122 enddo … … 620 624 621 625 zbx=z(h)+dz(h)/2. 626 627 c ATTENTION !! 628 c toutes ces definitions sont contradictoires, 629 c pour mettre 0 au bout du compte... 630 c A NETTOYER !! 631 622 632 if(zbx.le.42000.) then 623 633 kd=1.64e+12*(pb(h)/(kbz*tb(h)))**(-1./2.) 624 634 kd=4. 625 635 else 626 kd=0.0*kd627 636 kd=1.64e+12*(pb(h)/(kbz*tb(h)))**(-1./2.) 628 637 endif … … 758 767 * rap= aar/an2 cst sur l'altitude 759 768 760 rap=0.191 769 rap=0.02 770 c rap=0.191 761 771 do 23 i=1,nz 762 772 an2(i)=(1.-ach4(i))/(1.+rap) … … 769 779 24 continue 770 780 771 do 34i=1,nz781 do i=1,nz 772 782 m=ach4(i)*mch4+an2(i)*mn2+aar(i)*mar 773 783 rhob(i)=pb(i)*m/(rgp*tb(i)) 774 784 c print*,pb(i),m,rgp,tb(i),rhob(i),rho(i) 775 34 continue 785 enddo 776 786 777 787 * fin d'interpolation des taux de melange -
trunk/LMDZ.TITAN/libf/phytitan/calchim.F
r104 r1056 1 SUBROUTINE calchim(n y,qy_c,nomqy_c,declin_rad,ls_rad,dtchim,1 SUBROUTINE calchim(nlon,ny,qy_c,nomqy_c,declin_rad,ls_rad,dtchim, 2 2 . ctemp,cplay,cplev, 3 3 . dqyc) … … 9 9 c Auteur: S. Lebonnois, 01/2000 | 09/2003 10 10 c adaptation pour Titan 3D: 02/2009 11 c adaptation pour // : 04/2013 11 12 c 12 13 c------------------------------------------------- 13 14 c 14 15 use dimphy 16 use common_mod, only:utilaer,maer,prodaer,csn,csh,psurfhaze, 17 . NLEV,NC,ND,NR 18 USE comgeomphy, only: rlatd 19 use moyzon_mod, only: klat 15 20 implicit none 16 21 #include "dimensions.h" … … 19 24 #include "YOMCST.h" 20 25 21 #include "titan_for.h"22 !!! doit etre en accord avec titan.h23 #include "aerprod.h"24 25 26 c Arguments 26 27 c --------- 27 28 29 INTEGER nlon ! nb of horiz points 28 30 INTEGER ny ! nb de composes (nqmax-nmicro) 29 REAL qy_c( jjm+1,klev,NC)! Especes chimiques apres adv.+diss.31 REAL qy_c(nlon,klev,NC) ! Especes chimiques apres adv.+diss. 30 32 character*10 nomqy_c(NC+1) ! Noms des especes chimiques 31 33 REAL declin_rad,ls_rad ! declinaison et long solaire en radians 32 34 REAL dtchim ! pas de temps chimie 33 REAL ctemp( jjm+1,klev) ! Temperature34 REAL cplay( jjm+1,klev) ! pression (Pa)35 REAL cplev( jjm+1,klev) ! pression intercouches (Pa)36 37 REAL dqyc( jjm+1,klev,NC) ! Tendances especes chimiques35 REAL ctemp(nlon,klev) ! Temperature 36 REAL cplay(nlon,klev) ! pression (Pa) 37 REAL cplev(nlon,klev) ! pression intercouches (Pa) 38 39 REAL dqyc(nlon,klev,NC) ! Tendances especes chimiques 38 40 39 41 c Local variables : 40 42 c ----------------- 43 44 integer i,j,l,ic,jm1 45 41 46 c variables envoyees dans la chimie: double precision 42 47 43 integer i,j,l,ic44 48 REAL temp_c(klev),press_c(klev) ! T,p(mbar) a 1 lat donnee 45 49 REAL declin_c ! declinaison en degres … … 64 68 65 69 REAL mass(NC),duree 66 REAL tablefluxtop(NC,jj m+1,5)70 REAL tablefluxtop(NC,jjp1,5) 67 71 REAL botCH4 68 72 DATA botCH4/0.05/ … … 90 94 c ************************************ 91 95 92 allocate(krpd(15,ND+1,klev,jj m+1),krate(klev,NR))96 allocate(krpd(15,ND+1,klev,jjp1),krate(klev,NR)) 93 97 94 98 c Verification dimension verticale: coherence titan_for.h et klev … … 110 114 endif 111 115 112 c calcul de temp_c, densites et press_c a l'equateur:113 c -------------------------------------------------- 114 115 print*,'pression, densites et temp a l equateur(chimie):'116 c calcul de temp_c, densites et press_c au milieu de l'ensemble des points: 117 c ---------------------------------------------------------------------- 118 119 print*,'pression, densites et temp (chimie):' 116 120 print*,'level, press_c, nb, temp_c' 117 121 DO l=1,klev 118 122 c temp_c (K): 119 temp_c(l) = ctemp( jjm/2+1,l)123 temp_c(l) = ctemp(nlon/2+1,l) 120 124 c press_c (mbar): 121 press_c(l) = cplay( jjm/2+1,l)/100.125 press_c(l) = cplay(nlon/2+1,l)/100. 122 126 c nb (cm-3): 123 127 nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l)) … … 393 397 c BOUCLE SUR LES LATITUDES 394 398 c 395 DO j=1,jjp1 396 399 DO j=1,nlon 400 401 if (j.eq.1) then 402 jm1=1 403 else 404 jm1=j-1 405 endif 406 407 if((j.eq.1).or.(klat(j).ne.klat(jm1))) then 408 397 409 c*********************************************************************** 398 410 c*********************************************************************** … … 459 471 c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 460 472 461 if (firstcal.and.(j.eq.1)) then462 print*,'Alt, densites et temp au pole (chimie):'463 print*,'level, z_bas, nb, temp_c'464 do l=1,klev465 print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)466 enddo467 endif468 469 if (firstcal.and.(j.eq.jjm/2)) then470 c print*,'g,mugaz'471 c print*,g,mugaz472 print*,'Alt, densites et temp a l equateur (chimie):'473 print*,'level, z_bas, nb, temp_c'474 do l=1,klev475 print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)476 enddo477 endif478 479 473 c----------------------------------------------------------------------- 480 474 c … … 507 501 c -------------------- 508 502 509 call gptitan( jjp1,rinter,temp_c,nb,503 call gptitan(rinter,temp_c,nb, 510 504 $ nomqy_c,cqy,fluxtop, 511 $ declin_c,duree,( j-1),mass,505 $ declin_c,duree,(klat(j)-1),mass, 512 506 $ botCH4,krpd,krate,reactif, 513 507 $ nom_prod,nom_perte,prod,perte, … … 515 509 $ htoh2,surfhaze) 516 510 517 c if ( j.eq.jjm/2 )518 c $ print*,cqy(1,1),cqy(klev,1),cqy(1,2),cqy(klev,2)519 c if ( j.eq.jjm/2 )520 c $ print*,qy_c(j,1,1),qy_c(j,klev,1),qy_c(j,1,2),qy_c(j,klev,2)521 522 c stop523 524 511 c Tendances composition 525 512 c --------------------- … … 551 538 c*********************************************************************** 552 539 c*********************************************************************** 553 c 540 554 541 c FIN: BOUCLE SUR LES LATITUDES 555 c 542 543 else ! same latitude, we don't do calculations again 544 dqyc(j,:,:) = dqyc(jm1,:,:) 545 if (aerprod.eq.1) then 546 prodaer(j,:,:) = prodaer(jm1,:,:) 547 maer(j,:,:) = maer(jm1,:,:) 548 csn(j,:,:) = csn(jm1,:,:) 549 csh(j,:,:) = csh(jm1,:,:) 550 endif 551 endif 552 556 553 ENDDO 557 554 -
trunk/LMDZ.TITAN/libf/phytitan/clesphys.h
r1048 r1056 30 30 real tx,tcorrect,p_prodaer 31 31 real xnuf 32 REAL xvis,xir 32 33 33 34 … … 39 40 COMMON/clesphys_r/ & 40 41 & ecritphy, solaire, z0, lmixmin, ksta, inertie, emis, & 41 & tx,tcorrect,p_prodaer,xnuf 42 & tx,tcorrect,p_prodaer,xnuf,xvis,xir 42 43 43 44 COMMON/clesphys_l/cycle_diurne, soil_model, & -
trunk/LMDZ.TITAN/libf/phytitan/comgeomphy.F90
r102 r1056 9 9 10 10 subroutine initcomgeomphy 11 use dimphy11 USE mod_phys_lmdz_para 12 12 implicit none 13 13 14 14 15 allocate(airephy(klon ))16 allocate(cuphy(klon ))17 allocate(cvphy(klon ))18 allocate(rlatd(klon ))19 allocate(rlond(klon ))15 allocate(airephy(klon_omp)) 16 allocate(cuphy(klon_omp)) 17 allocate(cvphy(klon_omp)) 18 allocate(rlatd(klon_omp)) 19 allocate(rlond(klon_omp)) 20 20 21 21 end subroutine initcomgeomphy -
trunk/LMDZ.TITAN/libf/phytitan/conf_phys.F90
r815 r1056 374 374 call getin('tcorrect',tcorrect) 375 375 376 ! 377 !Config Key = xvis 378 !Config Desc = Facteur d ajustement des proprietes vis des aerosols 379 !Config Def = 1.5 380 !Config Help = 381 ! 382 xvis = 1.0 383 call getin('xvis',xvis) 384 ! 385 !Config Key = xir 386 !Config Desc = Facteur d ajustement des proprietes IR des aerosols 387 !Config Def = 0.5 388 !Config Help = 389 ! 390 xir = 1.0 391 call getin('xir',xir) 376 392 ! 377 393 !Config Key = p_prodaer … … 487 503 write(numout,*)' tx = ', tx 488 504 write(numout,*)' tcorrect = ', tcorrect 505 write(numout,*)' xvis = ', xvis 506 write(numout,*)' xir = ', xir 489 507 write(numout,*)' p_prodaer = ', p_prodaer 490 508 write(numout,*)' cutoff = ', cutoff -
trunk/LMDZ.TITAN/libf/phytitan/dimphy.F90
r102 r1056 8 8 INTEGER,SAVE :: klevp1 9 9 INTEGER,SAVE :: klevm1 10 INTEGER,SAVE :: kflev11 10 12 11 !$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon) 13 REAL,save,allocatable,dimension(:) :: zmasq14 !$OMP THREADPRIVATE(zmasq)15 12 16 13 CONTAINS … … 31 28 klevp1=klev+1 32 29 klevm1=klev-1 33 kflev=klev34 30 !$OMP END MASTER 35 ALLOCATE(zmasq(klon))36 31 37 32 END SUBROUTINE init_dimphy -
trunk/LMDZ.TITAN/libf/phytitan/ini_histday.h
r902 r1056 1 1 IF (ok_journe) THEN 2 c 2 3 3 zsto = dtime 4 zout = dtime * FLOAT(ecrit_day)4 zout = dtime * REAL(ecrit_day) 5 5 c zsto1: pour des flux radiatifs calcules tous les radpas appels physiq 6 zsto1= dtime * FLOAT(radpas)7 c 6 zsto1= dtime * REAL(radpas) 7 8 8 idayref = day_ref 9 9 CALL ymds2ju(annee_ref, 1, idayref, zero, zjulian) 10 c 11 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon) 12 DO i = 1, iim 13 zx_lon(i,1) = rlond(i+jjmp1-jjm) 14 zx_lon(i,jjmp1) = rlond(i+jjmp1-jjm) 15 ENDDO 16 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat) 17 CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:), 18 . 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 10 11 CALL histbeg_phy("histday.nc", itau_phy, zjulian, dtime, 19 12 . nhori, nid_day) 20 write(*,*)'Journee ', itau_phy, zjulian 21 CALL histvert(nid_day, "presnivs", "Vertical levels", "mb", 13 14 !$OMP MASTER 15 CALL histvert(nid_day, "presnivs", "Vertical levels", "Pa", 22 16 . klev, presnivs, nvert) 23 17 24 18 c------------------------------------------------------- 25 19 IF(lev_histday.GE.1) THEN 26 c 20 27 21 ccccccccccccc 2D fields, invariables 28 c 22 29 23 CALL histdef(nid_day, "phis", "Surface geop. height", "-", 30 . iim,jj mp1,nhori, 1,1,1, -99, 32,24 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 31 25 . "once", zsto,zout) 32 c 26 33 27 CALL histdef(nid_day, "aire", "Grid area", "-", 34 . iim,jj mp1,nhori, 1,1,1, -99, 32,28 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 35 29 . "once", zsto,zout) 36 c 30 37 31 ccccccc axe Ls 38 32 CALL histdef(nid_day, "ls", "Solar longitude", "degrees", 39 . iim,jj mp1,nhori, 1,1,1, -99, 32,40 . "ave(X)", zsto,zout) 41 c 33 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 34 . "ave(X)", zsto,zout) 35 42 36 ccccccccccccc 2D fields, variables 43 c 37 44 38 CALL histdef(nid_day, "tsol", "Surface Temperature", "K", 45 . iim,jj mp1,nhori, 1,1,1, -99, 32,46 . "ave(X)", zsto,zout) 47 c 39 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 40 . "ave(X)", zsto,zout) 41 48 42 CALL histdef(nid_day, "psol", "Surface Pressure", "Pa", 49 . iim,jj mp1,nhori, 1,1,1, -99, 32,50 . "ave(X)", zsto,zout) 51 c 43 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 44 . "ave(X)", zsto,zout) 45 52 46 c CALL histdef(nid_day, "ue", "Zonal energy transport", "-", 53 c . iim,jj mp1,nhori, 1,1,1, -99, 32,47 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 54 48 c . "ave(X)", zsto,zout) 55 c 49 56 50 c CALL histdef(nid_day, "ve", "Merid energy transport", "-", 57 c . iim,jj mp1,nhori, 1,1,1, -99, 32,51 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 58 52 c . "ave(X)", zsto,zout) 59 c 53 60 54 ENDIF !lev_histday.GE.1 61 c 55 62 56 c------------------------------------------------------- 63 57 IF(lev_histday.GE.2) THEN 64 c 58 65 59 ccccccccccccc 3D fields, basics 66 c 60 67 61 CALL histdef(nid_day, "temp", "Air temperature", "K", 68 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,69 . "ave(X)", zsto,zout) 70 c 62 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 63 . "ave(X)", zsto,zout) 64 71 65 CALL histdef(nid_day, "pres", "Air pressure", "Pa", 72 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,73 . "ave(X)", zsto,zout) 74 c 66 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 67 . "ave(X)", zsto,zout) 68 75 69 CALL histdef(nid_day, "geop", "Geopotential height", "m", 76 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,77 . "ave(X)", zsto,zout) 78 c 70 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 71 . "ave(X)", zsto,zout) 72 79 73 CALL histdef(nid_day, "vitu", "Zonal wind", "m/s", 80 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,81 . "ave(X)", zsto,zout) 82 c 74 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 75 . "ave(X)", zsto,zout) 76 83 77 CALL histdef(nid_day, "vitv", "Meridional wind", "m/s", 84 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,85 . "ave(X)", zsto,zout) 86 c 78 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 79 . "ave(X)", zsto,zout) 80 87 81 CALL histdef(nid_day, "vitw", "Vertical wind", "Pa/s", 88 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,89 . "ave(X)", zsto,zout) 90 c 82 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 83 . "ave(X)", zsto,zout) 84 91 85 CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2", 92 . iim,jj mp1,nhori, 1,1,1, -99, 32,86 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 93 87 . "ave(X)", zsto1,zout) 94 c 88 89 CALL histdef(nid_day, "duvdf", "Boundary-layer dU", "m/s2", 90 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 91 . "ave(X)", zsto,zout) 92 95 93 CALL histdef(nid_day, "dudyn", "Dynamics dU", "m/s2", 96 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 97 . "ave(X)", zsto,zout) 98 c 99 CALL histdef(nid_day, "duvdf", "Boundary-layer dU", "m/s2", 100 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 101 . "ave(X)", zsto,zout) 102 c 94 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 95 . "ave(X)", zsto,zout) 96 103 97 cccccccccccccccccc Tracers 104 c 98 105 99 if (iflag_trac.eq.1) THEN 106 100 if (microfi.ge.1) then 107 101 c DO iq=1,nmicro 108 102 c CALL histdef(nid_day, tname(iq), ttext(iq), "n/m2", 109 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,103 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 110 104 c . "ave(X)", zsto,zout) 111 105 c ENDDO 112 106 CALL histdef(nid_day, "qaer","nb tot aer" , "n/m2", 113 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,107 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 114 108 . "ave(X)", zsto,zout) 115 109 116 110 if (clouds.eq.1) then 117 111 CALL histdef(nid_day, "qnoy","nb tot noy" , "n/m2", 118 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,112 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 119 113 . "ave(X)", zsto,zout) 120 114 CALL histdef(nid_day, "qgl1","V tot gl1" , "m3/m2", 121 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,115 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 122 116 . "ave(X)", zsto,zout) 123 117 CALL histdef(nid_day, "qgl2","V tot gl2" , "m3/m2", 124 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,118 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 125 119 . "ave(X)", zsto,zout) 126 120 CALL histdef(nid_day, "qgl3","V tot gl3" , "m3/m2", 127 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,121 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 128 122 . "ave(X)", zsto,zout) 129 123 c-------------- 130 124 c ----- SATURATION ESP NUAGES 131 125 CALL histdef(nid_day,"ch4sat", "saturation CH4", "--", 132 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,126 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 133 127 . "ave(X)", zsto,zout) 134 128 CALL histdef(nid_day,"c2h6sat", "saturation C2H6", "--", 135 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,129 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 136 130 . "ave(X)", zsto,zout) 137 131 CALL histdef(nid_day,"c2h2sat", "saturation C2H2", "--", 138 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,132 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 139 133 . "ave(X)", zsto,zout) 140 134 c -------------- 141 135 c ----- RESERVOIR DE SURFACE 142 136 CALL histdef(nid_day, "reserv", "Reservoir surface","m", 143 . iim,jj mp1,nhori, 1,1,1, -99, 32,137 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 144 138 . "ave(X)", zsto,zout) 145 139 c -------------- 146 140 c ----- ECHANGE GAZ SURF/ATM (evaporation) 147 141 CALL histdef(nid_day, "evapch4", "Evaporation CH4","m", 148 . iim,jj mp1,nhori, 1,1,1, -99, 32,142 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 149 143 . "ave(X)", zsto,zout) 150 144 c -------------- 151 145 c ----- PRECIPITATIONS (precipitations cumulatives) 152 146 CALL histdef(nid_day,"prech4","Precip CH4","m", 153 . iim,jj mp1,nhori, 1,1,1, -99, 32,147 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 154 148 . "ave(X)", zsto,zout) 155 149 CALL histdef(nid_day,"prec2h6","Precip C2H6", 156 . "m",iim,jj mp1,nhori, 1,1,1, -99, 32,150 . "m",iim,jj_nb,nhori, 1,1,1, nvert, 32, 157 151 . "ave(X)", zsto,zout) 158 152 CALL histdef(nid_day,"prec2h2","Precip C2H2", 159 . "m",iim,jjmp1,nhori, 1,1,1, -99, 32, 153 . "m",iim,jj_nb,nhori, 1,1,1, nvert, 32, 154 . "ave(X)", zsto,zout) 155 CALL histdef(nid_day,"prenoy","Precip NOY", 156 . "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32, 157 . "ave(X)", zsto,zout) 158 CALL histdef(nid_day,"preaer","Precip AER", 159 . "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32, 160 160 . "ave(X)", zsto,zout) 161 161 c -------------- 162 162 c ----- FLUX GLACE 163 163 CALL histdef(nid_day,"flxgl1", "flux gl CH4", 164 . "kg/m2/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,164 . "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 165 165 . "ave(X)", zsto,zout) 166 166 CALL histdef(nid_day,"flxgl2", "flux gl C2H6", 167 . "kg/m2/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,167 . "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 168 168 . "ave(X)", zsto,zout) 169 169 CALL histdef(nid_day,"flxgl3", "flux gl C2H2", 170 . "kg/m2/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,170 . "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 171 171 . "ave(X)", zsto,zout) 172 172 c -------------- 173 173 c ----- RAYON DES GOUTTES 174 174 CALL histdef(nid_day,"rcldbar", "rayon moyen goutte", 175 . "m",iim,jj mp1,nhori, klev,1,klev,nvert, 32,175 . "m",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 176 176 . "ave(X)", zsto,zout) 177 177 endif … … 182 182 DO iq=nmicro+1,nqmax 183 183 CALL histdef(nid_day, tname(iq), ttext(iq), "ppm", 184 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,184 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 185 185 . "ave(X)", zsto,zout) 186 186 ENDDO 187 187 endif 188 188 endif 189 c 189 190 190 ENDIF !lev_histday.GE.2 191 c 191 192 192 c------------------------------------------------------- 193 193 IF(lev_histday.GE.3) THEN 194 c 194 195 195 cccccccccccccccccc Radiative transfer 196 c 196 197 197 c 2D 198 c 198 199 199 CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2", 200 . iim,jj mp1,nhori, 1,1,1, -99, 32,200 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 201 201 . "ave(X)", zsto1,zout) 202 c 202 203 203 CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2", 204 . iim,jj mp1,nhori, 1,1,1, -99, 32,204 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 205 205 . "ave(X)", zsto1,zout) 206 c 206 207 207 CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2", 208 . iim,jj mp1,nhori, 1,1,1, -99, 32,208 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 209 209 . "ave(X)", zsto1,zout) 210 c 210 211 211 c 3D 212 c 212 213 213 CALL histdef(nid_day, "SWnet", "Net SW flux","W/m2", 214 . iim,jj mp1,nhori, klev,1,klev,nvert,214 . iim,jj_nb,nhori, klev,1,klev,nvert, 215 215 . 32, "ave(X)", zsto1,zout) 216 c 216 217 217 CALL histdef(nid_day, "LWnet", "Net LW flux","W/m2", 218 . iim,jj mp1,nhori, klev,1,klev,nvert,218 . iim,jj_nb,nhori, klev,1,klev,nvert, 219 219 . 32, "ave(X)", zsto1,zout) 220 c 220 221 221 c -------------- 222 222 c ----- OPACITE BRUME 223 223 DO k=7,NSPECV,10 224 write(str 1,'(i2.2)') k225 CALL histdef(nid_day,"thv"//str 1,"Haze Opa Vis",226 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,227 . "ave(X)",zsto1,zout) 228 ENDDO 229 c 224 write(str2,'(i2.2)') k 225 CALL histdef(nid_day,"thv"//str2,"Haze Opa Vis", 226 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 227 . "ave(X)",zsto1,zout) 228 ENDDO 229 230 230 DO k=8,NSPECI,10 231 write(str 1,'(i2.2)') k232 CALL histdef(nid_day,"thi"//str 1,"Haze Opa IR",233 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,234 . "ave(X)",zsto1,zout) 235 ENDDO 236 c 231 write(str2,'(i2.2)') k 232 CALL histdef(nid_day,"thi"//str2,"Haze Opa IR", 233 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 234 . "ave(X)",zsto1,zout) 235 ENDDO 236 237 237 c -------------- 238 238 c ----- EXTINCTION BRUME 239 239 DO k=7,NSPECV,10 240 write(str 1,'(i2.2)') k241 CALL histdef(nid_day,"khv"//str 1,"Haze ext Vis ",242 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,243 . "ave(X)",zsto1,zout) 244 ENDDO 245 c 240 write(str2,'(i2.2)') k 241 CALL histdef(nid_day,"khv"//str2,"Haze ext Vis ", 242 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 243 . "ave(X)",zsto1,zout) 244 ENDDO 245 246 246 DO k=8,NSPECI,10 247 write(str 1,'(i2.2)') k248 CALL histdef(nid_day,"khi"//str 1,"Haze ext IR ",249 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,250 . "ave(X)",zsto1,zout) 251 ENDDO 252 c 247 write(str2,'(i2.2)') k 248 CALL histdef(nid_day,"khi"//str2,"Haze ext IR ", 249 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 250 . "ave(X)",zsto1,zout) 251 ENDDO 252 253 253 c -------------- 254 254 c ----- OPACITE GAZ 255 255 DO k=7,NSPECV,10 256 write(str 1,'(i2.2)') k257 CALL histdef(nid_day,"tgv"//str 1,"Gas Opa Vis",258 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,259 . "ave(X)",zsto1,zout) 260 ENDDO 261 c 256 write(str2,'(i2.2)') k 257 CALL histdef(nid_day,"tgv"//str2,"Gas Opa Vis", 258 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 259 . "ave(X)",zsto1,zout) 260 ENDDO 261 262 262 DO k=8,NSPECI,10 263 write(str 1,'(i2.2)') k264 CALL histdef(nid_day,"tgi"//str 1,"Gas Opa IR",265 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,266 . "ave(X)",zsto1,zout) 267 ENDDO 268 c 263 write(str2,'(i2.2)') k 264 CALL histdef(nid_day,"tgi"//str2,"Gas Opa IR", 265 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 266 . "ave(X)",zsto1,zout) 267 ENDDO 268 269 269 c -------------- 270 270 c ----- EXTINCTION GAZ 271 271 DO k=7,NSPECV,10 272 write(str 1,'(i2.2)') k273 CALL histdef(nid_day,"kgv"//str 1,"Gas ext Vis ",274 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,275 . "ave(X)",zsto1,zout) 276 ENDDO 277 c 272 write(str2,'(i2.2)') k 273 CALL histdef(nid_day,"kgv"//str2,"Gas ext Vis ", 274 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 275 . "ave(X)",zsto1,zout) 276 ENDDO 277 278 278 DO k=8,NSPECI,10 279 write(str 1,'(i2.2)') k280 CALL histdef(nid_day,"kgi"//str 1,"Gas ext IR ",281 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,282 . "ave(X)",zsto1,zout) 283 ENDDO 284 c 279 write(str2,'(i2.2)') k 280 CALL histdef(nid_day,"kgi"//str2,"Gas ext IR ", 281 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 282 . "ave(X)",zsto1,zout) 283 ENDDO 284 285 285 c -------------- 286 286 c ----- OPACITE NUAGES 287 287 if (clouds.eq.1) then 288 288 CALL histdef(nid_day,"tcld","Cld Opa proxy", 289 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,289 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 290 290 . "ave(X)",zsto,zout) 291 c 291 292 292 c -------------- 293 293 c ----- EXTINCTION NUAGES 294 294 CALL histdef(nid_day,"kcld","Cld Ext proxy", 295 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,295 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 296 296 . "ave(X)",zsto,zout) 297 297 endif 298 c 298 299 299 ENDIF !lev_histday.GE.3 300 c 300 301 301 c------------------------------------------------------- 302 302 IF(lev_histday.GE.4) THEN 303 c 303 304 304 CALL histdef(nid_day, "dtdyn", "Dynamics dT", "K/s", 305 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,306 . "ave(X)", zsto,zout) 307 c 305 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 306 . "ave(X)", zsto,zout) 307 308 308 CALL histdef(nid_day, "dtphy", "Physics dT", "K/s", 309 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,310 . "ave(X)", zsto,zout) 311 c 309 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 310 . "ave(X)", zsto,zout) 311 312 312 CALL histdef(nid_day, "dtvdf", "Boundary-layer dT", "K/s", 313 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,314 . "ave(X)", zsto,zout) 315 c 313 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 314 . "ave(X)", zsto,zout) 315 316 316 CALL histdef(nid_day, "dtajs", "Dry adjust. dT", "K/s", 317 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,318 . "ave(X)", zsto,zout) 319 c 317 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 318 . "ave(X)", zsto,zout) 319 320 320 CALL histdef(nid_day, "dtswr", "SW radiation dT", "K/s", 321 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,322 . "ave(X)", zsto,zout) 323 c 321 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 322 . "ave(X)", zsto,zout) 323 324 324 CALL histdef(nid_day, "dtlwr", "LW radiation dT", "K/s", 325 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,326 . "ave(X)", zsto,zout) 327 c 325 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 326 . "ave(X)", zsto,zout) 327 328 328 c CALL histdef(nid_day, "dtec", "Cinetic dissip dT", "K/s", 329 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,329 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 330 330 c . "ave(X)", zsto,zout) 331 c 331 332 332 ENDIF !lev_histday.GE.4 333 c 333 334 334 c------------------------------------------------------- 335 335 IF(lev_histday.GE.5) THEN 336 c 337 c 336 337 338 338 c call histdef(nid_day, "taux", 339 339 c $ "Zonal wind stress", "Pa", 340 c $ iim,jj mp1,nhori, 1,1,1, -99, 32,340 c $ iim,jj_nb,nhori, 1,1,1, nvert, 32, 341 341 c $ "ave(X)", zsto,zout) 342 c 342 343 343 c call histdef(nid_day, "tauy", 344 344 c $ "Meridional xind stress", "Pa", 345 c $ iim,jj mp1,nhori, 1,1,1, -99, 32,345 c $ iim,jj_nb,nhori, 1,1,1, nvert, 32, 346 346 c $ "ave(X)", zsto,zout) 347 c 347 348 348 c CALL histdef(nid_day, "cdrm", "Momentum drag coef.", "-", 349 c . iim,jj mp1,nhori, 1,1,1, -99, 32,349 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 350 350 c . "ave(X)", zsto,zout) 351 c 351 352 352 c CALL histdef(nid_day, "cdrh", "Heat drag coef.", "-", 353 c . iim,jj mp1,nhori, 1,1,1, -99, 32,353 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 354 354 c . "ave(X)", zsto,zout) 355 c 355 356 356 ENDIF !lev_histday.GE.5 357 357 c------------------------------------------------------- 358 c 358 359 359 CALL histend(nid_day) 360 c 361 ndex2d = 0 362 ndex3d = 0 363 c 360 364 361 ENDIF ! fin de test sur ok_journe -
trunk/LMDZ.TITAN/libf/phytitan/ini_histins.h
r902 r1056 1 1 IF (ok_instan) THEN 2 c 3 zsto = dtime * FLOAT(ecrit_ins)4 zout = dtime * FLOAT(ecrit_ins)5 c 2 3 zsto = dtime * REAL(ecrit_ins) 4 zout = dtime * REAL(ecrit_ins) 5 6 6 idayref = day_ref 7 7 CALL ymds2ju(annee_ref, 1, idayref, zero, zjulian) 8 c 9 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon) 10 DO i = 1, iim 11 zx_lon(i,1) = rlond(i+jjmp1-jjm) 12 zx_lon(i,jjmp1) = rlond(i+jjmp1-jjm) 13 ENDDO 14 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat) 15 CALL histbeg("histins", iim,zx_lon(:,1), jjmp1,zx_lat(1,:), 16 . 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 8 9 CALL histbeg_phy("histins.nc", itau_phy, zjulian, dtime, 17 10 . nhori, nid_ins) 18 write(*,*)'Inst ', itau_phy, zjulian 19 CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb", 11 12 !$OMP MASTER 13 CALL histvert(nid_ins, "presnivs", "Vertical levels", "Pa", 20 14 . klev, presnivs, nvert) 21 15 … … 23 17 24 18 IF(lev_histday.GE.1) THEN 25 c 19 26 20 ccccccccccccc 2D fields, invariables 27 c 21 28 22 CALL histdef(nid_ins, "phis", "Surface geop. height", "-", 29 . iim,jj mp1,nhori, 1,1,1, -99, 32,23 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 30 24 . "once", zsto,zout) 31 c 25 32 26 CALL histdef(nid_ins, "aire", "Grid area", "-", 33 . iim,jj mp1,nhori, 1,1,1, -99, 32,27 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 34 28 . "once", zsto,zout) 35 c 29 36 30 ccccccc axe Ls 37 31 CALL histdef(nid_ins, "ls", "Solar longitude", "degrees", 38 . iim,jj mp1,nhori, 1,1,1, -99, 32,39 . "inst(X)", zsto,zout) 40 c 32 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 33 . "inst(X)", zsto,zout) 34 41 35 ccccccccccccc 2D fields, variables 42 c 36 43 37 CALL histdef(nid_ins, "tsol", "Surface Temperature", "K", 44 . iim,jj mp1,nhori, 1,1,1, -99, 32,45 . "inst(X)", zsto,zout) 46 c 38 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 39 . "inst(X)", zsto,zout) 40 47 41 CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa", 48 . iim,jj mp1,nhori, 1,1,1, -99, 32,49 . "inst(X)", zsto,zout) 50 c 42 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 43 . "inst(X)", zsto,zout) 44 51 45 c CALL histdef(nid_ins, "ue", "Zonal energy transport", "-", 52 c . iim,jj mp1,nhori, 1,1,1, -99, 32,53 c . "inst(X)", zsto,zout) 54 c 46 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 47 c . "inst(X)", zsto,zout) 48 55 49 c CALL histdef(nid_ins, "ve", "Merid energy transport", "-", 56 c . iim,jj mp1,nhori, 1,1,1, -99, 32,57 c . "inst(X)", zsto,zout) 58 c 50 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 51 c . "inst(X)", zsto,zout) 52 59 53 ENDIF !lev_histday.GE.1 60 c 54 61 55 c------------------------------------------------------- 62 56 IF(lev_histday.GE.2) THEN 63 c 57 64 58 ccccccccccccc 3D fields, basics 65 c 59 66 60 CALL histdef(nid_ins, "temp", "Air temperature", "K", 67 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,68 . "inst(X)", zsto,zout) 69 c 61 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 62 . "inst(X)", zsto,zout) 63 70 64 CALL histdef(nid_ins, "pres", "Air pressure", "Pa", 71 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,72 . "inst(X)", zsto,zout) 73 c 65 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 66 . "inst(X)", zsto,zout) 67 74 68 CALL histdef(nid_ins, "geop", "Geopotential height", "m", 75 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,76 . "inst(X)", zsto,zout) 77 c 69 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 70 . "inst(X)", zsto,zout) 71 78 72 CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s", 79 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,80 . "inst(X)", zsto,zout) 81 c 73 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 74 . "inst(X)", zsto,zout) 75 82 76 CALL histdef(nid_ins, "vitv", "Meridional wind", "m/s", 83 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,84 . "inst(X)", zsto,zout) 85 c 77 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 78 . "inst(X)", zsto,zout) 79 86 80 CALL histdef(nid_ins, "vitw", "Vertical wind", "Pa/s", 87 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,88 . "inst(X)", zsto,zout) 89 c 81 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 82 . "inst(X)", zsto,zout) 83 90 84 CALL histdef(nid_ins, "tops", "Solar rad. at TOA", "W/m2", 91 . iim,jj mp1,nhori, 1,1,1, -99, 32,92 . "inst(X)", zsto,zout) 93 c 85 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 86 . "inst(X)", zsto,zout) 87 94 88 c CALL histdef(nid_ins, "duvdf", "Boundary-layer dU", "m/s2", 95 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,96 c . "inst(X)", zsto,zout) 97 c 89 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 90 c . "inst(X)", zsto,zout) 91 98 92 c CALL histdef(nid_ins, "dudyn", "Dynamics dU", "m/s2", 99 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,100 c . "inst(X)", zsto,zout) 101 c 93 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 94 c . "inst(X)", zsto,zout) 95 102 96 ENDIF !lev_histday.GE.2 103 c 97 104 98 c------------------------------------------------------- 105 99 IF(lev_histday.GE.3) THEN 106 c 100 107 101 cccccccccccccccccc Tracers 108 c 102 109 103 if (iflag_trac.eq.1) THEN 110 104 if (microfi.ge.1) then 111 105 DO iq=1,nmicro 112 106 CALL histdef(nid_ins, tname(iq), ttext(iq), "n/m2", 113 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,107 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 114 108 . "inst(X)", zsto,zout) 115 109 ENDDO … … 118 112 DO iq=nmicro+1,nqmax 119 113 CALL histdef(nid_ins, tname(iq), ttext(iq), "ppm", 120 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,114 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 121 115 . "inst(X)", zsto,zout) 122 116 ENDDO 123 117 endif 124 118 endif 125 c 119 126 120 cccccccccccccccccc Radiative transfer 127 c 121 128 122 c 2D 129 c 123 130 124 CALL histdef(nid_ins, "topl", "IR rad. at TOA", "W/m2", 131 . iim,jj mp1,nhori, 1,1,1, -99, 32,132 . "inst(X)", zsto,zout) 133 c 125 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 126 . "inst(X)", zsto,zout) 127 134 128 CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2", 135 . iim,jj mp1,nhori, 1,1,1, -99, 32,136 . "inst(X)", zsto,zout) 137 c 129 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 130 . "inst(X)", zsto,zout) 131 138 132 CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2", 139 . iim,jj mp1,nhori, 1,1,1, -99, 32,140 . "inst(X)", zsto,zout) 141 c 133 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 134 . "inst(X)", zsto,zout) 135 142 136 c 3D 143 c 137 144 138 CALL histdef(nid_ins, "SWnet", "Net SW flux","W/m2", 145 . iim,jj mp1,nhori, klev,1,klev,nvert,139 . iim,jj_nb,nhori, klev,1,klev,nvert, 146 140 . 32, "inst(X)", zsto,zout) 147 c 141 148 142 CALL histdef(nid_ins, "LWnet", "Net LW flux","W/m2", 149 . iim,jj mp1,nhori, klev,1,klev,nvert,143 . iim,jj_nb,nhori, klev,1,klev,nvert, 150 144 . 32, "inst(X)", zsto,zout) 151 c 145 152 146 c -------------- 153 147 c ----- OPACITE BRUME 154 148 DO k=7,NSPECV,10 155 write(str 1,'(i2.2)') k156 CALL histdef(nid_ins,"thv"//str 1,"Haze Opa Vis",157 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,158 . "ins(X)",zsto,zout) 159 ENDDO 160 c 161 DO k=8,NSPECI,10 162 write(str 1,'(i2.2)') k163 CALL histdef(nid_ins,"thi"//str 1,"Haze Opa IR",164 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,165 . "ins(X)",zsto,zout) 166 ENDDO 167 c 149 write(str2,'(i2.2)') k 150 CALL histdef(nid_ins,"thv"//str2,"Haze Opa Vis", 151 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 152 . "ins(X)",zsto,zout) 153 ENDDO 154 155 DO k=8,NSPECI,10 156 write(str2,'(i2.2)') k 157 CALL histdef(nid_ins,"thi"//str2,"Haze Opa IR", 158 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 159 . "ins(X)",zsto,zout) 160 ENDDO 161 168 162 c -------------- 169 163 c ----- EXTINCTION BRUME 170 164 DO k=7,NSPECV,10 171 write(str 1,'(i2.2)') k172 CALL histdef(nid_ins,"khv"//str 1,"Haze ext Vis ",173 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,174 . "ins(X)",zsto,zout) 175 ENDDO 176 c 177 DO k=8,NSPECI,10 178 write(str 1,'(i2.2)') k179 CALL histdef(nid_ins,"khi"//str 1,"Haze ext IR ",180 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,181 . "ins(X)",zsto,zout) 182 ENDDO 183 c 165 write(str2,'(i2.2)') k 166 CALL histdef(nid_ins,"khv"//str2,"Haze ext Vis ", 167 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 168 . "ins(X)",zsto,zout) 169 ENDDO 170 171 DO k=8,NSPECI,10 172 write(str2,'(i2.2)') k 173 CALL histdef(nid_ins,"khi"//str2,"Haze ext IR ", 174 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 175 . "ins(X)",zsto,zout) 176 ENDDO 177 184 178 c -------------- 185 179 c ----- OPACITE GAZ 186 180 DO k=7,NSPECV,10 187 write(str 1,'(i2.2)') k188 CALL histdef(nid_ins,"tgv"//str 1,"Haze Opa Vis",189 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,190 . "ins(X)",zsto,zout) 191 ENDDO 192 c 193 DO k=8,NSPECI,10 194 write(str 1,'(i2.2)') k195 CALL histdef(nid_ins,"tgi"//str 1,"Haze Opa IR",196 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,197 . "ins(X)",zsto,zout) 198 ENDDO 199 c 181 write(str2,'(i2.2)') k 182 CALL histdef(nid_ins,"tgv"//str2,"Haze Opa Vis", 183 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 184 . "ins(X)",zsto,zout) 185 ENDDO 186 187 DO k=8,NSPECI,10 188 write(str2,'(i2.2)') k 189 CALL histdef(nid_ins,"tgi"//str2,"Haze Opa IR", 190 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 191 . "ins(X)",zsto,zout) 192 ENDDO 193 200 194 c -------------- 201 195 c ----- EXTINCTION GAZ 202 196 DO k=7,NSPECV,10 203 write(str 1,'(i2.2)') k204 CALL histdef(nid_ins,"kgv"//str 1,"Haze ext Vis ",205 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,206 . "ins(X)",zsto,zout) 207 ENDDO 208 c 209 DO k=8,NSPECI,10 210 write(str 1,'(i2.2)') k211 CALL histdef(nid_ins,"kgi"//str 1,"Haze ext IR ",212 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,213 . "ins(X)",zsto,zout) 214 ENDDO 215 c 197 write(str2,'(i2.2)') k 198 CALL histdef(nid_ins,"kgv"//str2,"Haze ext Vis ", 199 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 200 . "ins(X)",zsto,zout) 201 ENDDO 202 203 DO k=8,NSPECI,10 204 write(str2,'(i2.2)') k 205 CALL histdef(nid_ins,"kgi"//str2,"Haze ext IR ", 206 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 207 . "ins(X)",zsto,zout) 208 ENDDO 209 216 210 ENDIF !lev_histday.GE.3 217 c 211 218 212 c------------------------------------------------------- 219 213 IF(lev_histday.GE.4) THEN 220 c 214 221 215 CALL histdef(nid_ins, "dtdyn", "Dynamics dT", "K/s", 222 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,223 . "inst(X)", zsto,zout) 224 c 216 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 217 . "inst(X)", zsto,zout) 218 225 219 CALL histdef(nid_ins, "dtphy", "Physics dT", "K/s", 226 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,227 . "inst(X)", zsto,zout) 228 c 220 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 221 . "inst(X)", zsto,zout) 222 229 223 CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s", 230 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,231 . "inst(X)", zsto,zout) 232 c 224 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 225 . "inst(X)", zsto,zout) 226 233 227 CALL histdef(nid_ins, "dtajs", "Dry adjust. dT", "K/s", 234 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,235 . "inst(X)", zsto,zout) 236 c 228 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 229 . "inst(X)", zsto,zout) 230 237 231 CALL histdef(nid_ins, "dtswr", "SW radiation dT", "K/s", 238 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,239 . "inst(X)", zsto,zout) 240 c 232 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 233 . "inst(X)", zsto,zout) 234 241 235 CALL histdef(nid_ins, "dtlwr", "LW radiation dT", "K/s", 242 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,243 . "inst(X)", zsto,zout) 244 c 236 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 237 . "inst(X)", zsto,zout) 238 245 239 c CALL histdef(nid_ins, "dtec", "Cinetic dissip dT", "K/s", 246 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,247 c . "inst(X)", zsto,zout) 248 c 240 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 241 c . "inst(X)", zsto,zout) 242 249 243 c CALL histdef(nid_ins, "dvvdf", "Boundary-layer dV", "m/s2", 250 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,251 c . "inst(X)", zsto,zout) 252 c 244 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 245 c . "inst(X)", zsto,zout) 246 253 247 ENDIF !lev_histday.GE.4 254 c 248 255 249 c------------------------------------------------------- 256 250 IF(lev_histday.GE.5) THEN 257 c 258 c 251 252 259 253 c call histdef(nid_ins, "taux", 260 254 c $ "Zonal wind stress", "Pa", 261 c $ iim,jj mp1,nhori, 1,1,1, -99, 32,255 c $ iim,jj_nb,nhori, 1,1,1, nvert, 32, 262 256 c $ "inst(X)", zsto,zout) 263 c 257 264 258 c call histdef(nid_ins, "tauy", 265 259 c $ "Meridional xind stress", "Pa", 266 c $ iim,jj mp1,nhori, 1,1,1, -99, 32,260 c $ iim,jj_nb,nhori, 1,1,1, nvert, 32, 267 261 c $ "inst(X)", zsto,zout) 268 c 262 269 263 c CALL histdef(nid_ins, "cdrm", "Momentum drag coef.", "-", 270 c . iim,jj mp1,nhori, 1,1,1, -99, 32,271 c . "inst(X)", zsto,zout) 272 c 264 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 265 c . "inst(X)", zsto,zout) 266 273 267 c CALL histdef(nid_ins, "cdrh", "Heat drag coef.", "-", 274 c . iim,jj mp1,nhori, 1,1,1, -99, 32,275 c . "inst(X)", zsto,zout) 276 c 268 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 269 c . "inst(X)", zsto,zout) 270 277 271 ENDIF !lev_histday.GE.5 278 272 c------------------------------------------------------- 279 273 280 274 CALL histend(nid_ins) 281 c 282 ndex2d = 0 283 ndex3d = 0 284 c 275 285 276 ENDIF -
trunk/LMDZ.TITAN/libf/phytitan/ini_histmth.h
r902 r1056 1 1 IF (ok_mensuel) THEN 2 c 2 3 3 zsto = dtime 4 zout = dtime * FLOAT(ecrit_mth)4 zout = dtime * REAL(ecrit_mth) 5 5 c zsto1: pour des flux radiatifs calcules tous les radpas appels physiq 6 zsto1= dtime * FLOAT(radpas)7 c 6 zsto1= dtime * REAL(radpas) 7 8 8 idayref = day_ref 9 9 CALL ymds2ju(annee_ref, 1, idayref, zero, zjulian) 10 c 11 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon) 12 DO i = 1, iim 13 zx_lon(i,1) = rlond(i+jjmp1-jjm) 14 zx_lon(i,jjmp1) = rlond(i+jjmp1-jjm) 15 ENDDO 16 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat) 17 CALL histbeg("histmth", iim,zx_lon(:,1), jjmp1,zx_lat(1,:), 18 . 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 10 11 CALL histbeg_phy("histmth.nc", itau_phy, zjulian, dtime, 19 12 . nhori, nid_mth) 20 write(*,*)'Journee ', itau_phy, zjulian 21 CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb", 13 14 !$OMP MASTER 15 CALL histvert(nid_mth, "presnivs", "Vertical levels", "Pa", 22 16 . klev, presnivs, nvert) 23 17 24 18 c------------------------------------------------------- 25 19 IF(lev_histmth.GE.1) THEN 26 c 20 27 21 ccccccccccccc 2D fields, invariables 28 c 22 29 23 CALL histdef(nid_mth, "phis", "Surface geop. height", "-", 30 . iim,jj mp1,nhori, 1,1,1, -99, 32,24 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 31 25 . "once", zsto,zout) 32 c 26 33 27 CALL histdef(nid_mth, "aire", "Grid area", "-", 34 . iim,jj mp1,nhori, 1,1,1, -99, 32,28 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 35 29 . "once", zsto,zout) 36 c 30 37 31 ccccccc axe Ls 38 32 CALL histdef(nid_mth, "ls", "Solar longitude", "degrees", 39 . iim,jj mp1,nhori, 1,1,1, -99, 32,40 . "ave(X)", zsto,zout) 41 c 33 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 34 . "ave(X)", zsto,zout) 35 42 36 ccccccccccccc 2D fields, variables 43 c 37 44 38 CALL histdef(nid_mth, "tsol", "Surface Temperature", "K", 45 . iim,jj mp1,nhori, 1,1,1, -99, 32,46 . "ave(X)", zsto,zout) 47 c 39 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 40 . "ave(X)", zsto,zout) 41 48 42 CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa", 49 . iim,jj mp1,nhori, 1,1,1, -99, 32,50 . "ave(X)", zsto,zout) 51 c 43 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 44 . "ave(X)", zsto,zout) 45 52 46 c CALL histdef(nid_mth, "ue", "Zonal energy transport", "-", 53 c . iim,jj mp1,nhori, 1,1,1, -99, 32,54 c . "ave(X)", zsto,zout) 55 c 47 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 48 c . "ave(X)", zsto,zout) 49 56 50 c CALL histdef(nid_mth, "ve", "Merid energy transport", "-", 57 c . iim,jjmp1,nhori, 1,1,1, -99, 32, 58 c . "ave(X)", zsto,zout) 59 c 60 c CALL histdef(nid_mth, "cdragh", "Drag coef on T", "-", 61 c . iim,jjmp1,nhori, 1,1,1, -99, 32, 62 c . "ave(X)", zsto,zout) 63 c 64 c CALL histdef(nid_mth, "cdragm", "Drag coef on U", "-", 65 c . iim,jjmp1,nhori, 1,1,1, -99, 32, 66 c . "ave(X)", zsto,zout) 67 c 51 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 52 c . "ave(X)", zsto,zout) 53 68 54 ENDIF !lev_histmth.GE.1 69 c 55 70 56 c------------------------------------------------------- 71 57 IF(lev_histmth.GE.2) THEN 72 c 58 73 59 ccccccccccccc 3D fields, basics 74 c 60 75 61 CALL histdef(nid_mth, "temp", "Air temperature", "K", 76 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,77 . "ave(X)", zsto,zout) 78 c 62 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 63 . "ave(X)", zsto,zout) 64 79 65 CALL histdef(nid_mth, "pres", "Air pressure", "Pa", 80 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,81 . "ave(X)", zsto,zout) 82 c 66 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 67 . "ave(X)", zsto,zout) 68 83 69 CALL histdef(nid_mth, "geop", "Geopotential height", "m", 84 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,85 . "ave(X)", zsto,zout) 86 c 70 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 71 . "ave(X)", zsto,zout) 72 87 73 CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s", 88 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,89 . "ave(X)", zsto,zout) 90 c 74 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 75 . "ave(X)", zsto,zout) 76 91 77 CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s", 92 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,93 . "ave(X)", zsto,zout) 94 c 78 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 79 . "ave(X)", zsto,zout) 80 95 81 CALL histdef(nid_mth, "vitw", "Vertical wind", "Pa/s", 96 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,97 . "ave(X)", zsto,zout) 98 c 82 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 83 . "ave(X)", zsto,zout) 84 99 85 c CALL histdef(nid_mth, "Kz", "vertical diffusion coef", "m2/s", 100 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,101 c . "ave(X)", zsto,zout) 102 c 86 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 87 c . "ave(X)", zsto,zout) 88 103 89 CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2", 104 . iim,jj mp1,nhori, 1,1,1, -99, 32,90 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 105 91 . "ave(X)", zsto1,zout) 106 c 92 93 CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2", 94 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 95 . "ave(X)", zsto,zout) 96 97 CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2", 98 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 99 . "ave(X)", zsto,zout) 100 107 101 cccccccccccccccccc Tracers 108 c 102 109 103 if (iflag_trac.eq.1) THEN 110 104 if (microfi.ge.1) then 111 105 c DO iq=1,nmicro 112 106 c CALL histdef(nid_mth, tname(iq), ttext(iq), "n/m2", 113 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,107 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 114 108 c . "ave(X)", zsto,zout) 115 109 c ENDDO 116 110 CALL histdef(nid_mth, "qaer","nb tot aer" , "n/m2", 117 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,111 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 118 112 . "ave(X)", zsto,zout) 119 113 120 114 if (clouds.eq.1) then 121 115 CALL histdef(nid_mth, "qnoy","nb tot noy" , "n/m2", 122 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,116 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 123 117 . "ave(X)", zsto,zout) 124 118 CALL histdef(nid_mth, "qgl1","V tot gl1" , "m3/m2", 125 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,119 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 126 120 . "ave(X)", zsto,zout) 127 121 CALL histdef(nid_mth, "qgl2","V tot gl2" , "m3/m2", 128 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,122 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 129 123 . "ave(X)", zsto,zout) 130 124 CALL histdef(nid_mth, "qgl3","V tot gl3" , "m3/m2", 131 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,125 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 132 126 . "ave(X)", zsto,zout) 133 127 c-------------- 134 128 c ----- SATURATION ESP NUAGES 135 129 CALL histdef(nid_mth,"ch4sat", "saturation CH4", "--", 136 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,130 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 137 131 . "ave(X)", zsto,zout) 138 132 CALL histdef(nid_mth,"c2h6sat", "saturation C2H6", "--", 139 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,133 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 140 134 . "ave(X)", zsto,zout) 141 135 CALL histdef(nid_mth,"c2h2sat", "saturation C2H2", "--", 142 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,136 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 143 137 . "ave(X)", zsto,zout) 144 138 c -------------- 145 139 c ----- RESERVOIR DE SURFACE 146 140 CALL histdef(nid_mth, "reserv", "Reservoir surface","m", 147 . iim,jj mp1,nhori, 1,1,1, -99, 32,141 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 148 142 . "ave(X)", zsto,zout) 149 143 c -------------- 150 144 c ----- ECHANGE GAZ SURF/ATM (evaporation) 151 145 CALL histdef(nid_mth, "evapch4", "Evaporation CH4","m", 152 . iim,jj mp1,nhori, 1,1,1, -99, 32,146 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 153 147 . "ave(X)", zsto,zout) 154 148 c -------------- 155 149 c ----- PRECIPITATIONS (precipitations moyennes) 156 150 CALL histdef(nid_mth,"prech4","Precip CH4","um/s", 157 . iim,jj mp1,nhori, 1,1,1, -99, 32,151 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 158 152 . "ave(X)", zsto,zout) 159 153 CALL histdef(nid_mth,"prec2h6","Precip C2H6", 160 . "um/s",iim,jj mp1,nhori, 1,1,1, -99, 32,154 . "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32, 161 155 . "ave(X)", zsto,zout) 162 156 CALL histdef(nid_mth,"prec2h2","Precip C2H2", 163 . "um/s",iim,jj mp1,nhori, 1,1,1, -99, 32,157 . "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32, 164 158 . "ave(X)", zsto,zout) 165 159 CALL histdef(nid_mth,"prenoy","Precip NOY", 166 . "um/s",iim,jj mp1,nhori, 1,1,1, -99, 32,160 . "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32, 167 161 . "ave(X)", zsto,zout) 168 162 CALL histdef(nid_mth,"preaer","Precip AER", 169 . "um/s",iim,jj mp1,nhori, 1,1,1, -99, 32,163 . "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32, 170 164 . "ave(X)", zsto,zout) 171 165 c -------------- 172 166 c ----- FLUX GLACE 173 167 CALL histdef(nid_mth,"flxgl1", "flux gl CH4", 174 . "kg/m2/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,168 . "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 175 169 . "ave(X)", zsto,zout) 176 170 CALL histdef(nid_mth,"flxgl2", "flux gl C2H6", 177 . "kg/m2/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,171 . "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 178 172 . "ave(X)", zsto,zout) 179 173 CALL histdef(nid_mth,"flxgl3", "flux gl C2H2", 180 . "kg/m2/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,174 . "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 181 175 . "ave(X)", zsto,zout) 182 176 c -------------- 183 177 c ----- Source/puits GLACE 184 178 CALL histdef(nid_mth,"solch4", "dQ gl CH4", 185 . "m3/m3",iim,jj mp1,nhori, klev,1,klev,nvert, 32,179 . "m3/m3",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 186 180 . "ave(X)", zsto,zout) 187 181 CALL histdef(nid_mth,"solc2h6", "dQ gl C2H6", 188 . "m3/m3",iim,jj mp1,nhori, klev,1,klev,nvert, 32,182 . "m3/m3",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 189 183 . "ave(X)", zsto,zout) 190 184 CALL histdef(nid_mth,"solc2h2", "dQ gl C2H2", 191 . "m3/m3",iim,jj mp1,nhori, klev,1,klev,nvert, 32,185 . "m3/m3",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 192 186 . "ave(X)", zsto,zout) 193 187 c -------------- 194 188 c ----- RAYON DES GOUTTES 195 189 CALL histdef(nid_mth,"rcldbar", "rayon moyen goutte", 196 . "m",iim,jj mp1,nhori, klev,1,klev,nvert, 32,190 . "m",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 197 191 . "ave(X)", zsto,zout) 198 192 endif … … 203 197 DO iq=nmicro+1,nqmax 204 198 CALL histdef(nid_mth, tname(iq), ttext(iq), "ppm", 205 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,199 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 206 200 . "ave(X)", zsto,zout) 207 201 ENDDO … … 209 203 c DO iq=nmicro+1,nqmax 210 204 c CALL histdef(nid_mth, "c_"//tname(iq), "c_"//ttext(iq), 211 c . "ppm/s",iim,jj mp1,nhori, klev,1,klev,nvert, 32,205 c . "ppm/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, 212 206 c . "ave(X)", zsto,zout) 213 207 c ENDDO 214 208 endif 215 209 endif 216 c 210 217 211 ENDIF !lev_histmth.GE.2 218 c 212 219 213 c------------------------------------------------------- 220 214 IF(lev_histmth.GE.3) THEN 221 c 215 222 216 cccccccccccccccccc Radiative transfer 223 c 217 224 218 c 2D 225 c 219 226 220 CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2", 227 . iim,jj mp1,nhori, 1,1,1, -99, 32,221 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 228 222 . "ave(X)", zsto1,zout) 229 c 223 230 224 CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2", 231 . iim,jj mp1,nhori, 1,1,1, -99, 32,225 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 232 226 . "ave(X)", zsto1,zout) 233 c 227 234 228 CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2", 235 . iim,jj mp1,nhori, 1,1,1, -99, 32,229 . iim,jj_nb,nhori, 1,1,1, nvert, 32, 236 230 . "ave(X)", zsto1,zout) 237 c 231 238 232 c 3D 239 c 233 240 234 CALL histdef(nid_mth, "SWnet", "Net SW flux","W/m2", 241 . iim,jj mp1,nhori, klev,1,klev,nvert,235 . iim,jj_nb,nhori, klev,1,klev,nvert, 242 236 . 32, "ave(X)", zsto1,zout) 243 c 237 244 238 CALL histdef(nid_mth, "LWnet", "Net LW flux","W/m2", 245 . iim,jj mp1,nhori, klev,1,klev,nvert,239 . iim,jj_nb,nhori, klev,1,klev,nvert, 246 240 . 32, "ave(X)", zsto1,zout) 247 c 241 248 242 c -------------- 249 243 c ----- OPACITE BRUME 250 244 DO k=7,NSPECV,10 251 write(str 1,'(i2.2)') k252 CALL histdef(nid_mth,"thv"//str 1,"Haze Opa Vis",253 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,254 . "ave(X)",zsto1,zout) 255 ENDDO 256 c 245 write(str2,'(i2.2)') k 246 CALL histdef(nid_mth,"thv"//str2,"Haze Opa Vis", 247 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 248 . "ave(X)",zsto1,zout) 249 ENDDO 250 257 251 DO k=8,NSPECI,10 258 write(str 1,'(i2.2)') k259 CALL histdef(nid_mth,"thi"//str 1,"Haze Opa IR",260 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,261 . "ave(X)",zsto1,zout) 262 ENDDO 263 c 252 write(str2,'(i2.2)') k 253 CALL histdef(nid_mth,"thi"//str2,"Haze Opa IR", 254 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 255 . "ave(X)",zsto1,zout) 256 ENDDO 257 264 258 c -------------- 265 259 c ----- EXTINCTION BRUME 266 260 DO k=7,NSPECV,10 267 write(str 1,'(i2.2)') k268 CALL histdef(nid_mth,"khv"//str 1,"Haze ext Vis ",269 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,270 . "ave(X)",zsto1,zout) 271 ENDDO 272 c 261 write(str2,'(i2.2)') k 262 CALL histdef(nid_mth,"khv"//str2,"Haze ext Vis ", 263 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 264 . "ave(X)",zsto1,zout) 265 ENDDO 266 273 267 DO k=8,NSPECI,10 274 write(str 1,'(i2.2)') k275 CALL histdef(nid_mth,"khi"//str 1,"Haze ext IR ",276 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,277 . "ave(X)",zsto1,zout) 278 ENDDO 279 c 268 write(str2,'(i2.2)') k 269 CALL histdef(nid_mth,"khi"//str2,"Haze ext IR ", 270 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 271 . "ave(X)",zsto1,zout) 272 ENDDO 273 280 274 c -------------- 281 275 c ----- OPACITE GAZ 282 276 DO k=7,NSPECV,10 283 write(str 1,'(i2.2)') k284 CALL histdef(nid_mth,"tgv"//str 1,"Gas Opa Vis",285 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,286 . "ave(X)",zsto1,zout) 287 ENDDO 288 c 277 write(str2,'(i2.2)') k 278 CALL histdef(nid_mth,"tgv"//str2,"Gas Opa Vis", 279 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 280 . "ave(X)",zsto1,zout) 281 ENDDO 282 289 283 DO k=8,NSPECI,10 290 write(str 1,'(i2.2)') k291 CALL histdef(nid_mth,"tgi"//str 1,"Haze Opa IR",292 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,293 . "ave(X)",zsto1,zout) 294 ENDDO 295 c 284 write(str2,'(i2.2)') k 285 CALL histdef(nid_mth,"tgi"//str2,"Haze Opa IR", 286 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 287 . "ave(X)",zsto1,zout) 288 ENDDO 289 296 290 c -------------- 297 291 c ----- EXTINCTION GAZ 298 292 DO k=7,NSPECV,10 299 write(str 1,'(i2.2)') k300 CALL histdef(nid_mth,"kgv"//str 1,"Gas ext Vis ",301 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,302 . "ave(X)",zsto1,zout) 303 ENDDO 304 c 293 write(str2,'(i2.2)') k 294 CALL histdef(nid_mth,"kgv"//str2,"Gas ext Vis ", 295 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 296 . "ave(X)",zsto1,zout) 297 ENDDO 298 305 299 DO k=8,NSPECI,10 306 write(str 1,'(i2.2)') k307 CALL histdef(nid_mth,"kgi"//str 1,"Gas ext IR ",308 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,309 . "ave(X)",zsto1,zout) 310 ENDDO 311 c 300 write(str2,'(i2.2)') k 301 CALL histdef(nid_mth,"kgi"//str2,"Gas ext IR ", 302 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 303 . "ave(X)",zsto1,zout) 304 ENDDO 305 312 306 c -------------- 313 307 c ----- OPACITE NUAGES 314 308 if (clouds.eq.1) then 315 309 CALL histdef(nid_mth,"tcld","Cld Opa proxy", 316 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,310 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 317 311 . "ave(X)",zsto,zout) 318 c 312 319 313 c -------------- 320 314 c ----- EXTINCTION NUAGES 321 315 CALL histdef(nid_mth,"kcld","Cld Ext proxy", 322 . "m-1",iim,jj mp1,nhori,klev,1,klev,nvert,32,316 . "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32, 323 317 . "ave(X)",zsto,zout) 324 318 endif 325 c 319 326 320 c -------------- 327 321 c ----- OCCURENCE NUAGES 328 322 do k=1,12 329 write(str 1,'(i2.2)') k330 CALL histdef(nid_mth,"occcld"//str 1,"occ cld",331 . "--",iim,jj mp1,nhori,klev,1,klev,nvert,32,323 write(str2,'(i2.2)') k 324 CALL histdef(nid_mth,"occcld"//str2,"occ cld", 325 . "--",iim,jj_nb,nhori,klev,1,klev,nvert,32, 332 326 . "ave(X)",zsto,zout) 333 327 enddo 334 c 328 335 329 ENDIF !lev_histmth.GE.3 336 c 330 337 331 c------------------------------------------------------- 338 332 IF(lev_histmth.GE.4) THEN 339 c 333 340 334 CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s", 341 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,342 . "ave(X)", zsto,zout) 343 c 335 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 336 . "ave(X)", zsto,zout) 337 344 338 CALL histdef(nid_mth, "dtphy", "Physics dT", "K/s", 345 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,346 . "ave(X)", zsto,zout) 347 c 339 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 340 . "ave(X)", zsto,zout) 341 348 342 CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s", 349 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,350 . "ave(X)", zsto,zout) 351 c 343 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 344 . "ave(X)", zsto,zout) 345 352 346 CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s", 353 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,354 . "ave(X)", zsto,zout) 355 c 347 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 348 . "ave(X)", zsto,zout) 349 356 350 CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s", 357 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,358 . "ave(X)", zsto,zout) 359 c 351 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 352 . "ave(X)", zsto,zout) 353 360 354 CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s", 361 . iim,jj mp1,nhori, klev,1,klev,nvert, 32,362 . "ave(X)", zsto,zout) 363 c 355 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 356 . "ave(X)", zsto,zout) 357 364 358 c CALL histdef(nid_mth, "dtec", "Cinetic dissip dT", "K/s", 365 c . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 366 c . "ave(X)", zsto,zout) 367 c 368 CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2", 369 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 370 . "ave(X)", zsto,zout) 371 c 372 CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2", 373 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 374 . "ave(X)", zsto,zout) 375 c 359 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 360 c . "ave(X)", zsto,zout) 361 376 362 c CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2", 377 c . iim,jj mp1,nhori, klev,1,klev,nvert, 32,378 c . "ave(X)", zsto,zout) 379 c 363 c . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 364 c . "ave(X)", zsto,zout) 365 380 366 ENDIF !lev_histmth.GE.4 381 c 367 382 368 c------------------------------------------------------- 383 369 IF(lev_histmth.GE.5) THEN 384 c 385 c 370 371 386 372 c call histdef(nid_mth, "taux", 387 373 c $ "Zonal wind stress", "Pa", 388 c $ iim,jj mp1,nhori, 1,1,1, -99, 32,374 c $ iim,jj_nb,nhori, 1,1,1, nvert, 32, 389 375 c $ "ave(X)", zsto,zout) 390 c 376 391 377 c call histdef(nid_mth, "tauy", 392 378 c $ "Meridional xind stress", "Pa", 393 c $ iim,jj mp1,nhori, 1,1,1, -99, 32,379 c $ iim,jj_nb,nhori, 1,1,1, nvert, 32, 394 380 c $ "ave(X)", zsto,zout) 395 c 381 396 382 c CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-", 397 c . iim,jj mp1,nhori, 1,1,1, -99, 32,398 c . "ave(X)", zsto,zout) 399 c 383 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 384 c . "ave(X)", zsto,zout) 385 400 386 c CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-", 401 c . iim,jj mp1,nhori, 1,1,1, -99, 32,402 c . "ave(X)", zsto,zout) 403 c 387 c . iim,jj_nb,nhori, 1,1,1, nvert, 32, 388 c . "ave(X)", zsto,zout) 389 404 390 ENDIF !lev_histmth.GE.5 405 391 c------------------------------------------------------- 406 c 392 407 393 CALL histend(nid_mth) 408 c 409 ndex2d = 0 410 ndex3d = 0 411 c 394 412 395 ENDIF ! fin de test sur ok_journe -
trunk/LMDZ.TITAN/libf/phytitan/iniphysiq.F
r841 r1056 43 43 c ------------- 44 44 45 use dimphy 46 USE comgeomphy 45 USE dimphy, only : klev 46 USE mod_grid_phy_lmdz, only : klon_glo 47 USE mod_phys_lmdz_para, only : klon_omp,klon_omp_begin, 48 & klon_omp_end,klon_mpi_begin 49 USE comgeomphy, only : airephy,cuphy,cvphy,rlond,rlatd 47 50 IMPLICIT NONE 48 #include " dimensions.h"51 #include "iniprint.h" 49 52 50 REAL prad,pg,pr,pcpp,punjours 53 REAL,INTENT(IN) :: prad ! radius of the planet (m) 54 REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2) 55 REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu 56 REAL,INTENT(IN) :: pcpp ! specific heat Cp 57 REAL,INTENT(IN) :: punjours ! length (in s) of a standard day 58 INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics 59 INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers 60 REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid 61 REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid 62 REAL,INTENT(IN) :: parea(klon_glo) ! area (m2) 63 REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u) 64 REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v) 65 INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation 66 REAL,INTENT(IN) :: ptimestep !physics time step (s) 51 67 INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called 52 INTEGER ngrid,nlayer 53 REAL plat(ngrid),plon(ngrid),parea(klon),pcu(klon),pcv(klon) 54 INTEGER pdayref 55 56 REAL ptimestep 68 69 INTEGER :: ibegin,iend,offset 70 CHARACTER (LEN=20) :: modname='iniphysiq' 71 CHARACTER (LEN=80) :: abort_message 57 72 58 73 IF (nlayer.NE.klev) THEN 59 PRINT*,'STOP in inifis' 60 PRINT*,'Probleme de dimensions :' 61 PRINT*,'nlayer = ',nlayer 62 PRINT*,'klev = ',klev 63 STOP 74 write(lunout,*) 'STOP in ',trim(modname) 75 write(lunout,*) 'Problem with dimensions :' 76 write(lunout,*) 'nlayer = ',nlayer 77 write(lunout,*) 'klev = ',klev 78 abort_message = '' 79 CALL abort_gcm (modname,abort_message,1) 64 80 ENDIF 65 81 66 IF (ngrid.NE.klon) THEN 67 PRINT*,'STOP in inifis' 68 PRINT*,'Probleme de dimensions :' 69 PRINT*,'ngrid = ',ngrid 70 PRINT*,'klon = ',klon 71 STOP 82 IF (ngrid.NE.klon_glo) THEN 83 write(lunout,*) 'STOP in ',trim(modname) 84 write(lunout,*) 'Problem with dimensions :' 85 write(lunout,*) 'ngrid = ',ngrid 86 write(lunout,*) 'klon = ',klon_glo 87 abort_message = '' 88 CALL abort_gcm (modname,abort_message,1) 72 89 ENDIF 73 90 74 airephy=parea 75 cuphy=pcu 76 cvphy=pcv 77 rlond = plon 78 rlatd = plat 91 c$OMP PARALLEL PRIVATE(ibegin,iend) 92 c$OMP+ SHARED(parea,pcu,pcv,plon,plat) 93 94 offset=klon_mpi_begin-1 95 airephy(1:klon_omp)=parea(offset+klon_omp_begin: 96 & offset+klon_omp_end) 97 cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end) 98 cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end) 99 rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end) 100 rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end) 79 101 80 102 call suphec 103 104 c$OMP END PARALLEL 105 81 106 c print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ' 82 107 c print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...' 83 108 109 c print*,'agagagagagagagagaga' 110 c print*,'klon_mpi_begin =', klon_mpi_begin 111 c print*,'klon_mpi_end =', klon_mpi_end 112 c print*,'klon_mpi =', klon_mpi 113 c print*,'klon_mpi_para_nb =', klon_mpi_para_nb 114 c print*,'klon_mpi_para_begin =', klon_mpi_para_begin 115 c print*,'klon_mpi_para_end =', klon_mpi_para_end 116 c print*,'mpi_rank =', mpi_rank 117 c print*,'mpi_size =', mpi_size 118 c print*,'mpi_root =', mpi_root 119 c print*,'klon_glo =', klon_glo 120 c print*,'is_mpi_root =',is_mpi_root 121 c print*,'is_omp_root =',is_omp_root 122 123 ! pas d'inifis ici... 124 ! est-ce que cursor est utile ? Voir avec Aymeric 125 ! cursor = klon_mpi_begin 126 ! print*, "CURSOR !!!!", mpi_rank, cursor 84 127 85 128 RETURN -
trunk/LMDZ.TITAN/libf/phytitan/init_phys_lmdz.F90
r119 r1056 3 3 ! 4 4 SUBROUTINE init_phys_lmdz(iim,jjp1,llm,nb_proc,distrib) 5 USE mod_phys_lmdz_para 5 6 USE mod_grid_phy_lmdz 6 USE dimphy 7 USE dimphy, ONLY : init_dimphy 8 USE infotrac, ONLY : type_trac 9 7 10 IMPLICIT NONE 8 11 … … 15 18 16 19 CALL init_grid_phy_lmdz(iim,jjp1,llm) 17 CALL init_dimphy(klon_glo,nbp_lev) 20 CALL init_phys_lmdz_para(iim,jjp1,nb_proc,distrib) 21 !$OMP PARALLEL 22 CALL init_dimphy(klon_omp,nbp_lev) 23 !$OMP END PARALLEL 18 24 19 25 END SUBROUTINE init_phys_lmdz -
trunk/LMDZ.TITAN/libf/phytitan/interface_surf.F90
r1055 r1056 45 45 & tsol_rad, tsurf_new, alb_new) 46 46 47 use write_field_phy 47 48 use cpdet_mod, only: cpdet 48 49 … … 159 160 CALL soil(dtime, knon, tsurf, tsoil,soilcap, soilflux) 160 161 cal(1:knon) = zcp(1:knon) / soilcap(1:knon) 162 ! for tests: 163 ! call writefield_phy('interfsurf_hq_zcp',zcp,1) 164 ! call writefield_phy('interfsurf_hq_cal',cal,1) 165 ! call writefield_phy('interfsurf_hq_soilcap',soilcap,1) 161 166 ! print*,"DIAGNOSTIC SOIL" 162 167 ! print*,"soilcap=",soilcap … … 191 196 & tsurf_new, fluxsens, dflux_s) 192 197 198 use write_field_phy 193 199 use cpdet_mod, only: t2tpot, tpot2t 194 200 … … 326 332 ENDDO 327 333 334 ! for tests: write output fields... 335 ! call writefield_phy('calcul_fluxs_d_ts',d_ts,1) 336 ! call writefield_phy('calcul_fluxs_fluxsens',fluxsens,1) 337 ! call writefield_phy('calcul_fluxs_dflux_s',dflux_s,1) 338 328 339 END SUBROUTINE calcul_fluxs 329 340 ! -
trunk/LMDZ.TITAN/libf/phytitan/muphys3D.F
r474 r1056 64 64 c------------------------------------------------------ 65 65 use dimphy 66 c use radcommon_h, only : volume,rayon,vrat,drayon,dvolume 67 USE comgeomphy, only: rlatd 68 66 69 IMPLICIT NONE 67 70 #include "dimensions.h" … … 74 77 75 78 integer iq,nmicro 76 79 real ptimestep 80 real pdpsrf(ngrid) 81 82 c a la place de radcommon_h: 77 83 common/part/vaer,raer,vrat,draer,dvaer 78 84 real vaer(nrad),raer(nrad),vrat, 79 85 & draer(nrad),dvaer(nrad) 80 81 real ptimestep82 83 real pdpsrf(ngrid)84 86 85 87 c************************************* … … 116 118 real q(ngrid,klev,nmicro) 117 119 REAL taused(klev,nrad) 118 integer jsup,jinf,h,jalt,ihor,k 120 integer jsup,jinf,h,jalt,ihor,k,im1 119 121 120 122 c microphysique * … … 146 148 IF (IPREM.eq.0) THEN 147 149 148 IF (microfi.eq.1) THEN149 IF (ngrid.ne.jjm+1) THEN150 print*,"aLeRte :"151 print*,"microfi en 2D mais ngrid.ne.jjm+1"152 print*,ngrid,jjm+1153 stop "je m'arrete..."154 ENDIF155 ELSEIF (microfi.eq.2) THEN156 150 IF (ngrid.ne.klon) THEN 157 151 print*,"aLeRte :" 158 print*,"microfi en 3Dmais ngrid.ne.klon"152 print*,"microfi, mais ngrid.ne.klon" 159 153 print*,ngrid,klon 160 stop "je m'arrete... "154 stop "je m'arrete... (muphys3D)" 161 155 ENDIF 162 ENDIF163 156 164 157 c initialisation des constantes de la microphysique : … … 183 176 call rdf() 184 177 c ici on recopie la grille dans un common specifique a la microfi... 178 c v_e = volume 179 c r_e = rayon 180 c vrat_e = vrat 181 c dr_e = drayon 182 c dv_e = dvolume 185 183 v_e = vaer 186 184 r_e = raer … … 221 219 c correpondance des couches / sens GCM > microphysique 222 220 c----------------------------------------------------- 223 c 221 222 c*************************************************************** 224 223 do IHOR=1,NGRID ! GRANDE BOUCLE HORIZONTALE / SEPARATION DES COLONNES 225 224 225 if (IHOR.eq.1) then 226 im1=1 227 else 228 im1=IHOR-1 229 endif 230 231 c*************************************************************** 232 c On refait les calculs si on est au premier point 233 c OU si on change de latitude 234 c OU si on calcule la microfi en 3D 235 c*************************************************************** 236 if((IHOR.eq.1) 237 & .or.(rlatd(IHOR).ne.rlatd(im1)) 238 & .or.(microfi.eq.2)) then 239 c*************************************************************** 226 240 227 241 c Ici, on initialise la grille verticale et les … … 415 429 endif 416 430 431 c*************************************************************** 432 else ! same latitude, we don't do calculations again 433 q(ihor,:,:) = q(im1,:,:) 434 tau_aer(ihor,:,:) = tau_aer(im1,:,:) 435 prec(ihor,:) = prec(im1,:) 436 if (clouds.eq.1) then 437 solesp(ihor,:,:) = solesp(im1,:,:) 438 flxesp_i(ihor,:,:) = flxesp_i(im1,:,:) 439 tau_drop(ihor,:) = tau_drop(im1,:) 440 gaz1(ihor,:) = gaz1(im1,:) 441 gaz2(ihor,:) = gaz2(im1,:) 442 gaz3(ihor,:) = gaz3(im1,:) 443 endif 444 endif 445 417 446 ENDDO ! Fin de la boucle IHOR 447 c*************************************************************** 418 448 419 449 102 CONTINUE ! la premiere fois, c'est une boucle vide! -
trunk/LMDZ.TITAN/libf/phytitan/n_acethylene.F
r175 r1056 95 95 #include "varmuphy.h" 96 96 97 98 97 integer ng,nalt 99 98 parameter(ng=1,nalt=llm) … … 163 162 164 163 c Variables for latent heat release 165 real lw ,cpp164 real lw 166 165 data lw / 581.e+3/ 167 data cpp/1050./ ! pour etre cohérent avec le reste... 168 save lw,cpp 166 save lw 169 167 170 168 -
trunk/LMDZ.TITAN/libf/phytitan/n_ethane.F
r175 r1056 177 177 178 178 c Variables for latent heat release 179 real lw ,cpp179 real lw 180 180 data lw / 581.e+3/ 181 c data cpp/1044./ 182 data cpp/1050./ ! pour etre cohérent avec le reste... 183 save lw,cpp 181 save lw 184 182 185 183 -
trunk/LMDZ.TITAN/libf/phytitan/n_methane.F
r175 r1056 157 157 158 158 c Variables for latent heat release 159 real lw ,cpp159 real lw 160 160 data lw / 510.e+3/ 161 c data cpp/1044./ 162 data cpp/1050./ ! pour etre cohérent avec le reste... 163 save lw,cpp 161 save lw 164 162 165 163 -
trunk/LMDZ.TITAN/libf/phytitan/optci.F
r808 r1056 2 2 use dimphy 3 3 use infotrac 4 use common_mod, only:rmcbar,xfbar,ncount,TauHID,TauCID,TauGID 4 5 #include "dimensions.h" 5 6 #include "microtab.h" … … 42 43 & TAUHV(ngrid,NSPECV),TAUCV(ngrid,NSPECV), 43 44 & TAUGV(ngrid,NSPECV) 44 45 COMMON /TAUD/ TAUHID(ngrid,NLAYER,NSPECI)46 & ,TAUCID(ngrid,NLAYER,NSPECI)47 & ,TAUGID(ngrid,NLAYER,NSPECI)48 & ,TAUHVD(ngrid,NLAYER,NSPECV)49 & ,TAUCVD(ngrid,NLAYER,NSPECV)50 & ,TAUGVD(ngrid,NLAYER,NSPECV)51 52 45 53 46 COMMON /OPTICI/ DTAUI(ngrid,NLAYER,NSPECI) … … 70 63 COMMON /CONST/RGAS,RHOP,PI,SIGMA 71 64 COMMON /part/v,rayon,vrat,dr,dv 72 73 c-----Rayons nuages et "composition" de la goutte74 c sur la grille ...75 integer ncount(ngrid,NLAYER)76 real rmcbar(ngrid,NLAYER)77 real xfbar(ngrid,NLAYER,4)78 COMMON/rnuabar/ncount,rmcbar,xfbar79 65 80 66 DIMENSION PROD(NLEVEL) … … 164 150 DO 420 K=1,NSPECI 165 151 C LETS USE THE THOLIN OPTICAL CONSTANTS FOR THE HAZE. 166 CALL THOLIN(WLNI(K),TNR,TNI) 152 c CALL THOLIN(WLNI(K),TNR,TNI) 153 CALL THOLIN_CVD(WLNI(K),TNR,TNI) 167 154 REALI(K)=TNR 168 155 XIMGI(K)=TNI*FHIR … … 293 280 TAUGI(ig,:) = TAUGI_1pt(:) 294 281 295 T AUHID(ig,:,:) = TAUHID_1pt(:,:)296 T AUCID(ig,:,:) = TAUCID_1pt(:,:)297 T AUGID(ig,:,:) = TAUGID_1pt(:,:)282 TauHID(ig,:,:) = TAUHID_1pt(:,:) 283 TauCID(ig,:,:) = TAUCID_1pt(:,:) 284 TauGID(ig,:,:) = TAUGID_1pt(:,:) 298 285 299 286 c************************************************************************ -
trunk/LMDZ.TITAN/libf/phytitan/optci_1pt_3.F
r888 r1056 12 12 & ximgi, realv, ximgv, rcldi, xicldi, rcldv, xicldv, rcldi2, 13 13 & xicldi2, rcldv2, xicldv2,real bwni, wnoi, dwni, wlni, csubp, 14 & rsfi, rsfv,f0pi, rhch4, fh2, fhaze, fhvis14 & f0pi, rhch4, fh2, fhaze, fhvis 15 15 & reali, ximgi, bwni, fhir, taufac, rcloud, fargon, rgas, rhop, 16 16 & pi, sigma, prod,reali,fhvis … … 55 55 & DWNI(NSPECI), WLNI(NSPECI) 56 56 57 COMMON /PLANT/ CSUBP, RSFI,RSFV,F0PI57 COMMON /PLANT/ CSUBP,F0PI 58 58 COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON 59 59 COMMON /CONST/RGAS,RHOP,PI,SIGMA … … 99 99 DO 100 J=1,NLAYER ! BOUCLE SUR L'ALTITUDE 100 100 c************************************************************************ 101 c print*,'ig,k,j ',ig,k,j102 101 103 102 C SET UP THE COEFFICIENT TO REDUCE MASS PATH TO STP ...SEE NOTES … … 282 281 c TAEROSCAT=xv2(j,k) 283 282 c CBAR=xv3(j,k) 284 285 c if (ig.eq.1) then286 c if (k.eq.NSPECV/2) then287 c print*,'@IR',K,J,TAEROS,TAEROSCAT,CBAR288 c stop'Pour faire des comparaisons'289 c endif290 c endif291 283 292 284 … … 337 329 TAUGAS=0.0 338 330 IF (WNOI(K) .LT. 940. ) THEN 339 c if(ig.eq.1.and.k.eq.nspecv/2) print*,'avant PIA'340 331 CALL PIA(K,TBAR,PNN,PCC,PCN,PHN) 341 c if(ig.eq.1.and.k.eq.nspecv/2) print*,'apres PIA'342 332 C HERE IS WHERE WE COULD SCALE THE PIA COEFFICEINTS TO FIT DATA 343 333 C BASED ON REGIS' NOTES. ---TGM HAS THIS ADJUST IN IT AS DEFAULT … … 360 350 C ??FLAG? HERE MUST BE WATCHED CAREFULLY 361 351 U=COLDEN(J)*6.02204E23/BMU 362 if(ig.eq.1.and.k.eq.nspecv/2) print*,'Avant GAS2'363 352 if((ylellouch).or.(.not.hcnrad)) then 364 353 CALL GAS2_NOHCN(J, KGAS,TBAR,PBAR,U,TAU2) … … 366 355 CALL GAS2(J, KGAS,TBAR,PBAR,U,TAU2) 367 356 endif 368 if(ig.eq.1.and.k.eq.nspecv/2) print*,'Apres GAS2'369 357 TAUGAS=TAUGAS+TAU2 370 358 ENDIF … … 457 445 c 195 CONTINUE 458 446 459 c IF(ig.eq.12) WRITE (6,240) TAUI_1pt(NLEVEL,K)460 447 c 200 CONTINUE 461 448 -
trunk/LMDZ.TITAN/libf/phytitan/optcv.F
r808 r1056 3 3 use dimphy 4 4 use infotrac 5 use common_mod, only:rmcbar,xfbar,ncount,TauHVD,TauCVD,TauGVD 5 6 #include "dimensions.h" 6 7 #include "microtab.h" … … 41 42 & ,TAUHV(ngrid,NSPECV) ,TAUCV(ngrid,NSPECV) 42 43 & ,TAUGV(ngrid,NSPECV) 43 44 COMMON /TAUD/ TAUHID(ngrid,NLAYER,NSPECI)45 & ,TAUCID(ngrid,NLAYER,NSPECI)46 & ,TAUGID(ngrid,NLAYER,NSPECI)47 & ,TAUHVD(ngrid,NLAYER,NSPECV)48 & ,TAUCVD(ngrid,NLAYER,NSPECV)49 & ,TAUGVD(ngrid,NLAYER,NSPECV)50 44 51 45 COMMON /OPTICV/ DTAUV(ngrid,NLAYER,NSPECV,4) … … 65 59 COMMON /CONST/ RGAS,RHOP,PI,SIGMA 66 60 COMMON /part/ v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad) 67 68 c-----Rayons nuages et "composition" de la goutte69 c sur la grille ...70 integer ncount(ngrid,NLAYER)71 real rmcbar(ngrid,NLAYER)72 real xfbar(ngrid,NLAYER,4)73 COMMON/rnuabar/ncount,rmcbar,xfbar74 61 75 62 REAL xv1(klev,NSPECV) … … 136 123 DO 130 K=1,NSPECV 137 124 C LETS USE THE OPTICAL CONSTANTS FOR THOLIN 138 CALL THOLIN(WLNV(K),TNR,TNI) 125 c CALL THOLIN(WLNV(K),TNR,TNI) 126 CALL THOLIN_CVD(WLNV(K),TNR,TNI) 139 127 REALV(K)=TNR 140 128 XIMGV(K)=TNI*FHVIS … … 228 216 TAUGV(ig,:) = TAUGV_1pt(:) 229 217 230 T AUHVD(ig,:,:) = TAUHVD_1pt(:,:)231 T AUCVD(ig,:,:) = TAUCVD_1pt(:,:)232 T AUGVD(ig,:,:) = TAUGVD_1pt(:,:)218 TauHVD(ig,:,:) = TAUHVD_1pt(:,:) 219 TauCVD(ig,:,:) = TAUCVD_1pt(:,:) 220 TauGVD(ig,:,:) = TAUGVD_1pt(:,:) 233 221 234 222 101 CONTINUE -
trunk/LMDZ.TITAN/libf/phytitan/optcv_1pt_3.F
r814 r1056 12 12 & ximgi, realv, ximgv, rcldi, xicldi, rcldv, xicldv, rcldi2, 13 13 & xicldi2, rcldv2, xicldv2,real bwni, wnoi, dwni, wlni, csubp, 14 & rsfi, rsfv,f0pi, rhch4, fh2, fhaze, fhvis14 & f0pi, rhch4, fh2, fhaze, fhvis 15 15 & reali, ximgi, bwni, fhir, taufac, rcloud, fargon, rgas, rhop, 16 16 & pi, sigma, prod,reali,fhvis … … 58 58 & ,DWNV(NSPECV),WLNV(NSPECV) 59 59 60 COMMON /PLANT/ CSUBP, RSFI,RSFV,F0PI60 COMMON /PLANT/ CSUBP,F0PI 61 61 COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON 62 62 COMMON /CONST/ RGAS,RHOP,PI,SIGMA … … 380 380 c WRITE (6,120) 381 381 c 120 FORMAT(///' OPTICAL CONSTANTS IN THE VISIBLE (@EQUATOR) ') 382 c WRITE(6,*) 'latitude:',ig383 382 c DO 200 K=1,NSPECV 384 383 c WRITE (6,190) … … 387 386 c WRITE (6,230)REALV(K),XIMGV(K) 388 387 c DO 195 J=1,NLAYER,NLAYER 389 C RECALCULATE FOR PRINT OUT ONLY, ONLY FIRST NTERM AT ig=12 (EQUATOR)390 388 c WRITE (6,220)XNUMB(J), WBARV_1pt(J,K,NT),COSBV_1pt(J,K,NT) 391 389 c & ,DTAUV_1pt(J,K,NT),TAUV_1pt(J,K,NT) -
trunk/LMDZ.TITAN/libf/phytitan/physiq.F
r1048 r1056 13 13 c 14 14 c Modifications pour la physique de Titan 15 c adaptation a partir de celle de Venus 16 c S. Lebonnois (LMD/CNRS) Mai 2008 15 c S. Lebonnois (LMD/CNRS) Juin 2013: Parallelisation 17 16 c 18 17 c --------------------------------------------------------------------- … … 28 27 c Arguments: 29 28 c 30 c nlon---- --input-I-nombre de points horizontaux31 c nlev---- --input-I-nombre de couches verticales32 c nqmax--- --input-I-nombre de traceurs33 c debut--- --input-L-variable logique indiquant le premier passage34 c lafin--- --input-L-variable logique indiquant le dernier passage35 c rjour vrai-input-R-NBjours36 c gmtime-- --input-R-temps universel dans la journee (fraction de jour)37 c pdtphys- --input-R-pas d'integration pour la physique (seconde)38 c paprs--- --input-R-pression pour chaque inter-couche (en Pa)39 c pplay--- --input-R-pression pour le mileu de chaque couche (en Pa)40 c ppk --- --input-R-fonction d'Exner au milieu de couche41 c pphi---- --input-R-geopotentiel de chaque couche (g z) (reference sol)42 c pphis--- --input-R-geopotentiel du sol43 c presnivs- -input_R_pressions approximat. des milieux couches ( en PA)44 c u------- --input-R-vitesse dans la direction X (de O a E) en m/s45 c v------- --input-R-vitesse Y (de S a N) en m/s46 c t------- --input-R-temperature (K)47 c qx------ --input-R-mass mixing ratio traceurs (kg/kg)48 c d_t_dyn- --input-R-tendance dynamique pour "t" (K/s)49 c omega--- --input-R-vitesse verticale en Pa/s29 c nlon----input-I-nombre de points horizontaux 30 c nlev----input-I-nombre de couches verticales 31 c nqmax---input-I-nombre de traceurs 32 c debut---input-L-variable logique indiquant le premier passage 33 c lafin---input-L-variable logique indiquant le dernier passage 34 c rjour---input-R-numero du jour de l'experience 35 c gmtime--input-R-temps universel dans la journee (0 a RDAY s) 36 c pdtphys-input-R-pas d'integration pour la physique (seconde) 37 c paprs---input-R-pression pour chaque inter-couche (en Pa) 38 c pplay---input-R-pression pour le mileu de chaque couche (en Pa) 39 c ppk ---input-R-fonction d'Exner au milieu de couche 40 c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol) 41 c pphis---input-R-geopotentiel du sol 42 c presnivs-input_R_pressions approximat. des milieux couches ( en PA) 43 c u-------input-R-vitesse dans la direction X (de O a E) en m/s 44 c v-------input-R-vitesse Y (de S a N) en m/s 45 c t-------input-R-temperature (K) 46 c qx------input-R-mass mixing ratio traceurs (kg/kg) 47 c d_t_dyn-input-R-tendance dynamique pour "t" (K/s) 48 c omega---input-R-vitesse verticale en Pa/s 50 49 c 51 50 c d_u-----output-R-tendance physique de "u" (m/s/s) … … 62 61 USE comgeomphy 63 62 use cpdet_mod, only: cpdet, t2tpot 63 USE mod_phys_lmdz_para, only : is_parallel,jj_nb 64 USE phys_state_var_mod ! Variables sauvegardees de la physique 65 USE iophy 66 USE common_mod, only: rmcbar,xfbar,ncount, 67 & flxesp_i,tau_drop,tau_aer,solesp,precip, 68 & evapch4,occcld_m,occcld,satch4,satc2h6,satc2h2,rmcloud, 69 & TauHID,TauHVD,TauGID,TauGVD,TauCID,TauCVD,NSPECV,NSPECI, 70 & common_init 71 72 USE moyzon_mod 73 USE write_field_phy 64 74 IMPLICIT none 65 75 c====================================================================== 66 76 c CLEFS CPP POUR LES IO 67 77 c ===================== 78 #define histday 68 79 #define histmth 69 #define histday70 80 #define histins 71 81 c====================================================================== … … 78 88 #include "iniprint.h" 79 89 #include "logic.h" 90 #include "tabcontrol.h" 80 91 #include "comorbit.h" 81 92 #include "microtab.h" 82 #include "diagmuphy.h"83 #include "tabcontrol.h"84 93 #include "itemps.h" 85 94 c====================================================================== 95 LOGICAL ok_journe ! sortir le fichier journalier 96 save ok_journe 97 c PARAMETER (ok_journe=.true.) 98 c 86 99 LOGICAL ok_mensuel ! sortir le fichier mensuel 87 100 save ok_mensuel 88 101 c PARAMETER (ok_mensuel=.true.) 89 c90 LOGICAL ok_journe ! sortir le fichier journalier91 save ok_journe92 c PARAMETER (ok_journe=.true.)93 102 c 94 103 LOGICAL ok_instan ! sortir le fichier instantane … … 121 130 REAL qx(klon,klev,nqmax) 122 131 123 REAL,save,allocatable :: t_ancien(:,:)124 REAL,save,allocatable :: u_ancien(:,:)125 LOGICAL ancien_ok126 SAVE ancien_ok127 128 132 REAL d_u_dyn(klon,klev) 129 133 REAL d_t_dyn(klon,klev) … … 137 141 REAL d_ps(klon) 138 142 139 REAL,save,allocatable :: swnet(:,:)140 REAL,save,allocatable :: lwnet(:,:)141 c142 143 c Variables propres a la physique 143 144 c 144 REAL,save,allocatable :: radsol(:) ! bilan radiatif au sol calcule par code radiatif145 145 REAL,save,allocatable :: rlev(:,:) ! altitude a chaque niveau (interface inferieure de la couche) 146 146 INTEGER,save :: itap ! compteur pour la physique 147 REAL,save,allocatable :: ftsol(:) ! temperature du sol148 REAL,save,allocatable :: ftsoil(:,:) ! temperature dans le sol149 REAL,save,allocatable :: falbe(:) ! albedo150 147 REAL delp(klon,klev) ! epaisseur d'une couche 151 148 152 CMODDEB FLOTT153 c154 c Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):155 c156 REAL,save,allocatable :: zmea(:) ! orographie moyenne157 REAL,save,allocatable :: zstd(:) ! deviation standard de l'OESM158 REAL,save,allocatable :: zsig(:) ! pente de l'OESM159 REAL,save,allocatable :: zgam(:) ! anisotropie de l'OESM160 REAL,save,allocatable :: zthe(:) ! orientation de l'OESM161 REAL,save,allocatable :: zpic(:) ! Maximum de l'OESM162 REAL,save,allocatable :: zval(:) ! Minimum de l'OESM163 REAL,save,allocatable :: rugoro(:) ! longueur de rugosite de l'OESM164 165 149 INTEGER igwd,idx(klon),itest(klon) 166 150 c … … 191 175 192 176 REAL zustrph(klon),zvstrph(klon) 193 c194 REAL,save,allocatable :: zuthe(:),zvthe(:)195 177 196 178 c Variables locales: … … 199 181 REAL cdragm(klon) ! drag coefficient pour vent 200 182 c 201 cAA Pour TRACEURS183 cAA Pour TRACEURS 202 184 cAA 203 185 REAL,save,allocatable :: source(:,:) 204 186 integer nmicro 205 187 save nmicro 188 character*8 nom 189 REAL qaer(klon,klev,nqmax) 206 190 207 191 REAL ycoefh(klon,klev) ! coef d'echange pour phytrac 208 192 REAL yu1(klon) ! vents dans la premiere couche U 209 193 REAL yv1(klon) ! vents dans la premiere couche V 210 character*8 nom211 REAL qaer(klon,klev,nqmax)212 194 213 195 REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee 214 REAL,save,allocatable :: dlw(:) ! derivee infra rouge215 REAL,save,allocatable :: fder(:) ! Derive de flux (sensible et latente)216 196 REAL ve(klon) ! integr. verticale du transport meri. de l'energie 217 197 REAL vq(klon) ! integr. verticale du transport meri. de l'eau … … 232 212 EXTERNAL radlwsw ! rayonnements solaire et infrarouge 233 213 EXTERNAL suphec ! initialiser certaines constantes 234 c 214 c EXTERNAL transp ! transport total de l'eau et de l'energie 235 215 EXTERNAL abort_gcm 236 216 EXTERNAL printflag … … 253 233 REAL flux_ec(klon,klev) ! flux de chaleur Ec 254 234 c 255 c Le rayonnement n'est pas calcule tous les pas, il faut donc256 c sauvegarder les sorties du rayonnement257 REAL,save,allocatable :: heat(:,:) ! chauffage solaire258 REAL,save,allocatable :: cool(:,:) ! refroidissement infrarouge259 REAL,save,allocatable :: dtrad(:,:) ! K s-1260 REAL,save,allocatable :: topsw(:), toplw(:)261 REAL,save,allocatable :: solsw(:), sollw(:)262 REAL,save,allocatable :: sollwdown(:) ! downward LW flux at surface263 REAL tmpout(klon,klev) ! K s-1264 265 235 REAL dtimerad 266 236 INTEGER itaprad … … 268 238 REAL zdtime 269 239 c 270 271 240 c CHIMIE 272 241 … … 278 247 279 248 REAL dist, rmu0(klon), fract(klon), pdecli 249 REAL rmu0bar(klon), fractbar(klon) 280 250 REAL zday 281 251 REAL zls,zlsdeg,zlsm1 … … 332 302 c 333 303 REAL tr_seri(klon,klev,nqmax) 304 REAL d_tr(klon,klev,nqmax) 334 305 c 335 306 c pour ioipsl 336 INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)337 REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique338 REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D339 REAL zx_tmp_2d(iim,jjmp1),zx_tmp_3d(iim,jjmp1,klev)340 REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)341 342 307 INTEGER nid_day, nid_mth, nid_ins 343 308 SAVE nid_day, nid_mth, nid_ins 344 c345 309 INTEGER nhori, nvert, idayref 346 310 REAL zsto, zout, zsto1, zsto2, zero … … 348 312 real zjulian 349 313 save zjulian 350 314 REAL tmpout(klon,klev) ! pour sorties 315 316 CHARACTER*1 str1 351 317 CHARACTER*2 str2 352 318 character*20 modname … … 383 349 REAL mangtot ! moment cinetique total 384 350 385 CHARACTER*2 str1386 387 351 c Temporaire avant de trouver mieux : 388 352 c Recuperation des TAU du TR … … 390 354 REAL t_tcld(klon,klev),t_kcld(klon,klev) 391 355 REAL t_kcvd(klon,klev) 392 c ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX393 INTEGER ngrid394 PARAMETER (ngrid=(jjm-1)*iim+2) ! = klon395 INTEGER NSPECV,NSPECI,NLAYER396 PARAMETER (NSPECV=24,NSPECI=46,NLAYER=llm)397 REAL TAUHID(ngrid,NLAYER,NSPECI)398 & ,TAUCID(ngrid,NLAYER,NSPECI)399 & ,TAUGID(ngrid,NLAYER,NSPECI)400 & ,TAUHVD(ngrid,NLAYER,NSPECV)401 & ,TAUCVD(ngrid,NLAYER,NSPECV)402 & ,TAUGVD(ngrid,NLAYER,NSPECV)403 404 COMMON /TAUD/ TAUHID,TAUCID,TAUGID,TAUHVD,TAUCVD,TAUGVD405 COMMON /PLANT/ CSUBP,F0PI406 REAL CSUBP,F0PI407 408 * common relatifs au nuages409 real rmcbar(ngrid,NLAYER),xfbar(ngrid,NLAYER,4)410 integer ncount(ngrid,NLAYER)411 COMMON/rnuabar/ncount,rmcbar,xfbar412 356 413 357 REAL ch4(klon,jjm+1),dch4(jjm+1) … … 427 371 c====================================================================== 428 372 c INITIALISATIONS 429 c================ ======================================================373 c================ 430 374 431 375 modname = 'physiq' … … 434 378 bilansmc = 0 435 379 ballons = 0 380 ! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!! 381 if (is_parallel) then 382 bilansmc = 0 383 ballons = 0 384 endif 436 385 437 386 IF (if_ebil.ge.1) THEN … … 449 398 c======================== 450 399 IF (debut) THEN 451 allocate(t_ancien(klon,klev),u_ancien(klon,klev)) 452 allocate(swnet(klon,klevp1),lwnet(klon,klevp1)) 453 allocate(radsol(klon),ftsol(klon),falbe(klon)) 454 allocate(rlev(klon,klevp1),ftsoil(klon,nsoilmx)) 455 allocate(zmea(klon),zstd(klon),zsig(klon),zgam(klon)) 456 allocate(zthe(klon),zpic(klon),zval(klon),rugoro(klon)) 457 allocate(zuthe(klon),zvthe(klon),dlw(klon),fder(klon)) 458 allocate(heat(klon,klev),cool(klon,klev)) 459 allocate(dtrad(klon,klev),topsw(klon),toplw(klon)) 460 allocate(solsw(klon),sollw(klon),sollwdown(klon)) 400 allocate(rlev(klon,klevp1)) 461 401 allocate(source(klon,nqmax)) 462 402 allocate(reservoir(klon)) … … 468 408 c appel a la lecture du physiq.def 469 409 c 470 call conf_phys(ok_mensuel,ok_journe,ok_instan,if_ebil) 471 410 call conf_phys(ok_journe, ok_mensuel, 411 . ok_instan, 412 . if_ebil) 413 414 call phys_state_var_init 415 call common_init 472 416 c 473 417 c Initialiser les compteurs: 474 418 c 475 itap 476 itaprad 419 itap = 0 420 itaprad = 0 477 421 itapchim = 0 422 423 c init rnuabar 478 424 ncount(:,:) = 0 479 425 rmcbar = 0. 426 xfbar = 0. 427 480 428 c 481 429 c Lecture startphy.nc : 482 430 c 483 c REMETTRE TOUS LES PARAMETRES POUR OROGW... A FAIRE POUR TITAN 484 CALL phyetat0 ("startphy.nc", 485 . rlatd,rlond,ftsol,ftsoil, 486 . falbe, solsw, sollw, 487 . dlw,radsol,reservoir, 488 c . zmea,zstd,zsig,zgam,zthe,zpic,zval, 489 . t_ancien, ancien_ok) 490 491 c dtime est defini dans tabcontrol.h et lu dans startphy 431 CALL phyetat0 ("startphy.nc") 432 433 c dtime est defini dans tabcontrol.h et lu dans startphy 492 434 c pdtphys est calcule a partir des nouvelles conditions: 493 435 c Reinitialisation du pas de temps physique quand changement … … 508 450 chimpas = radpas*nbapp_rad/nbapp_chim 509 451 510 CALL printflag( ok_mensuel,ok_journe, ok_instan ) 511 452 CALL printflag( ok_mensuel,ok_journe,ok_instan ) 512 453 c 513 454 c Initialiser les pas de temps: 514 455 c 515 dtimerad = dtime* FLOAT(radpas) ! pas de temps du rayonnement (s)456 dtimerad = dtime*REAL(radpas) ! pas de temps du rayonnement (s) 516 457 c PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas 517 458 518 dtimechim = dtime* FLOAT(chimpas) ! pas de temps de la chimie (s)459 dtimechim = dtime*REAL(chimpas) ! pas de temps de la chimie (s) 519 460 c PRINT*,'dtimechim,dtime,chimpas',dtimechim,dtime,chimpas 520 461 … … 526 467 c--------- 527 468 c FLOTT 528 cIF (ok_orodr) THEN529 cDO i=1,klon530 crugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)531 cENDDO532 cCALL SUGWD(klon,klev,paprs,pplay)533 cDO i=1,klon534 czuthe(i)=0.535 czvthe(i)=0.536 cif(zstd(i).gt.10.)then537 czuthe(i)=(1.-zgam(i))*cos(zthe(i))538 czvthe(i)=(1.-zgam(i))*sin(zthe(i))539 cendif540 cENDDO541 cENDIF469 IF (ok_orodr) THEN 470 DO i=1,klon 471 rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0) 472 ENDDO 473 CALL SUGWD(klon,klev,paprs,pplay) 474 DO i=1,klon 475 zuthe(i)=0. 476 zvthe(i)=0. 477 if(zstd(i).gt.10.)then 478 zuthe(i)=(1.-zgam(i))*cos(zthe(i)) 479 zvthe(i)=(1.-zgam(i))*sin(zthe(i)) 480 endif 481 ENDDO 482 ENDIF 542 483 543 484 if (bilansmc.eq.1) then … … 566 507 C TRACEURS 567 508 C source dans couche limite 568 509 source = 0.0 ! pas de source, pour l'instant 569 510 C 570 511 c Si microphysique offline, pas besoin d'avoir de traceurs microphysiques … … 586 527 print*,"nmicro=",nmicro 587 528 588 c 529 c -------------- 589 530 c Verifications: 590 c 531 c -------------- 591 532 IF ((nmicro.eq.0).and.(microfi.eq.1)) THEN 592 533 abort_message="MICROPHYSIQUE ONLINE, MAIS NMICRO=0..." … … 611 552 call abort_gcm(modname,abort_message,1) 612 553 ENDIF 613 c 614 IF (dtime*FLOAT(radpas).GT.(RDAY*0.25).AND.cycle_diurne) 554 555 IF (((moyzon_mu).and.(microfi.ne.1)).or. 556 . ((.not.moyzon_mu).and.(microfi.eq.1))) THEN 557 abort_message="Microphysic 2D and moyzon_mu not compatible" 558 write(lunout,*) "moyzon_mu=",moyzon_mu 559 write(lunout,*) "microfi=",microfi 560 call abort_gcm(modname,abort_message,1) 561 ENDIF 562 IF (((moyzon_ch).and.(.not.chimi)).or. 563 . ((.not.moyzon_ch).and.(chimi))) THEN 564 abort_message="Chemistry and moyzon_ch not compatible" 565 write(lunout,*) "moyzon_ch=",moyzon_ch 566 write(lunout,*) "chimi=",chimi 567 call abort_gcm(modname,abort_message,1) 568 ENDIF 569 570 IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne) 615 571 $ THEN 616 572 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' … … 625 581 ecrit_mth = NINT(RDAY/dtime) *nday ! tous les nday jours 626 582 IF (ok_mensuel) THEN 627 WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 583 WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 628 584 . ecrit_mth 629 585 ENDIF … … 646 602 #ifdef CPP_IOIPSL 647 603 604 #ifdef histday 605 #include "ini_histday.h" 606 #endif 607 648 608 #ifdef histmth 649 609 #include "ini_histmth.h" 650 610 #endif 651 611 652 #ifdef histday653 #include "ini_histday.h"654 #endif655 656 612 #ifdef histins 657 613 #include "ini_histins.h" … … 670 626 ENDDO 671 627 672 rmcbar = 0.673 xfbar = 0.674 675 628 ENDIF ! debut 676 629 c==================================================================== … … 719 672 C 720 673 DO i = 1, klon 721 ztsol(i) = ftsol(i) 674 ztsol(i) = ftsol(i) 722 675 ENDDO 723 676 C … … 777 730 ENDDO 778 731 732 c call WriteField_phy('physiq_pphi',pphi,klev) 733 c call WriteField_phy('physiq_pphis',pphis,1) 734 779 735 c calcul du geopotentiel aux niveaux intercouches 780 736 c ponderation des altitudes au niveau des couches en dp/p … … 796 752 DO i=1,klon 797 753 z1=(pplay(i,l-1)+paprs(i,l))/(pplay(i,l-1)-paprs(i,l)) 798 z2=(paprs(i,l) +pplay(i,l))/(paprs(i,l)-pplay(i,l))754 z2=(paprs(i,l) +pplay(i,l))/(paprs(i,l) -pplay(i,l)) 799 755 zzlev(i,l)=(z1*zzlay(i,l-1)+z2*zzlay(i,l))/(z1+z2) 800 756 ENDDO … … 804 760 ENDDO 805 761 762 ! zonal averages needed 763 if (moyzon_ch.or.moyzon_mu) then 764 765 c zzlaybar(1,:)=(zphibar(1,:)+zphisbar(1))/RG 766 c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE: 767 zzlaybar(1,:)=RG*RA*RA/(RG*RA-(zphibar(1,:)+zphisbar(1)))-RA 768 zzlevbar(1,1)=zphisbar(1)/RG 769 DO l=2,klev 770 z1=(zplaybar(1,l-1)+zplevbar(1,l))/ 771 . (zplevbar(1,l-1)-zplevbar(1,l)) 772 z2=(zplevbar(1,l) +zplaybar(1,l))/ 773 . (zplevbar(1,l) -zplaybar(1,l)) 774 zzlevbar(1,l)=(z1*zzlaybar(1,l-1)+z2*zzlaybar(1,l))/(z1+z2) 775 ENDDO 776 zzlevbar(1,klev+1)=zzlaybar(1,klev)+ 777 . (zzlaybar(1,klev)-zzlevbar(1,klev)) 778 779 DO i=2,klon 780 if (rlatd(i).ne.rlatd(i-1)) then 781 DO l=1,klev 782 c zzlaybar(i,l)=(zphibar(i,l)+zphisbar(i))/RG 783 c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE: 784 zzlaybar(i,l)=RG*RA*RA/(RG*RA-(zphibar(i,l)+zphisbar(i)))-RA 785 ENDDO 786 zzlevbar(i,1)=zphisbar(i)/RG 787 DO l=2,klev 788 z1=(zplaybar(i,l-1)+zplevbar(i,l))/ 789 . (zplevbar(i,l-1)-zplevbar(i,l)) 790 z2=(zplevbar(i,l) +zplaybar(i,l))/ 791 . (zplevbar(i,l) -zplaybar(i,l)) 792 zzlevbar(i,l)=(z1*zzlaybar(i,l-1)+z2*zzlaybar(i,l))/(z1+z2) 793 ENDDO 794 zzlevbar(i,klev+1)=zzlaybar(i,klev)+ 795 . (zzlaybar(i,klev)-zzlevbar(i,klev)) 796 else 797 zzlaybar(i,:)=zzlaybar(i-1,:) 798 zzlevbar(i,:)=zzlevbar(i-1,:) 799 endif 800 ENDDO 801 802 endif ! moyzon 803 804 c call WriteField_phy('physiq_zphi',zphi,klev) 805 c call WriteField_phy('physiq_zzlay',zzlay,klev) 806 c call WriteField_phy('physiq_zzlev',zzlev,klev+1) 806 807 c- - - - - - - - - - - - - - - - 807 808 c DIAGNOSTIQUE GRILLE VERTICALE … … 838 839 ENDDO 839 840 840 841 842 843 c==================================================================== 844 c ORBITE ET ECLAIREMENT 845 c==================================================================== 846 841 c==================================================================== 842 c Orbite et eclairement 843 c==================================================================== 847 844 848 845 c Pour TITAN: … … 856 853 857 854 c dans zenang, Ls en degres ; dans mucorr, Ls en radians 855 call mucorr(klon,zls,rlatd,rmu0bar,fractbar) 858 856 IF (cycle_diurne) THEN 859 zdtime=dtime* FLOAT(radpas) ! pas de temps du rayonnement (s)857 zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s) 860 858 CALL zenang(zlsdeg,gmtime,zdtime,rlatd,rlond,rmu0,fract) 861 859 ELSE 862 call mucorr(klon,zls,rlatd,rmu0,fract) 860 rmu0 = rmu0bar 861 fract = fractbar 863 862 ENDIF 864 865 c==================================================================== 866 c COUCHE LIMITE863 864 c==================================================================== 865 c Appeler la diffusion verticale (programme de couche limite) 867 866 c==================================================================== 868 867 … … 901 900 c print*,"sollw avant clmain=",sollw(klon/2) 902 901 903 c CLMAIN904 905 902 ! ADAPTATION GCM POUR CP(T) 903 906 904 CALL clmain(dtime,itap, 907 905 e t_seri,u_seri,v_seri, … … 911 909 $ paprs,pplay,ppk,radsol,falbe, 912 910 e solsw, sollw, sollwdown, fder, 913 e rlond, rlatd, cuphy, cvphy, 911 e rlond, rlatd, cuphy, cvphy, 914 912 e debut, lafin, 915 913 s d_t_vdf,d_u_vdf,d_v_vdf,d_ts, … … 940 938 ENDDO 941 939 942 c print*,"d_t_vdf1=",d_t_vdf(1,:)*dtime 943 c print*,"d_t_vdf2=",d_t_vdf(klon/2,:)*dtime 944 c print*,"d_t_vdf3=",d_t_vdf(klon,:)*dtime 945 c print*,"d_u_vdf=",d_u_vdf(klon/2,:)*dtime 946 c print*,"d_v_vdf=",d_v_vdf(klon/2,:)*dtime 940 c call WriteField_phy('physiq_dtvdf',d_t_vdf,klev) 941 c call WriteField_phy('physiq_duvdf',d_u_vdf,klev) 942 c call WriteField_phy('physiq_dvvdf',d_v_vdf,klev) 947 943 948 944 C TRACEURS … … 950 946 d_tr_vdf = 0. 951 947 if (iflag_trac.eq.1) then 952 DO iq=1, nqmax953 CALL cltrac(dtime,ycoefh,t_seri,954 s tr_seri(1,1,iq), 955 e paprs, pplay, 948 DO iq=1, nqmax 949 CALL cltrac(dtime,ycoefh,t_seri, 950 s tr_seri(1,1,iq),source, 951 e paprs, pplay,delp, 956 952 s d_tr_vdf(1,1,iq)) 957 958 tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq) 959 d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime ! /s 960 ENDDO 953 tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq) 954 d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime ! /s 955 ENDDO 961 956 endif 962 957 … … 976 971 c Incrementer la temperature du sol 977 972 c 978 c print*,'Tsol avant clmain:',ftsol( klon/2)973 c print*,'Tsol avant clmain:',ftsol(1) 979 974 DO i = 1, klon 980 975 ftsol(i) = ftsol(i) + d_ts(i) 981 976 ENDDO 982 977 c print*,'DTsol apres clmain:',d_ts(klon/2) 983 c print*,'Tsol apres clmain:',ftsol( klon/2)978 c print*,'Tsol apres clmain:',ftsol(1) 984 979 985 980 c Calculer la derive du flux infrarouge … … 1040 1035 d_v_ajs(:,:)= d_v_ajs(:,:)/dtime ! (m/s)/s 1041 1036 if (iflag_trac.eq.1) then 1042 tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)1043 d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime! /s1037 tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:) 1038 d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime ! /s 1044 1039 endif 1045 1046 c print*,"d_t_ajs1=",d_t_ajs(1,:)*dtime 1047 c print*,"d_t_ajs2=",d_t_ajs(klon/2,:)*dtime 1048 c print*,"d_t_ajs3=",d_t_ajs(klon,:)*dtime 1049 c print*,"d_u_ajs=",d_u_ajs(klon/2,:)*dtime 1050 c print*,"d_v_ajs=",d_v_ajs(klon/2,:)*dtime 1040 1041 c call WriteField_phy('physiq_dtajs',d_t_ajs,klev) 1042 c call WriteField_phy('physiq_duajs',d_u_ajs,klev) 1043 c call WriteField_phy('physiq_dvajs',d_v_ajs,klev) 1051 1044 1052 1045 endif … … 1090 1083 1091 1084 if (iflag_trac.eq.1) then 1085 c call WriteField_phy('physiq_qaer01', 1086 c . qaer(:,:,1),klev) 1087 c call WriteField_phy('physiq_qaer10', 1088 c . qaer(:,:,10),klev) 1089 c call WriteField_phy('physiq_tr_seri01', 1090 c . tr_seri(:,:,1),klev) 1091 c call WriteField_phy('physiq_tr_seri10', 1092 c . tr_seri(:,:,10),klev) 1093 1092 1094 c call begintime(tt0) 1095 c in phytrac call, mu0 and fract are only used in brume 1096 c so we need to pass either rmu0 ou rmu0bar depending on 1097 c moyzon_mu 1098 if (moyzon_mu) then 1093 1099 call phytrac (debut,lafin, 1094 . nqmax,nmicro,dtime,appel_chim,dtimechim, 1095 . paprs,pplay,delp,t,rmu0,fract,pdecli,zls, 1096 . yu1,yv1,zzlev,zzlay,ftsol, 1097 . tr_seri,qaer,d_tr_mph,d_tr_kim, 1098 . fclat,reservoir) 1100 . nqmax,nmicro,dtime,appel_chim,dtimechim, 1101 . paprs,pplay,delp,t,rmu0bar,fractbar,pdecli,zls, 1102 . yu1,yv1,zzlev,zzlay,ftsol, 1103 . tr_seri,qaer,d_tr_mph,d_tr_kim, 1104 . fclat,reservoir) 1105 else 1106 call phytrac (debut,lafin, 1107 . nqmax,nmicro,dtime,appel_chim,dtimechim, 1108 . paprs,pplay,delp,t,rmu0,fract,pdecli,zls, 1109 . yu1,yv1,zzlev,zzlay,ftsol, 1110 . tr_seri,qaer,d_tr_mph,d_tr_kim, 1111 . fclat,reservoir) 1112 endif 1099 1113 1100 1114 c call endtime(tt0,tt1) … … 1112 1126 tr_seri(:,:,1:nmicro) = tr_seri(:,:,1:nmicro) 1113 1127 . + d_tr_mph(:,:,1:nmicro)*dtime 1128 c call WriteField_phy('physiq_d_tr_mph01', 1129 c . d_tr_mph(:,:,1),klev) 1130 c call WriteField_phy('physiq_d_tr_mph10', 1131 c . d_tr_mph(:,:,10),klev) 1114 1132 endif 1115 1133 c PAS ELEGANT mais je n'ai pas trouve d'autres solutions : … … 1195 1213 DO i=1,klon 1196 1214 DO j=1,klev 1197 rmcbar(i,j)=rmcbar(i,j)/MAX( FLOAT(ncount(i,j)),1.)1198 xfbar(i,j,:)=xfbar(i,j,:)/MAX( FLOAT(ncount(i,j)),1.)1215 rmcbar(i,j)=rmcbar(i,j)/MAX(REAL(ncount(i,j)),1.) 1216 xfbar(i,j,:)=xfbar(i,j,:)/MAX(REAL(ncount(i,j)),1.) 1199 1217 ENDDO 1200 1218 ENDDO … … 1203 1221 c call begintime(tt0) 1204 1222 CALL radlwsw 1205 e (dist, rmu0, fract, falbe,zzlev,1223 e (dist, rmu0, fract, zzlev, 1206 1224 e paprs, pplay,ftsol, t_seri, nqmax, nmicro, 1207 c tr_seri, qaer, 1208 s heat,cool,radsol, 1209 s topsw,toplw,solsw,sollw, 1210 s sollwdown, 1211 s lwnet, swnet) 1225 c tr_seri, qaer) 1226 c print*,"apres radlwsw" 1227 1212 1228 c call endtime(tt0,tt1) 1213 1229 c ttrad=ttrad+tt1 … … 1221 1237 ENDIF 1222 1238 1223 c print*,"radsol apres radlwsw=",radsol(klon/2)1224 c print*,"solsw apres radlwsw=",solsw(klon/2)1225 c print*,"sollw apres radlwsw=",sollw(klon/2)1226 1239 itaprad = 0 1227 1240 DO k = 1, klev … … 1230 1243 ENDDO 1231 1244 ENDDO 1232 c print*,"heat (K/s) =",heat(klon/2,:) 1233 c print*,"cool (K/s) =",cool(klon/2,:) 1234 c print*,"dtrad1 (K/s) =",dtrad(1,:) 1235 c print*,"dtrad2 (K/s) =",dtrad(klon/2,:) 1236 c print*,"dtrad3 (K/s) =",dtrad(klon,:) 1237 1245 1246 c call WriteField_phy('physiq_heat',heat,klev) 1247 c call WriteField_phy('physiq_cool',cool,klev) 1248 1238 1249 ENDIF 1239 1250 itaprad = itaprad + 1 … … 1261 1272 c 1262 1273 1274 c==================================================================== 1275 c Calcul des gravity waves FLOTT 1276 c==================================================================== 1277 c 1278 if (ok_orodr.or.ok_gw_nonoro) then 1279 c CALCUL DE N2 1280 do i=1,klon 1281 do k=2,klev 1282 ztlev(i,k) = (t_seri(i,k)+t_seri(i,k-1))/2. 1283 zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1)) 1284 enddo 1285 enddo 1286 call t2tpot(klon*klev,ztlev, ztetalev,zpklev) 1287 call t2tpot(klon*klev,t_seri,ztetalay,ppk) 1288 do i=1,klon 1289 do k=2,klev 1290 zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1) 1291 zdzlev(i,k) = (zphi(i,k)-zphi(i,k-1))/RG 1292 zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k)) 1293 zn2(i,k) = max(zn2(i,k),1.e-12) ! securite 1294 enddo 1295 zn2(i,1) = 1.e-12 ! securite 1296 enddo 1297 1298 endif 1299 1300 c ----------------------------ORODRAG 1301 IF (ok_orodr) THEN 1302 c 1303 c selection des points pour lesquels le shema est actif: 1304 igwd=0 1305 DO i=1,klon 1306 itest(i)=0 1307 c IF ((zstd(i).gt.10.0)) THEN 1308 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN 1309 itest(i)=1 1310 igwd=igwd+1 1311 idx(igwd)=i 1312 ENDIF 1313 ENDDO 1314 c igwdim=MAX(1,igwd) 1315 c 1316 c A ADAPTER POUR VENUS!!! 1317 CALL drag_noro(klon,klev,dtime,paprs,pplay,zphi,zn2, 1318 e zmea,zstd, zsig, zgam, zthe,zpic,zval, 1319 e igwd,idx,itest, 1320 e t_seri, u_seri, v_seri, 1321 s zulow, zvlow, zustrdr, zvstrdr, 1322 s d_t_oro, d_u_oro, d_v_oro) 1323 1324 c print*,"d_u_oro=",d_u_oro(klon/2,:) 1325 c ajout des tendances 1326 t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:) 1327 d_t_oro(:,:)= d_t_oro(:,:)/dtime ! K/s 1328 u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:) 1329 d_u_oro(:,:)= d_u_oro(:,:)/dtime ! (m/s)/s 1330 v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:) 1331 d_v_oro(:,:)= d_v_oro(:,:)/dtime ! (m/s)/s 1332 c 1333 ELSE 1334 d_t_oro = 0. 1335 d_u_oro = 0. 1336 d_v_oro = 0. 1337 zustrdr = 0. 1338 zvstrdr = 0. 1339 c 1340 ENDIF ! fin de test sur ok_orodr 1341 c 1342 c ----------------------------OROLIFT 1343 IF (ok_orolf) THEN 1344 print*,"ok_orolf NOT IMPLEMENTED !" 1345 stop 1346 c 1347 c selection des points pour lesquels le shema est actif: 1348 igwd=0 1349 DO i=1,klon 1350 itest(i)=0 1351 IF ((zpic(i)-zmea(i)).GT.100.) THEN 1352 itest(i)=1 1353 igwd=igwd+1 1354 idx(igwd)=i 1355 ENDIF 1356 ENDDO 1357 c igwdim=MAX(1,igwd) 1358 c 1359 c A ADAPTER POUR VENUS ET TITAN!!! 1360 c CALL lift_noro(klon,klev,dtime,paprs,pplay, 1361 c e rlatd,zmea,zstd,zpic,zgam,zthe,zpic,zval, 1362 c e igwd,idx,itest, 1363 c e t_seri, u_seri, v_seri, 1364 c s zulow, zvlow, zustrli, zvstrli, 1365 c s d_t_lif, d_u_lif, d_v_lif ) 1366 1367 c 1368 c ajout des tendances 1369 t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:) 1370 d_t_lif(:,:)= d_t_lif(:,:)/dtime ! K/s 1371 u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:) 1372 d_u_lif(:,:)= d_u_lif(:,:)/dtime ! (m/s)/s 1373 v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:) 1374 d_v_lif(:,:)= d_v_lif(:,:)/dtime ! (m/s)/s 1375 c 1376 ELSE 1377 d_t_lif = 0. 1378 d_u_lif = 0. 1379 d_v_lif = 0. 1380 zustrli = 0. 1381 zvstrli = 0. 1382 c 1383 ENDIF ! fin de test sur ok_orolf 1384 1385 c ---------------------------- NON-ORO GRAVITY WAVES 1386 IF(ok_gw_nonoro) then 1387 1388 abort_message="Option non developpee pour Titan" 1389 call abort_gcm(modname,abort_message,1) 1390 c A FAIRE POUR TITAN 1391 c call flott_gwd_ran(klon,klev,dtime,pplay,zn2, 1392 c e t_seri, u_seri, v_seri, 1393 c o zustrhi,zvstrhi, 1394 c o d_t_hin, d_u_hin, d_v_hin) 1395 1396 c ajout des tendances 1397 1398 c t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:) 1399 c d_t_hin(:,:)= d_t_hin(:,:)/dtime ! K/s 1400 c u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:) 1401 c d_u_hin(:,:)= d_u_hin(:,:)/dtime ! (m/s)/s 1402 c v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:) 1403 c d_v_hin(:,:)= d_v_hin(:,:)/dtime ! (m/s)/s 1404 1405 ELSE 1406 d_t_hin = 0. 1407 d_u_hin = 0. 1408 d_v_hin = 0. 1409 zustrhi = 0. 1410 zvstrhi = 0. 1411 1412 ENDIF ! fin de test sur ok_gw_nonoro 1413 1414 c==================================================================== 1415 c Transport de ballons 1416 c==================================================================== 1417 if (ballons.eq.1) then 1418 CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond, 1419 c C t,pplay,u,v,pphi) ! alt above surface (smoothed for GCM) 1420 C t,pplay,u,v,zphi) ! alt above planet average radius 1421 endif !ballons 1422 1423 c==================================================================== 1424 c Bilan de mmt angulaire 1425 c==================================================================== 1426 if (bilansmc.eq.1) then 1427 CMODDEB FLOTT 1428 C CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE) 1429 C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE 1430 1431 DO i = 1, klon 1432 zustrph(i)=0. 1433 zvstrph(i)=0. 1434 zustrcl(i)=0. 1435 zvstrcl(i)=0. 1436 ENDDO 1437 DO k = 1, klev 1438 DO i = 1, klon 1439 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* 1440 c (paprs(i,k)-paprs(i,k+1))/rg 1441 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* 1442 c (paprs(i,k)-paprs(i,k+1))/rg 1443 zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)* 1444 c (paprs(i,k)-paprs(i,k+1))/rg 1445 zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)* 1446 c (paprs(i,k)-paprs(i,k+1))/rg 1447 ENDDO 1448 ENDDO 1449 1450 CALL aaam_bud (27,klon,klev,rjourvrai,gmtime, 1451 C ra,rg,romega, 1452 C rlatd,rlond,pphis, 1453 C zustrdr,zustrli,zustrcl, 1454 C zvstrdr,zvstrli,zvstrcl, 1455 C paprs,u,v) 1456 1457 CCMODFIN FLOTT 1458 endif !bilansmc 1459 1460 c==================================================================== 1461 c==================================================================== 1462 c Calculer le transport de l'eau et de l'energie (diagnostique) 1463 c 1464 c A REVOIR POUR VENUS ET TITAN... 1465 c 1466 c CALL transp (paprs,ftsol, 1467 c e t_seri, q_seri, u_seri, v_seri, zphi, 1468 c s ve, vq, ue, uq) 1469 c 1263 1470 c==================================================================== 1264 1471 c+jld ec_conser … … 1281 1488 c-jld ec_conser 1282 1489 c==================================================================== 1283 1284 1490 IF (if_ebil.ge.1) THEN 1285 1491 ztit='after physic' … … 1301 1507 END IF 1302 1508 C 1303 c====================================================================1304 c Calcul des gravity waves FLOTT1305 c====================================================================1306 c1307 c if (ok_orodr.or.ok_gw_nonoro) then1308 cc CALCUL DE N21309 c do i=1,klon1310 c do k=2,klev1311 c ztlev(i,k) = (t_seri(i,k)+t_seri(i,k-1))/2.1312 c zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))1313 c enddo1314 c enddo1315 c call t2tpot(klon*klev,ztlev, ztetalev,zpklev)1316 c call t2tpot(klon*klev,t_seri,ztetalay,ppk)1317 c do i=1,klon1318 c do k=2,klev1319 c zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)1320 c zdzlev(i,k) = (zphi(i,k)-zphi(i,k-1))/RG1321 c zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))1322 c zn2(i,k) = max(zn2(i,k),1.e-12) ! securite1323 c enddo1324 c enddo1325 c1326 c endif1327 c1328 cc ----------------------------ORODRAG1329 c IF (ok_orodr) THEN1330 cc1331 cc selection des points pour lesquels le shema est actif:1332 c igwd=01333 c DO i=1,klon1334 c itest(i)=01335 cc IF ((zstd(i).gt.10.0)) THEN1336 c IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN1337 c itest(i)=11338 c igwd=igwd+11339 c idx(igwd)=i1340 c ENDIF1341 c ENDDO1342 cc igwdim=MAX(1,igwd)1343 cc1344 cc A ADAPTER POUR TITAN !!!1345 c CALL drag_noro(klon,klev,dtime,paprs,pplay,zphi,zn2,1346 c e zmea,zstd, zsig, zgam, zthe,zpic,zval,1347 c e igwd,idx,itest,1348 c e t_seri, u_seri, v_seri,1349 c s zulow, zvlow, zustrdr, zvstrdr,1350 c s d_t_oro, d_u_oro, d_v_oro)1351 c1352 cc ajout des tendances1353 c t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)1354 c d_t_oro(:,:)= d_t_oro(:,:)/dtime ! K/s1355 c u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)1356 c d_u_oro(:,:)= d_u_oro(:,:)/dtime ! (m/s)/s1357 c v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)1358 c d_v_oro(:,:)= d_v_oro(:,:)/dtime ! (m/s)/s1359 cc1360 c ELSE1361 c d_t_oro = 0.1362 c d_u_oro = 0.1363 c d_v_oro = 0.1364 c zustrdr = 0.1365 c zvstrdr = 0.1366 cc1367 c ENDIF ! fin de test sur ok_orodr1368 cc1369 cc ----------------------------OROLIFT1370 c IF (ok_orolf) THEN1371 cc1372 cc selection des points pour lesquels le shema est actif:1373 c igwd=01374 c DO i=1,klon1375 c itest(i)=01376 c IF ((zpic(i)-zmea(i)).GT.100.) THEN1377 c itest(i)=11378 c igwd=igwd+11379 c idx(igwd)=i1380 c ENDIF1381 c ENDDO1382 cc igwdim=MAX(1,igwd)1383 cc1384 cc A ADAPTER POUR VENUS!!!1385 cc CALL lift_noro(klon,klev,dtime,paprs,pplay,1386 cc e rlatd,zmea,zstd,zpic,zgam,zthe,zpic,zval,1387 cc e igwd,idx,itest,1388 cc e t_seri, u_seri, v_seri,1389 cc s zulow, zvlow, zustrli, zvstrli,1390 cc s d_t_lif, d_u_lif, d_v_lif )1391 c1392 cc1393 cc ajout des tendances1394 c t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)1395 c d_t_lif(:,:)= d_t_lif(:,:)/dtime ! K/s1396 c u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)1397 c d_u_lif(:,:)= d_u_lif(:,:)/dtime ! (m/s)/s1398 c v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)1399 c d_v_lif(:,:)= d_v_lif(:,:)/dtime ! (m/s)/s1400 cc1401 c ELSE1402 c d_t_lif = 0.1403 c d_u_lif = 0.1404 c d_v_lif = 0.1405 c zustrli = 0.1406 c zvstrli = 0.1407 cc1408 c ENDIF ! fin de test sur ok_orolf1409 c1410 cc ---------------------------- NON-ORO GRAVITY WAVES1411 c IF(ok_gw_nonoro) then1412 c1413 c call flott_gwd_ran(klon,klev,dtime,pplay,zn2,1414 c e t_seri, u_seri, v_seri,1415 c o zustrhi,zvstrhi,1416 c o d_t_hin, d_u_hin, d_v_hin)1417 c1418 cc ajout des tendances1419 c1420 c t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)1421 c d_t_hin(:,:)= d_t_hin(:,:)/dtime ! K/s1422 c u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)1423 c d_u_hin(:,:)= d_u_hin(:,:)/dtime ! (m/s)/s1424 c v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)1425 c d_v_hin(:,:)= d_v_hin(:,:)/dtime ! (m/s)/s1426 c1427 c ELSE1428 c d_t_hin = 0.1429 c d_u_hin = 0.1430 c d_v_hin = 0.1431 c zustrhi = 0.1432 c zvstrhi = 0.1433 c1434 c ENDIF ! fin de test sur ok_gw_nonoro1435 c1436 c====================================================================1437 c Transport de ballons1438 c====================================================================1439 if (ballons.eq.1) then1440 CALL ballon(30,pdtphys,rjourvrai,gmtime*RDAY,rlatd,rlond,1441 c C t,pplay,u,v,pphi) ! alt above surface (smoothed for GCM)1442 C t,pplay,u,v,zphi) ! alt above planet average radius1443 endif !ballons1444 1445 c====================================================================1446 c Bilan de mmt angulaire1447 c====================================================================1448 if (bilansmc.eq.1) then1449 CMODDEB FLOTT1450 C CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)1451 C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE1452 1453 DO i = 1, klon1454 zustrph(i)=0.1455 zvstrph(i)=0.1456 zustrcl(i)=0.1457 zvstrcl(i)=0.1458 ENDDO1459 DO k = 1, klev1460 DO i = 1, klon1461 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*1462 c (paprs(i,k)-paprs(i,k+1))/rg1463 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*1464 c (paprs(i,k)-paprs(i,k+1))/rg1465 zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*1466 c (paprs(i,k)-paprs(i,k+1))/rg1467 zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*1468 c (paprs(i,k)-paprs(i,k+1))/rg1469 ENDDO1470 ENDDO1471 1472 CALL aaam_bud (27,klon,klev,rjourvrai,gmtime*RDAY,1473 C ra,rg,romega,1474 C rlatd,rlond,pphis,1475 C zustrdr,zustrli,zustrcl,1476 C zvstrdr,zvstrli,zvstrcl,1477 C paprs,u,v)1478 1479 CCMODFIN FLOTT1480 endif !bilansmc1481 1482 1509 c======================================================================= 1483 1510 c SORTIES … … 1493 1520 ENDDO 1494 1521 ENDDO 1495 c print*,"vnatphy=",v(705,:)1496 c print*,"unatphy=",u(705,:)1497 1522 c 1498 1523 DO iq = 1, nqmax … … 1507 1532 c Calcul moment cinetique 1508 1533 c------------------------ 1509 c TEST 1534 c TEST... 1510 1535 c mangtot = 0.0 1511 1536 c DO k = 1, klev … … 1513 1538 c mang(i,k) = RA*cos(rlatd(i)*RPI/180.) 1514 1539 c . *(u_seri(i,k)+RA*cos(rlatd(i)*RPI/180.)*ROMEGA) 1515 c . *airephy(i)* delp(i,k)/RG1540 c . *airephy(i)*(paprs(i,k)-paprs(i,k+1))/RG 1516 1541 c mangtot=mangtot+mang(i,k) 1517 1542 c ENDDO … … 1536 1561 #ifdef CPP_IOIPSL 1537 1562 1563 #ifdef histday 1564 #include "write_histday.h" 1565 #endif 1566 1538 1567 #ifdef histmth 1539 1568 #include "write_histmth.h" 1540 1569 #endif 1541 1570 1542 #ifdef histday1543 #include "write_histday.h"1544 #endif1545 1546 1571 #ifdef histins 1547 1572 #include "write_histins.h" 1548 1573 #endif 1549 1574 1550 1575 #endif 1551 1576 … … 1557 1582 itau_phy = itau_phy + itap 1558 1583 lsinit = zlsdeg 1559 c REMETTRE TOUS LES PARAMETRES POUR OROGW... A FAIRE POUR TITAN 1560 CALL phyredem ("restartphy.nc", 1561 . rlatd, rlond, ftsol, ftsoil, 1562 . falbe, 1563 . solsw, sollw,dlw, 1564 . radsol,reservoir, 1565 c . zmea,zstd,zsig,zgam,zthe,zpic,zval, 1566 . t_ancien) 1567 1584 CALL phyredem ("restartphy.nc") 1585 1568 1586 c--------------FLOTT 1569 1587 CMODEB LOTT … … 1591 1609 ENDIF 1592 1610 1593 1594 1611 RETURN 1595 1612 END -
trunk/LMDZ.TITAN/libf/phytitan/phytrac.F
r888 r1056 16 16 c nqmax--------input-I-nombre de traceurs (total) 17 17 c nmicro-------input-I-nombre de traceurs microphysiques !! doivent etre toujours en premiers!! 18 c ptimestep----input-R-pas d 'integration pour la physique (seconde)18 c ptimestep----input-R-pas d integration pour la physique (seconde) 19 19 c appkim-------input-I-appel a la chimie 20 20 c dtkim--------input-R-pas de temps chimique (seconde) … … 40 40 USE infotrac 41 41 use dimphy 42 USE common_mod, only: rmcbar,xfbar,ncount, 43 & flxesp_i,tau_drop,tau_aer,solesp,precip, 44 & evapch4,occcld_m,occcld,satch4,satc2h6,satc2h2,rmcloud 45 USE moyzon_mod 42 46 IMPLICIT none 43 47 #include "dimensions.h" … … 46 50 #include "microtab.h" 47 51 #include "varmuphy.h" 48 #include "diagmuphy.h"49 52 #include "itemps.h" 53 #include "logic.h" 50 54 51 55 c====================================================================== … … 72 76 REAL prec(klon,5) 73 77 74 c ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX75 INTEGER ngrid,NLAYER76 PARAMETER (ngrid=(jjm-1)*iim+2) ! = klon77 PARAMETER (NLAYER=llm) ! = klev78 * common relatifs au nuages79 real rmcbar(ngrid,NLAYER),xfbar(ngrid,NLAYER,4)80 integer ncount(ngrid,NLAYER)81 COMMON/rnuabar/ncount,rmcbar,xfbar82 83 78 REAL rcloud(klon,klev,nrad),xfrac(klon,klev,4) 84 79 … … 91 86 92 87 c grandeurs en moyennes zonales 93 REAL zplev( jjm+1,klev+1),zplay(jjm+1,klev),ztsol(jjm+1)94 REAL zzlev( jjm+1,klev+1),zzlay(jjm+1,klev)95 REAL ztemp( jjm+1,klev),zmu0(jjm+1),zfract(jjm+1)88 REAL zplev(klon,klev+1),zplay(klon,klev) 89 REAL zzlev(klon,klev+1),zzlay(klon,klev) 90 REAL ztemp(klon,klev), delpbar(klon,klev) 96 91 real temp_eq(klev),press_eq(klev) 97 REAL zqaer(jjm+1,klev,nqmax) ! et non nmicro... Permet nmicro=0. 98 REAL zqaer0(jjm+1,klev,nqmax) 99 REAL zdqmufi(jjm+1,klev,nqmax) 100 REAL ychim(jjm+1,klev,nqmax-nmicro) 101 REAL zgaz1(jjm+1,klev),zgaz2(jjm+1,klev),zgaz3(jjm+1,klev) 102 REAL zgaz10(jjm+1,klev),zgaz20(jjm+1,klev),zgaz30(jjm+1,klev) 92 REAL qaer0bar(klon,klev,nqmax) ! et non nmicro... Permet nmicro=0. 93 REAL zdqmufi(klon,klev,nqmax) 94 REAL ychim(klon,klev,nqmax-nmicro) 103 95 c La saturation n est calculee qu une seule fois: sauvegarde qysat 104 96 c La chimie n est pas calculee tous les pas, il faut donc … … 109 101 integer i,j,k,l,iq,ig0 110 102 111 REAL zprec(jjm+1,5),zsolesp(jjm+1,klev,3),112 & zflxesp_i(jjm+1,klev,3)113 REAL ztau_drop(jjm+1,klev),ztau_aer(jjm+1,klev,nrad)114 c115 103 c indice des esp chimiques utilisees dans la microfi 116 104 integer icldch4,icldc2h6,icldc2h2 … … 121 109 REAL tmp,ex,kmin,kmax,dqsq 122 110 REAL dqch4 123 c REAL ch4(jjm+1),ch4b(jjm+1),dch4(jjm+1),ch4c(jjm+1,llm)124 c integer ich4125 c common/ch4ind/ich4126 111 127 112 c====================================================================== … … 129 114 130 115 if (firstcall) then 131 allocate(qysat(klev,nqmax-nmicro),pdyfi( jjm+1,klev,nqmax-nmicro))116 allocate(qysat(klev,nqmax-nmicro),pdyfi(klon,klev,nqmax-nmicro)) 132 117 133 118 c -------- Quelques verifications au demarrage sur les tailles des tableaux. … … 156 141 ENDIF 157 142 158 endif 143 endif ! firstcall 159 144 160 145 c RAZ des sorties : les moyennes se font directement dans IOIPSL : … … 177 162 c ------------------- 178 163 c Gestion de la temperature et de la pression : 164 c Utilisation des moyennes zonales: 165 179 166 c soit la chimie est active, soit la microphysique se fait en 2D. 180 167 IF (chimi.or.microfi.eq.1) THEN 181 182 zplev = 0.0 183 zplay = 0.0 184 zzlev = 0.0 185 zzlay = 0.0 186 ztemp = 0.0 187 zqaer = 0.0 168 zplev(:,:) = zplevbar(:,:) 169 zplay(:,:) = zplaybar(:,:) 170 zzlev(:,:) = zzlevbar(:,:) 171 zzlay(:,:) = zzlaybar(:,:) 172 ztemp(:,:) = ztfibar(:,:) 188 173 ychim = 0.0 189 zmu0 = 0.0 190 zfract= 0.0 191 zgaz1 = 0.0 192 zgaz2 = 0.0 193 zgaz3 = 0.0 194 zprec = 0.0 195 zflxesp_i = 0.0 196 ztau_drop = 0.0 197 ztau_aer = 0.0 198 zsolesp = 0.0 199 200 do l=1,llm+1 201 zplev(1,l) = pplev(1,l) 202 zzlev(1,l) = pzlev(1,l) 203 do j=2,jjm 204 ig0=1+(j-2)*iim 205 do i=1,iim 206 zplev(j,l) = zplev(j,l) + pplev(ig0+i,l)/iim 207 zzlev(j,l) = zzlev(j,l) + pzlev(ig0+i,l)/iim 208 enddo 209 enddo 210 zplev(jjm+1,l) = pplev(klon,l) 211 zzlev(jjm+1,l) = pzlev(klon,l) 212 enddo 213 214 do l=1,llm 215 ztemp(1,l) = ptemp(1,l) 216 zplay(1,l) = pplay(1,l) 217 zzlay(1,l) = pzlay(1,l) 218 do j=2,jjm 219 ig0=1+(j-2)*iim 220 do i=1,iim 221 ztemp(j,l) = ztemp(j,l) + ptemp(ig0+i,l)/iim 222 zplay(j,l) = zplay(j,l) + pplay(ig0+i,l)/iim 223 zzlay(j,l) = zzlay(j,l) + pzlay(ig0+i,l)/iim 224 enddo 225 enddo 226 ztemp(jjm+1,l) = ptemp(klon,l) 227 zplay(jjm+1,l) = pplay(klon,l) 228 zzlay(jjm+1,l) = pzlay(klon,l) 229 temp_eq = ztemp((jjm+1)/2,:) 230 press_eq = zplay((jjm+1)/2,:)/100. ! en mbar 231 enddo 232 233 ENDIF ! chimi or microfi=1 234 235 c ----------------------------- 236 c Gestion des variables de la microphysique : 237 c 238 c ------------------- 239 if (microfi.ge.1) then 240 241 c Traceurs microphysiques: passage en extensif: n/kg --> n/m^2 (2D ou 3D passage obligatoire) 242 DO iq=1,nmicro 243 c print*,tname(iq) 174 ENDIF 175 176 c Si la microphysique est faite en 2D: 177 IF (microfi.eq.1) THEN 244 178 DO l=1,llm 245 179 DO i = 1, klon 246 qaer(i,l,iq) = tr_seri(i,l,iq)*delp(i,l)/RG180 delpbar(i,l) = zplevbar(i,l) - zplevbar(i,l+1) 247 181 ENDDO 248 182 ENDDO 249 ENDDO 250 c copie du tableau de traceur : 251 qaer0(:,:,:)=qaer(:,:,:) 252 c 183 c Traceurs microphysiques: passage en extensif: n/kg --> n/m^2 184 DO iq=1,nmicro 185 qaer(:,:,iq) = zqfibar(:,:,iq)*delpbar(:,:)/RG 186 qaer0(:,:,iq)= tr_seri(:,:,iq)*delp(:,:)/RG 187 qaer0bar(:,:,iq) = qaer(:,:,iq) 188 ENDDO 189 ENDIF 190 191 c Si la microphysique est faite en 3D: 192 IF (microfi.eq.2) THEN 193 zplev(:,:) = pplev(:,:) 194 zplay(:,:) = pplay(:,:) 195 zzlev(:,:) = pzlev(:,:) 196 zzlay(:,:) = pzlay(:,:) 197 ztemp(:,:) = ptemp(:,:) 198 c Traceurs microphysiques: passage en extensif: n/kg --> n/m^2 199 DO iq=1,nmicro 200 qaer(:,:,iq) = tr_seri(:,:,iq)*delp(:,:)/RG 201 qaer0(:,:,iq)= tr_seri(:,:,iq)*delp(:,:)/RG 202 ENDDO 203 ENDIF 204 205 do l=1,llm 206 temp_eq = tmoy 207 press_eq = playmoy/100. ! en mbar 208 enddo 209 253 210 c ------------------- 254 211 c Extraction des gaz pour les nuages 255 c 212 IF ((microfi.ge.1).and.(clouds.eq.1)) THEN 213 256 214 c recuperation des indices des gaz qui nous interesse 257 215 if (firstcall) then 258 if (clouds.eq.1) then259 216 icldch4=-1 260 217 icldc2h6=-1 … … 279 236 STOP 280 237 endif 281 endif ! clouds=1282 238 endif ! firstcall 283 239 … … 286 242 c On le fait ici pour les sortir dans physiq.F sans avoir a surcharger la routine. 287 243 c Elles passent ensuite dans un common pour passer dans les I/O. 288 c 289 c------------------------------------------- 290 IF (clouds.eq.1) THEN 244 291 245 DO l=1,llm 292 246 DO i = 1, klon … … 299 253 call c2h2sat(ptemp(i,l),pplay(i,l),tmp) 300 254 satc2h2(i,l) =tr_seri(i,l,icldc2h2)/(tmp*28./26.) 301 302 255 ENDDO 303 256 ENDDO 304 257 305 258 c Copie des gaz (en 3D) <== UNIQUEMENT SI ON FAIT DES NUAGES 306 gaz1(:,:) = tr_seri(:,:,icldch4) 307 gaz2(:,:) = tr_seri(:,:,icldc2h6) 308 gaz3(:,:) = tr_seri(:,:,icldc2h2) 309 310 ENDIF ! clouds=1 259 if (moyzon_mu) then 260 gaz1(:,:) = zqfibar(:,:,icldch4) 261 gaz2(:,:) = zqfibar(:,:,icldc2h6) 262 gaz3(:,:) = zqfibar(:,:,icldc2h2) 263 else 264 gaz1(:,:) = tr_seri(:,:,icldch4) 265 gaz2(:,:) = tr_seri(:,:,icldc2h6) 266 gaz3(:,:) = tr_seri(:,:,icldc2h2) 267 endif 311 268 312 endif ! microfi.ge.1 313 314 c ------------------- 315 c Si microfi = 1 on est en 2D : 316 c conversion des inputs de muphys 317 IF (microfi.eq.1) THEN 318 319 zmu0(1) = pmu0(1) 320 zfract(1) = pfract(1) 321 do j=2,jjm 322 ig0=1+(j-2)*iim 323 do i=1,iim 324 zmu0(j) = zmu0(j) + pmu0(ig0+i)/iim 325 zfract(j) = zfract(j) + pfract(ig0+i)/iim 326 enddo 327 enddo 328 zmu0(jjm+1) = pmu0(klon) 329 zfract(jjm+1) = pfract(klon) 330 c 331 c traceurs 3D --> 2D 332 c 333 do iq=1,nqmax 334 do l=1,llm 335 zqaer(1,l,iq) = qaer(1,l,iq) 336 do j=2,jjm 337 ig0=1+(j-2)*iim 338 do i=1,iim 339 zqaer(j,l,iq) = zqaer(j,l,iq) + qaer(ig0+i,l,iq)/iim 340 enddo 341 enddo 342 zqaer(jjm+1,l,iq) = qaer(klon,l,iq) 343 enddo 344 enddo 345 c copie du tableau de traceur 346 zqaer0(:,:,:) = zqaer(:,:,:) 347 c 348 c gaz 3D --> 2D <=== UNIQUEMENT SI ON FAIT DES NUAGES. 349 c 350 if (clouds.eq.1) then 351 do l=1,llm 352 zgaz1(1,l) = gaz1(1,l) 353 zgaz2(1,l) = gaz2(1,l) 354 zgaz3(1,l) = gaz3(1,l) 355 do j=2,jjm 356 ig0=1+(j-2)*iim 357 do i=1,iim 358 zgaz1(j,l) = zgaz1(j,l) + gaz1(ig0+i,l)/iim 359 zgaz2(j,l) = zgaz2(j,l) + gaz2(ig0+i,l)/iim 360 zgaz3(j,l) = zgaz3(j,l) + gaz3(ig0+i,l)/iim 361 enddo 362 enddo 363 zgaz1(jjm+1,l) = gaz1(klon,l) 364 zgaz2(jjm+1,l) = gaz2(klon,l) 365 zgaz3(jjm+1,l) = gaz3(klon,l) 366 enddo 367 368 zgaz10=zgaz1 369 zgaz20=zgaz2 370 zgaz30=zgaz3 371 endif ! clouds=1 372 373 endif ! microfi=1 269 endif ! microfi.ge.1 + clouds.eq.1 270 c ------------------- 374 271 375 272 c AUTRES TRACEURS 376 273 377 274 if (nqmax.gt.nmicro) then 378 do iq=nmicro+1,nqmax 379 do l=1,llm 380 ychim(1,l,iq-nmicro) = tr_seri(1,l,iq) 381 do j=2,jjm 382 ig0=1+(j-2)*iim 383 do i=1,iim 384 ychim(j,l,iq-nmicro) = ychim(j,l,iq-nmicro) 385 . + tr_seri(ig0+i,l,iq)/iim 386 enddo 387 enddo 388 ychim(jjm+1,l,iq-nmicro) = tr_seri(klon,l,iq) 275 do iq=nmicro+1,nqmax 276 if (moyzon_ch) then 277 ychim(:,:,iq-nmicro) = zqfibar(:,:,iq) 278 else 279 ychim(:,:,iq-nmicro) = tr_seri(:,:,iq) 280 endif 281 nomqy(iq-nmicro) = tname(iq) 282 c print*,iq-nmicro,nomqy(iq-nmicro) 389 283 enddo 390 nomqy(iq-nmicro) = tname(iq) 391 c print*,iq-nmicro,nomqy(iq-nmicro) 392 enddo 393 nomqy(nqmax-nmicro+1) = "HV" 284 nomqy(nqmax-nmicro+1) = "HV" 394 285 endif 395 286 … … 416 307 IF (MICROFI.eq.0) THEN 417 308 c PAS DE MICROPHYSIQUE : 418 c On appelle juste rdf pour creer la grille de rayons.419 309 IF (firstcall) THEN 420 310 print*,'MICROPHYSIQUE OFF-LINE',MICROFI 421 call rdf()422 311 ENDIF 423 c NOTES : 424 c L'appel de rdf ne sert a rien ici mis a part pour le TR. Si cet 425 c appel a deja lieu dans le TR inutile de le refaire ici. 426 c Je ne sais pas exactement comment marche les modules en F90 427 c Mais je recopie les valeurs du common/part/ de rdf pour 428 c les mettre dans un common interne a la microphysique (voir varmuphy.h) 429 c DONC J'AI BESOIN D'AVOIR ACCES A L'ANCIEN COMMON !!! 430 c 431 ELSEIF (MICROFI.eq.1) THEN 432 c MICROPHYSIQUE 2D : 433 c Les input/output comportent le prefixe z pour 2D :) 312 ELSE 434 313 zdqmufi = 0. ! ne sert que pour chimi pour condensation 435 call muphys( jjm+1,314 call muphys(klon, 436 315 & zplev,zplay,zzlev,zzlay, 437 & ztemp, zqaer,zgaz1,zgaz2,zgaz3,316 & ztemp,qaer,gaz1,gaz2,gaz3, 438 317 & nmicro,ptimestep, 439 & zmu0,zfract,318 & pmu0,pfract, 440 319 c -------- sorties diagnostiques 441 & zflxesp_i,442 & ztau_drop,ztau_aer,443 & zsolesp,zprec)444 ELSE445 c MICROPHYSIQUE 3D :446 c Les input sont des champs 3D directement !447 call muphys(klon,448 & pplev,pplay,pzlev,pzlay,449 & ptemp,qaer,gaz1,gaz2,gaz3,450 & nmicro,ptimestep,451 & pmu0,pfract,452 c ------ sorties diagnostiques453 320 & flxesp_i, 454 321 & tau_drop,tau_aer, 455 322 & solesp,prec) 456 c 323 457 324 c NOTES : 458 325 c Ici toutes nos sorties sont des champs 3D...(meme les diagnostiques) 459 326 c On a rien a faire mis a part copier les dq dans les d_tr 460 c 327 461 328 ENDIF 462 329 c call endtime(tt0,tt1) 463 330 c ttmuphys=ttmuphys+tt1 464 465 c-----------------------------------------------------------------------466 c Mise a jour des sorties de muphys467 c -------------468 c En 2D on copie les sorties de muphys de la grille LATxALT469 c sur la grille complete.470 IF (microfi.eq.1) THEN471 c precipitations472 DO l=1,5473 prec(1,l) = zprec(1,l)474 ig0 = 2475 DO j=2,jjm476 DO i = 1, iim477 prec(ig0,l) = zprec(j,l)478 ig0 = ig0 + 1479 ENDDO480 ENDDO481 prec(ig0,l) = zprec(jjm+1,l)482 ENDDO483 c taux sedimentation484 DO l=1,llm485 c taux sed goutte486 IF (clouds.eq.1) THEN487 tau_drop(1,l) = ztau_drop(1,l)488 ig0 = 2489 DO j=2,jjm490 DO i = 1, iim491 tau_drop(ig0,l) = ztau_drop(j,l)492 ig0 = ig0 + 1493 ENDDO494 ENDDO495 tau_drop(ig0,l) = ztau_drop(jjm+1,l)496 ENDIF497 c taux sed aer498 DO iq=1,nrad499 tau_aer(1,l,iq) = ztau_aer(1,l,iq)500 ig0 = 2501 DO j=2,jjm502 DO i = 1, iim503 tau_aer(ig0,l,iq) = ztau_aer(j,l,iq)504 ig0 = ig0 + 1505 ENDDO506 ENDDO507 tau_aer(ig0,l,iq) = ztau_aer(jjm+1,l,iq)508 ENDDO509 ENDDO510 c flux glace / production glace511 IF (clouds.eq.1) THEN512 DO iq=1,3513 DO l=1,llm514 flxesp_i(1,l,iq) = zflxesp_i(1,l,iq)515 solesp(1,l,iq) = zsolesp(1,l,iq)516 ig0 = 2517 DO j=2,jjm518 DO i = 1, iim519 flxesp_i(ig0,l,iq)=zflxesp_i(j,l,iq)520 solesp(ig0,l,iq) = zsolesp(j,l,iq)521 ig0 = ig0 + 1522 ENDDO523 ENDDO524 flxesp_i(ig0,l,iq)=zflxesp_i(jjm+1,l,iq)525 solesp(ig0,l,iq) = zsolesp(jjm+1,l,iq)526 ENDDO527 ENDDO528 ENDIF529 ENDIF530 331 531 332 c----------------------------------------------------------------------- … … 534 335 c 535 336 IF (clouds.eq.1) THEN 536 IF (microfi.eq.1) THEN 537 c On repasse les gaz en 3D si on a fait de la microphysique en 2D 538 DO l=1,llm 539 gaz1(1,l) = zgaz1(1,l) 540 gaz2(1,l) = zgaz2(1,l) 541 gaz3(1,l) = zgaz3(1,l) 542 ig0 = 2 543 DO j=2,jjm 544 DO i = 1, iim 545 gaz1(ig0,l) = zgaz1(j,l)* gaz1(ig0,l) /zgaz10(j,l) 546 gaz2(ig0,l) = zgaz2(j,l)* gaz2(ig0,l) /zgaz20(j,l) 547 gaz3(ig0,l) = zgaz3(j,l)* gaz3(ig0,l) /zgaz30(j,l) 548 ig0 = ig0 + 1 549 ENDDO 550 ENDDO 551 gaz1(ig0,l) = zgaz1(jjm+1,l) 552 gaz2(ig0,l) = zgaz2(jjm+1,l) 553 gaz3(ig0,l) = zgaz3(jjm+1,l) 554 ENDDO 555 ENDIF 556 c Mise a jour du reservoir de CH4 (ie : seul le CH4 remplit le reservoir) 557 DO i=1,klon 558 reservoir(i) = reservoir(i)+prec(i,1) 559 ENDDO 560 c Calcul des sources : 561 c ch4=0. 562 c ch4(1) = gaz1(1,1) 563 c do j=2,jjm 564 c ig0=1+(j-2)*iim 565 c do i=1,iim 566 c ch4(j)= ch4(j) + gaz1(ig0+i,1)/iim 567 c enddo 568 c enddo 569 c ch4(jjm+1) = gaz1(ig0,1) 570 571 CALL sources(klon,klev,ptimestep,z0, 337 IF (microfi.eq.1) THEN 338 c On repasse les gaz en 3D si on a fait de la microphysique en 2D 339 gaz1(:,:)=gaz1(:,:)*tr_seri(:,:,icldch4)/zqfibar(:,:,icldch4) 340 gaz2(:,:)=gaz2(:,:)*tr_seri(:,:,icldc2h6)/zqfibar(:,:,icldc2h6) 341 gaz3(:,:)=gaz3(:,:)*tr_seri(:,:,icldc2h2)/zqfibar(:,:,icldc2h2) 342 ENDIF 343 c Mise a jour du reservoir de CH4 (ie : seul le CH4 remplit le reservoir) 344 DO i=1,klon 345 reservoir(i) = reservoir(i)+prec(i,1) 346 ENDDO 347 348 CALL sources(klon,klev,ptimestep,z0, 572 349 & pu,pv,pplev,pzlay,pzlev, 573 350 & gaz1,gaz2,gaz3, 574 351 & ftsol,evapch4,reservoir) 575 352 576 c ch4b=0.577 c ch4b(1) = gaz1(1,1)578 c do j=2,jjm579 c ig0=1+(j-2)*iim580 c do i=1,iim581 c ch4b(j)= ch4b(j) + gaz1(ig0+i,1)/iim582 c enddo583 c enddo584 c ch4b(jjm+1) = gaz1(ig0,1)585 c do j=1,jjm+1586 c write(499,*) j,ch4(j),ch4b(j)587 c enddo588 c write(499,*) ""589 353 ENDIF 590 354 c----------------------------------------------------------------------- … … 599 363 do iq=1,nqmax-nmicro 600 364 do l=1,llm 601 do j=1, jjm+1365 do j=1,klon 602 366 if (ychim(j,l,iq).gt.qysat(l,iq)) then 603 367 zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+qysat(l,iq)) !delta y … … 622 386 c if (nomqy(iq).eq."CH4") then 623 387 c do l=1,llm 624 c do j=1, jjm+1388 c do j=1,klon 625 389 c if (ychim(j,l,iq).le.0.015) then 626 390 c zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+0.015) !delta y … … 640 404 c if (nomqy(iq).eq."C2H2") then 641 405 c do l=1,llm 642 c do j=1, jjm+1406 c do j=1,klon 643 407 c if (ychim(j,l,iq).gt.1.e-5) then 644 408 c zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+1.e-5) !delta y … … 650 414 c if (nomqy(iq).eq."C2H6") then 651 415 c do l=1,llm 652 c do j=1, jjm+1416 c do j=1,klon 653 417 c if (ychim(j,l,iq).gt.3.e-5) then 654 418 c zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+3.e-5) !delta y … … 680 444 c Appel Chimie 681 445 c ------------ 682 CALL calchim( nqmax-nmicro,ychim,nomqy,pdecli,lonsol,dtkim,446 CALL calchim(klon,nqmax-nmicro,ychim,nomqy,pdecli,lonsol,dtkim, 683 447 . ztemp,zplay,zplev, 684 448 . pdyfi) … … 701 465 c ---> microphysique 2D 702 466 IF (microfi.eq.1) THEN 703 c on repasse le champ de traceurs en 3D (pas les tendances)704 467 DO iq=1,nmicro 705 468 DO l=1,llm 706 qaer(1,l,iq) = zqaer(1,l,iq) 707 ig0 = 2 708 DO j=2,jjm 709 DO i = 1, iim 469 DO i=1,klon 470 c on repasse le champ de traceurs en 3D (pas les tendances) 471 c qaer est ce qui entre dans muphy, donc la moyenne zonale 472 c qaer0 est la valeur initiale du champ 473 c qaer0 est la moyenne zonale initiale 474 c la variation relative pour une bande de latitude est donc (qaer/qaer0bar) 475 c la nouvelle valeur en un point (3D) est donc qaer0*(qaer/qaer0bar) 476 c et la tendance: qaer0*(qaer/qaer0bar)-qaer0 710 477 c un petit patch : 711 478 c Si la moyenne zonale au depart est "nulle" : … … 714 481 c Cela permet aussi entre autre d eviter les NaN pour les traceurs des nuages ! 715 482 c (au dessus de la tropo pas de nuages donc qaer(nrad+1:ntype*nrad) = 0 !!!) 716 IF (zqaer0(j,l,iq).lt.1e-100) THEN 717 qaer(ig0,l,iq) = zqaer(j,l,iq) 718 ELSE 719 qaer(ig0,l,iq) = zqaer(j,l,iq) * 720 & qaer0(ig0,l,iq)/zqaer0(j,l,iq) 721 ENDIF 722 ig0 = ig0 + 1 723 ENDDO 724 ENDDO 725 qaer(ig0,l,iq) = zqaer(jjm+1,l,iq) 726 ENDDO 727 ENDDO 728 c La tendances correspond a (qaer-qaer0)/ptimestep 729 DO iq=1,nmicro 730 DO i=1,klon 731 DO l=1,llm 483 IF (qaer0bar(i,l,iq).gt.1e-100) THEN 484 qaer(i,l,iq) = qaer0(i,l,iq) * 485 & qaer(i,l,iq)/qaer0bar(i,l,iq) 486 ENDIF 487 c La tendance correspond a (qaer-qaer0)/ptimestep 732 488 d_tr_mph(i,l,iq) = (qaer(i,l,iq)-qaer0(i,l,iq))/ 733 489 & ptimestep … … 738 494 ELSEIF(microfi.gt.1) THEN 739 495 DO iq=1,nmicro 740 DO l=1,llm 741 DO i = 1, klon 742 d_tr_mph(i,l,iq)=(qaer(i,l,iq)-qaer0(i,l,iq))/ptimestep 743 ENDDO 744 ENDDO 496 d_tr_mph(:,:,iq)=(qaer(:,:,iq)-qaer0(:,:,iq))/ptimestep 745 497 ENDDO 746 747 498 ENDIF ! microfi 748 499 749 500 DO iq=1,nmicro 750 DO l=1,llm751 DO i = 1, klon752 501 c Traceurs microphysiques: passage en intensif: n/m^2 --> n/kg 753 d_tr_mph(i,l,iq) = d_tr_mph(i,l,iq)*RG/delp(i,l) 754 ENDDO 755 ENDDO 502 d_tr_mph(:,:,iq) = d_tr_mph(:,:,iq)*RG/delp(:,:) 756 503 ENDDO 757 504 … … 764 511 765 512 DO iq=nmicro+1,nqmax 766 DO l=1,llm 767 d_tr_kim(1,l,iq) = pdyfi(1,l,iq-nmicro) 768 d_tr_mph(1,l,iq) = zdqmufi(1,l,iq) 769 ig0 = 2 770 DO j=2,jjm 771 DO i = 1, iim 772 d_tr_kim(ig0,l,iq) = pdyfi(j,l,iq-nmicro) 773 & *tr_seri(ig0,l,iq)/ychim(j,l,iq-nmicro) 774 d_tr_mph(ig0,l,iq) = zdqmufi(j,l,iq) 775 & *tr_seri(ig0,l,iq)/ychim(j,l,iq-nmicro) 776 ig0 = ig0 + 1 777 ENDDO 778 ENDDO 779 d_tr_kim(ig0,l,iq) = pdyfi(jjm+1,l,iq-nmicro) 780 d_tr_mph(ig0,l,iq) = zdqmufi(jjm+1,l,iq) 781 ENDDO 513 d_tr_kim(:,:,iq) = pdyfi(:,:,iq-nmicro) 514 & *tr_seri(:,:,iq)/ychim(:,:,iq-nmicro) 515 d_tr_mph(:,:,iq) = zdqmufi(:,:,iq) 516 & *tr_seri(:,:,iq)/ychim(:,:,iq-nmicro) 782 517 ENDDO 783 518 … … 792 527 c les especes concernees (CH4, C2H6 pour le moment). 793 528 IF (microfi.ge.1.and.clouds.eq.1) THEN 794 DO i=1,klon795 DO l=1,klev796 529 c condensation CH4 797 d_tr_mph(i,l,icldch4)=(gaz1(i,l)-tr_seri(i,l,icldch4))530 d_tr_mph(:,:,icldch4) =(gaz1(:,:)-tr_seri(:,:,icldch4)) 798 531 & /ptimestep 799 532 c condensation C2H6 800 d_tr_mph(i,l,icldc2h6)=(gaz2(i,l)-tr_seri(i,l,icldc2h6))801 & 533 d_tr_mph(:,:,icldc2h6)=(gaz2(:,:)-tr_seri(:,:,icldc2h6)) 534 & /ptimestep 802 535 c condensation C2H2 803 d_tr_mph(i,l,icldc2h2)=(gaz3(i,l)-tr_seri(i,l,icldc2h2)) 804 & /ptimestep 805 ENDDO 806 ENDDO 536 d_tr_mph(:,:,icldc2h2)=(gaz3(:,:)-tr_seri(:,:,icldc2h2)) 537 & /ptimestep 807 538 ENDIF 808 c ch4c=0.809 c do l=1,llm810 c ch4c(1,l) = tr_seri(1,l,icldch4)811 c do j=2,jjm812 c ig0=1+(j-2)*iim813 c do i=1,iim814 c ch4c(j,l)= ch4c(j,l)+tr_seri(ig0+i,l,icldch4)/iim815 c enddo816 c enddo817 c ch4c(jjm+1,l) = tr_seri(klon,l,icldch4)818 c enddo819 c do l=1,llm820 c write(500,*) pplay(25,l),ch4c(25,l)821 c enddo822 c write(500,*) ""823 824 539 825 540 c-------------------------------------------------- … … 882 597 DO j=1,klev 883 598 DO iq=1,nrad 884 * Rayon minimum selon la quantit éde noyaux885 IF (qaer(i,j,iq+nrad) .le. 886 599 * Rayon minimum selon la quantite de noyaux 600 IF (qaer(i,j,iq+nrad) .le. 1.e-5) THEN 601 rcloud(i,j,iq) = 1.e-10 887 602 ELSE 888 603 rcloud(i,j,iq)= … … 940 655 c 941 656 c OCCCLD 942 c Calcul le nombre d 'occurence d'un nuage943 c d opacit écomprise en kmin et kmax657 c Calcul le nombre d occurence d un nuage 658 c d opacite comprise en kmin et kmax 944 659 c k kmin kmax 945 660 c 1 0.0000000 0.10000000 -
trunk/LMDZ.TITAN/libf/phytitan/radlwsw.F
r815 r1056 1 SUBROUTINE radlwsw(dist, rmu0, fract, falbe, zzlev, 2 . paprs, pplay,tsol, pt, nq, nmicro, pq, 3 . qaer, 4 . heat,cool,radsol, 5 . topsw,toplw,solsw,sollw, 6 . sollwdown, 7 . lwnet, swnet) 1 SUBROUTINE radlwsw(dist, rmu0, fract, zzlev, 2 . paprs, pplay,tsol, pt, nq, nmicro, pq,qaer) 8 3 c 9 4 c====================================================================== … … 41 36 use dimphy 42 37 USE comgeomphy 43 IMPLICIT none 38 USE phys_state_var_mod, only: falbe,heat,cool,radsol, 39 . topsw,toplw,solsw,sollw,sollwdown,lwnet,swnet 40 USE write_field_phy 41 IMPLICIT none 44 42 #include "dimensions.h" 45 43 #include "YOMCST.h" … … 48 46 c ARGUMENTS 49 47 INTEGER nq,nmicro 50 real rmu0(klon), fract(klon), falbe(klon),dist48 real rmu0(klon), fract(klon), dist 51 49 c 52 50 real zzlev(klon,klev+1),paprs(klon,klev+1), pplay(klon,klev) … … 55 53 real pq(klon,klev,nq) 56 54 REAL qaer(klon,klev,nq) 57 real heat(klon,klev), cool(klon,klev)58 real radsol(klon), topsw(klon), toplw(klon)59 real solsw(klon), sollw(klon)60 real sollwdown(klon)61 REAL swnet(klon,klev+1),lwnet(klon,klev+1)62 55 c 63 56 c LOCAL VARIABLES … … 87 80 enddo 88 81 82 c call WriteField_phy('radlwsw_zp',zp,klev+1) 83 84 c ======================================= 89 85 c altitudes (m) avec indice 1 en haut 90 86 do l=1,klev+1 … … 121 117 CALL radtitan(zp,nq,nmicro,zq,qaer) 122 118 123 c =======================================124 119 c CALCUL DU SW 125 120 c ======================================= -
trunk/LMDZ.TITAN/libf/phytitan/radtitan.F
r815 r1056 35 35 USE comgeomphy 36 36 USE optcld, only : iniqcld 37 use moyzon_mod, only:plevmoy 37 38 IMPLICIT NONE 38 39 #include "dimensions.h" … … 118 119 IPRINT=1 119 120 120 C MODIFY ADJUSTABLE NUMBERS HERE -- NOT IN COMMON121 121 C&& 122 122 FHAZE=0.3 … … 124 124 if(iprem.eq.0) then 125 125 TAUFAC=0 126 FHVIS=2.0 127 FHIR=.2 128 print*,'ouverture du fichier initpar' 129 open (unit=1,file='initpar') 130 read(1,*) xpoub,kkk,xvis,xir 131 close(1) 132 FHVIS= xvis 133 FHIR = xir 134 print*,'ouverture du fichier initpar ok' 135 print*,'DANS RADTITAN' 136 print*,'-------------' 137 print*,'FHVIS = ',FHVIS 138 print*,'FHIR = ',FHIR 126 c xvis et xir lus dans physiq.def (ancien fichier initpar) 127 FHVIS= xvis 128 FHIR = xir 139 129 c on initialise le paquet optcld 140 130 if (clouds.eq.1) call iniqcld() … … 151 141 print*,notfirstcall 152 142 153 DO 210 J=1,NLEVEL 154 PRESS(J)=SSUM(klon,p(1,j),1)/FLOAT(klon) 143 c pression moyenne globale 144 c passage au pressions en bar avec indice 1 au sommet. 145 c (similaire zp dans radlwsw) 146 DO 210 J=2,NLEVEL 147 PRESS(J)=plevmoy(NLEVEL+1-j)*1.e-5 155 148 210 CONTINUE 149 PRESS(1) = PRESS(2)*0.001 156 150 157 151 c a cause du tableau predefini dans lell.F (et lell_light.F) -
trunk/LMDZ.TITAN/libf/phytitan/rcm1d.F
r1048 r1056 85 85 COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus 86 86 REAL cppdyn,nu_venus,t0_venus 87 real pi 87 88 88 89 c======================================================================= … … 175 176 ndt=ndt*day_step 176 177 dtphys=daysec/day_step 178 dtime=dtphys 177 179 178 180 c Pression de surface sur la planete -
trunk/LMDZ.TITAN/libf/phytitan/snuages3D.F
r814 r1056 923 923 real rfg(nz),dfg(nz,nrad) 924 924 real puit(nz) 925 c ------ echange est decrit sur ngrid=klon mais peut etre utilisee926 c uniquement sur jjm+1925 c ------ echange est cree sur la taille maxi mais n'est utilisee 926 c que sur la dim geree par le proc (klon ou jjm+1) 927 927 integer ngrid 928 parameter (ngrid=(jjm-1)*iim+2) ! = klon928 parameter (ngrid=(jjm-1)*iim+2) ! = taille maximum 929 929 real echange(nz,nz,ngrid) 930 c pas genial mais vu que c est tres local, pas de soucis a priori en parallele. 930 931 real bilan1,bilan2,bilan3,bilan4,bilan5 931 932 real bilan11,bilan12,bilan13,bilan14,bilan15 -
trunk/LMDZ.TITAN/libf/phytitan/write_histday.h
r808 r1056 3 3 ! 4 4 IF (ok_journe) THEN 5 c 6 ndex2d = 0 7 ndex3d = 0 8 zx_tmp_2d = 0. 9 zx_tmp_3d = 0. 10 zx_tmp_fi2d=0. 11 zx_tmp_fi3d=0. 12 c 5 13 6 zsto = dtime 14 zout = dtime * FLOAT(ecrit_day)7 zout = dtime * REAL(ecrit_day) 15 8 itau_w = itau_phy + itap 16 9 17 c18 10 c------------------------------------------------------- 19 11 IF(lev_histday.GE.1) THEN 20 c 12 21 13 ccccccccccccc 2D fields, invariables 22 c 23 CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) 24 CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 25 C 26 CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d) 27 CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 28 c 14 15 call histwrite_phy(nid_day,.false.,"phis",itau_w,pphis) 16 call histwrite_phy(nid_day,.false.,"aire",itau_w,airephy) 17 29 18 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... 30 do j=1,jjmp1 31 do i=1,iim 32 zx_tmp_2d(i,j)=zls*180./RPI ! zls est en radians !! 33 enddo 34 enddo 35 c Correction passage de 360 à 0... Sinon probleme avec moyenne 19 c Correction passage de 360 a 0... Sinon probleme avec moyenne 36 20 if (zls.lt.zlsm1) then 37 zx_tmp_2d = zx_tmp_2d+360. 21 do i=1,klon 22 tmpout(i,1) = zls*180./RPI+360. 23 enddo 38 24 zlsm1 = 2.*RPI 39 25 else 26 do i=1,klon 27 tmpout(i,1) = zls*180./RPI 28 enddo 40 29 zlsm1 = zls 41 30 endif 42 CALL histwrite(nid_day,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)43 c 31 call histwrite_phy(nid_day,.false.,"ls",itau_w,tmpout(:,1)) 32 44 33 ccccccccccccc 2D fields, variables 45 c 46 CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d) 47 CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 48 c 49 DO i = 1, klon 50 zx_tmp_fi2d(i) = paprs(i,1) 51 ENDDO 52 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 53 CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 54 c 55 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d) 56 c CALL histwrite(nid_day,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 57 c 58 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d) 59 c CALL histwrite(nid_day,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 60 c 34 35 call histwrite_phy(nid_day,.false.,"tsol",itau_w,ftsol) 36 call histwrite_phy(nid_day,.false.,"psol",itau_w,paprs(:,1)) 37 38 c call histwrite_phy(nid_day,.false.,"ue",itau_w,ue) 39 c call histwrite_phy(nid_day,.false.,"ve",itau_w,ve) 40 61 41 ENDIF !lev_histday.GE.1 62 c 42 63 43 c------------------------------------------------------- 64 44 IF(lev_histday.GE.2) THEN 65 c 45 66 46 ccccccccccccc 3D fields, basics 67 c 68 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d) 69 CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d, 70 . iim*jjmp1*klev,ndex3d) 71 c 72 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d) 73 CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d, 74 . iim*jjmp1*klev,ndex3d) 75 c 76 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d) 77 CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d, 78 . iim*jjmp1*klev,ndex3d) 79 c 80 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d) 81 CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d, 82 . iim*jjmp1*klev,ndex3d) 83 c 84 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d) 85 CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d, 86 . iim*jjmp1*klev,ndex3d) 87 c 88 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d) 89 CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d, 90 . iim*jjmp1*klev,ndex3d) 91 c 92 CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d) 93 CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 94 c 95 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d) 96 CALL histwrite(nid_day,"dudyn",itau_w,zx_tmp_3d, 97 . iim*jjmp1*klev,ndex3d) 98 c 99 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d) 100 CALL histwrite(nid_day,"duvdf",itau_w,zx_tmp_3d, 101 . iim*jjmp1*klev,ndex3d) 102 c 47 48 call histwrite_phy(nid_day,.false.,"temp",itau_w,t_seri) 49 call histwrite_phy(nid_day,.false.,"pres",itau_w,pplay) 50 call histwrite_phy(nid_day,.false.,"geop",itau_w,zphi) 51 call histwrite_phy(nid_day,.false.,"vitu",itau_w,u_seri) 52 call histwrite_phy(nid_day,.false.,"vitv",itau_w,v_seri) 53 call histwrite_phy(nid_day,.false.,"vitw",itau_w,omega) 54 call histwrite_phy(nid_day,.false.,"tops",itau_w,topsw) 55 call histwrite_phy(nid_day,.false.,"duvdf",itau_w,d_u_vdf) 56 call histwrite_phy(nid_day,.false.,"dudyn",itau_w,d_u_dyn) 57 103 58 cccccccccccccccccc Tracers 104 c 59 105 60 if (iflag_trac.eq.1) THEN 106 61 if (microfi.ge.1) then 107 c DO iq=1,nmicro 108 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d) 109 c CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d, 110 c . iim*jjmp1*klev,ndex3d) 111 c ENDDO 62 c DO iq=1,nmicro 63 c call histwrite_phy(nid_day,.false.,tname(iq), 64 c . itau_w,qaer(1:klon,1:klev,iq)) 65 c ENDDO 112 66 c ------- NB AER TOT 113 67 do i=1,klon 114 68 do j=1,klev 115 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad)) 116 enddo 117 enddo 118 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 119 CALL histwrite(nid_day,"qaer",itau_w,zx_tmp_3d, 120 . iim*jjmp1*klev,ndex3d) 69 tmpout(i,j)= SUM(qaer(i,j,1:nrad)) 70 enddo 71 enddo 72 call histwrite_phy(nid_day,.false.,"qaer",itau_w,tmpout) 121 73 122 74 if (clouds.eq.1) then … … 124 76 do i=1,klon 125 77 do j=1,klev 126 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad)) 127 enddo 128 enddo 129 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 130 CALL histwrite(nid_day,"qnoy",itau_w,zx_tmp_3d, 131 . iim*jjmp1*klev,ndex3d) 78 tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad)) 79 enddo 80 enddo 81 call histwrite_phy(nid_day,.false.,"qnoy",itau_w,tmpout) 132 82 c ------- V GLA1 TOT 133 83 do i=1,klon 134 84 do j=1,klev 135 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad)) 136 enddo 137 enddo 138 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 139 CALL histwrite(nid_day,"qgl1",itau_w,zx_tmp_3d, 140 . iim*jjmp1*klev,ndex3d) 85 tmpout(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad)) 86 enddo 87 enddo 88 call histwrite_phy(nid_day,.false.,"qgl1",itau_w,tmpout) 141 89 c ------- V GLA2 TOT 142 90 do i=1,klon 143 91 do j=1,klev 144 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad)) 145 enddo 146 enddo 147 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 148 CALL histwrite(nid_day,"qgl2",itau_w,zx_tmp_3d, 149 . iim*jjmp1*klev,ndex3d) 92 tmpout(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad)) 93 enddo 94 enddo 95 call histwrite_phy(nid_day,.false.,"qgl2",itau_w,tmpout) 150 96 c ------- V GLA3 TOT 151 97 do i=1,klon 152 98 do j=1,klev 153 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad)) 154 enddo 155 enddo 156 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 157 CALL histwrite(nid_day,"qgl3",itau_w,zx_tmp_3d, 158 . iim*jjmp1*klev,ndex3d) 99 tmpout(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad)) 100 enddo 101 enddo 102 call histwrite_phy(nid_day,.false.,"qgl3",itau_w,tmpout) 159 103 c -------------- 160 104 c ----- SATURATION ESP NUAGES 161 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d) 162 CALL histwrite(nid_day,"ch4sat", itau_w, zx_tmp_3d, 163 . iim*jjmp1*klev,ndex3d) 164 165 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d) 166 CALL histwrite(nid_day,"c2h6sat", itau_w, zx_tmp_3d, 167 . iim*jjmp1*klev,ndex3d) 168 169 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d) 170 CALL histwrite(nid_day,"c2h2sat", itau_w, zx_tmp_3d, 171 . iim*jjmp1*klev,ndex3d) 105 call histwrite_phy(nid_day,.false.,"ch4sat",itau_w,satch4) 106 call histwrite_phy(nid_day,.false.,"c2h6sat",itau_w,satc2h6) 107 call histwrite_phy(nid_day,.false.,"c2h2sat",itau_w,satc2h2) 172 108 c -------------- 173 109 c ----- RESERVOIR DE SURFACE 174 CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d) 175 CALL histwrite(nid_day,"reserv",itau_w,zx_tmp_2d, 176 . iim*jjmp1,ndex2d) 110 call histwrite_phy(nid_day,.false.,"reserv",itau_w,reservoir) 177 111 c -------------- 178 112 c ----- ECHANGE GAZ SURF/ATM (evaporation) 179 CALL gr_fi_ecrit(1, klon,iim,jjmp1,evapch4,zx_tmp_2d) 180 CALL histwrite(nid_day,"evapch4",itau_w,zx_tmp_2d, 181 . iim*jjmp1,ndex2d) 113 call histwrite_phy(nid_day,.false.,"evapch4",itau_w,evapch4) 182 114 c -------------- 183 115 c ----- PRECIPITATIONS 184 116 c ----- CH4 185 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d) 186 CALL histwrite(nid_day,"prech4",itau_w,zx_tmp_2d, 187 . iim*jjmp1,ndex2d) 117 call histwrite_phy(nid_day,.false.,"prech4", 118 . itau_w,precip(1:klon,1)) 188 119 c ----- C2H6 189 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d) 190 CALL histwrite(nid_day,"prec2h6",itau_w,zx_tmp_2d, 191 . iim*jjmp1,ndex2d) 120 call histwrite_phy(nid_day,.false.,"prec2h6", 121 . itau_w,precip(1:klon,2)) 192 122 c ----- C2H2 193 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d) 194 CALL histwrite(nid_day,"prec2h2",itau_w,zx_tmp_2d, 195 . iim*jjmp1,ndex2d) 196 c 123 call histwrite_phy(nid_day,.false.,"prec2h2", 124 . itau_w,precip(1:klon,3)) 125 c ----- NOY 126 call histwrite_phy(nid_day,.false.,"prenoy", 127 . itau_w,precip(1:klon,4)) 128 c ----- AER 129 call histwrite_phy(nid_day,.false.,"preaer", 130 . itau_w,precip(1:klon,5)) 197 131 c -------------- 198 132 c ----- FLUX GLACE 199 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 200 . flxesp_i(1:klon,1:klev,1),zx_tmp_3d) 201 CALL histwrite(nid_day,"flxgl1", itau_w, zx_tmp_3d, 202 . iim*jjmp1*klev,ndex3d) 203 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 204 . flxesp_i(1:klon,1:klev,2),zx_tmp_3d) 205 CALL histwrite(nid_day,"flxgl2", itau_w, zx_tmp_3d, 206 . iim*jjmp1*klev,ndex3d) 207 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 208 . flxesp_i(1:klon,1:klev,3),zx_tmp_3d) 209 CALL histwrite(nid_day,"flxgl3", itau_w, zx_tmp_3d, 210 . iim*jjmp1*klev,ndex3d) 211 c 133 c ----- CH4 134 call histwrite_phy(nid_day,.false.,"flxgl1", 135 . itau_w,flxesp_i(1:klon,1:klev,1)) 136 c ----- C2H6 137 call histwrite_phy(nid_day,.false.,"flxgl2", 138 . itau_w,flxesp_i(1:klon,1:klev,2)) 139 c ----- C2H2 140 call histwrite_phy(nid_day,.false.,"flxgl3", 141 . itau_w,flxesp_i(1:klon,1:klev,3)) 142 c -------------- 143 c ----- Source/puits GLACE 144 c ----- CH4 145 call histwrite_phy(nid_day,.false.,"solch4", 146 . itau_w,solesp(1:klon,1:klev,1)) 147 c ----- C2H6 148 call histwrite_phy(nid_day,.false.,"solc2h6", 149 . itau_w,solesp(1:klon,1:klev,2)) 150 c ----- C2H2 151 call histwrite_phy(nid_day,.false.,"solc2h2", 152 . itau_w,solesp(1:klon,1:klev,3)) 212 153 c -------------- 213 154 c ----- RAYON MOYEN GOUTTE 214 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d) 215 CALL histwrite(nid_day,"rcldbar", itau_w, zx_tmp_3d, 216 . iim*jjmp1*klev,ndex3d) 217 c 155 call histwrite_phy(nid_day,.false.,"rcldbar",itau_w,rmcloud) 156 218 157 endif 219 158 endif 220 c 159 221 160 c -------------- 222 161 c ----- TRACEURS CHIMIQUES 223 162 if (nmicro.lt.nqmax) then 224 163 DO iq=nmicro+1,nqmax 225 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d) 226 CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d, 227 . iim*jjmp1*klev,ndex3d) 164 call histwrite_phy(nid_day,.false.,tname(iq), 165 . itau_w,tr_seri(1:klon,1:klev,iq)) 228 166 ENDDO 229 167 endif 230 168 endif 231 c 169 232 170 ENDIF !lev_histday.GE.2 233 c 171 234 172 c------------------------------------------------------- 235 173 IF(lev_histday.GE.3) THEN 236 c 174 237 175 cccccccccccccccccc Radiative transfer 238 c 176 239 177 c 2D 240 c 241 CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d) 242 CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 243 c 244 CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d) 245 CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 246 c 247 CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d) 248 CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 249 c 178 179 call histwrite_phy(nid_day,.false.,"topl",itau_w,toplw) 180 call histwrite_phy(nid_day,.false.,"sols",itau_w,solsw) 181 call histwrite_phy(nid_day,.false.,"soll",itau_w,sollw) 182 250 183 c 3D 251 c 252 zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev) 253 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 254 CALL histwrite(nid_day,"SWnet",itau_w,zx_tmp_3d, 255 . iim*jjmp1*klev,ndex3d) 256 c 257 zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev) 258 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 259 CALL histwrite(nid_day,"LWnet",itau_w,zx_tmp_3d, 260 . iim*jjmp1*klev,ndex3d) 261 c 184 185 call histwrite_phy(nid_day,.false.,"SWnet", 186 . itau_w,swnet(1:klon,1:klev)) 187 call histwrite_phy(nid_day,.false.,"LWnet", 188 . itau_w,lwnet(1:klon,1:klev)) 189 262 190 c -------------- 263 191 c ----- OPACITE BRUME … … 268 196 enddo 269 197 enddo 270 write(str1,'(i2.2)') k 271 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 272 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 273 CALL histwrite(nid_day,"thv"//str1,itau_w,zx_tmp_3d, 274 . iim*jjmp1*klev,ndex3d) 198 write(str2,'(i2.2)') k 199 call histwrite_phy(nid_day,.false.,"thv"//str2,itau_w,t_tauhvd) 275 200 enddo ! fin boucle NSPECV 276 201 … … 281 206 enddo 282 207 enddo 283 write(str1,'(i2.2)') k 284 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 285 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 286 CALL histwrite(nid_day,"thi"//str1,itau_w,zx_tmp_3d, 287 . iim*jjmp1*klev,ndex3d) 208 write(str2,'(i2.2)') k 209 call histwrite_phy(nid_day,.false.,"thi"//str2,itau_w,t_tauhvd) 288 210 enddo ! fin boucle NSPECI 289 c290 211 c -------------- 291 212 c ----- EXTINCTION BRUME … … 302 223 enddo 303 224 enddo 304 write(str1,'(i2.2)') k 305 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 306 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 307 CALL histwrite(nid_day,"khv"//str1,itau_w,zx_tmp_3d, 308 . iim*jjmp1*klev,ndex3d) 225 write(str2,'(i2.2)') k 226 call histwrite_phy(nid_day,.false.,"khv"//str2,itau_w,t_khvd) 309 227 enddo ! fin boucle NSPECV 310 228 … … 321 239 enddo 322 240 enddo 323 write(str1,'(i2.2)') k 324 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 325 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 326 CALL histwrite(nid_day,"khi"//str1,itau_w,zx_tmp_3d, 327 . iim*jjmp1*klev,ndex3d) 241 write(str2,'(i2.2)') k 242 call histwrite_phy(nid_day,.false.,"khi"//str2,itau_w,t_khvd) 328 243 enddo ! fin boucle NSPECI 329 c330 244 c -------------- 331 245 c ----- OPACITE GAZ … … 336 250 enddo 337 251 enddo 338 write(str1,'(i2.2)') k 339 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 340 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 341 CALL histwrite(nid_day,"tgv"//str1,itau_w,zx_tmp_3d, 342 . iim*jjmp1*klev,ndex3d) 252 write(str2,'(i2.2)') k 253 call histwrite_phy(nid_day,.false.,"tgv"//str2,itau_w,t_tauhvd) 343 254 enddo ! fin boucle NSPECV 344 255 … … 349 260 enddo 350 261 enddo 351 write(str1,'(i2.2)') k 352 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 353 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 354 CALL histwrite(nid_day,"tgi"//str1,itau_w,zx_tmp_3d, 355 . iim*jjmp1*klev,ndex3d) 262 write(str2,'(i2.2)') k 263 call histwrite_phy(nid_day,.false.,"tgi"//str2,itau_w,t_tauhvd) 356 264 enddo ! fin boucle NSPECI 357 c358 265 c -------------- 359 266 c ----- EXTINCTION GAZ … … 370 277 enddo 371 278 enddo 372 write(str1,'(i2.2)') k 373 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 374 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 375 CALL histwrite(nid_day,"kgv"//str1,itau_w,zx_tmp_3d, 376 . iim*jjmp1*klev,ndex3d) 279 write(str2,'(i2.2)') k 280 call histwrite_phy(nid_day,.false.,"kgv"//str2,itau_w,t_khvd) 377 281 enddo ! fin boucle NSPECV 378 282 … … 390 294 enddo 391 295 enddo 392 write(str1,'(i2.2)') k 393 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 394 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 395 CALL histwrite(nid_day,"kgi"//str1,itau_w,zx_tmp_3d, 396 . iim*jjmp1*klev,ndex3d) 296 write(str2,'(i2.2)') k 297 call histwrite_phy(nid_day,.false.,"kgi"//str2,itau_w,t_khvd) 397 298 enddo ! fin boucle NSPECI 398 299 399 300 c -------------- 301 if (clouds.eq.1) then 302 c -------------- 400 303 c ----- OPACITE NUAGES (ATTENTION PROXY) 401 if (clouds.eq.1) then 402 zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev) 403 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 404 CALL histwrite(nid_day,"tcld",itau_w,zx_tmp_3d, 405 . iim*jjmp1*klev,ndex3d) 304 call histwrite_phy(nid_day,.false.,"tcld",itau_w,occcld) 406 305 c -------------- 407 306 c ----- EXTINCTION NUAGES (ATTENTION PROXY) … … 414 313 enddo 415 314 enddo 416 zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev) 417 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 418 CALL histwrite(nid_day,"kcld",itau_w,zx_tmp_3d, 419 . iim*jjmp1*klev,ndex3d) 315 call histwrite_phy(nid_day,.false.,"kcld",itau_w,t_kcld) 316 c -------------- 420 317 endif 421 c 318 c -------------- 319 422 320 ENDIF !lev_histday.GE.3 423 c 321 424 322 c------------------------------------------------------- 425 323 IF(lev_histday.GE.4) THEN 426 c 427 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d) 428 CALL histwrite(nid_day,"dtdyn",itau_w,zx_tmp_3d, 429 . iim*jjmp1*klev,ndex3d) 430 c 431 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d) 432 CALL histwrite(nid_day,"dtphy",itau_w,zx_tmp_3d, 433 . iim*jjmp1*klev,ndex3d) 324 325 call histwrite_phy(nid_day,.false.,"dtdyn",itau_w,d_t_dyn) 326 call histwrite_phy(nid_day,.false.,"dtphy",itau_w,d_t) 434 327 c K/s 435 zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev) 436 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 437 CALL histwrite(nid_day,"dtvdf",itau_w,zx_tmp_3d, 438 . iim*jjmp1*klev,ndex3d) 439 c 328 call histwrite_phy(nid_day,.false.,"dtvdf",itau_w,d_t_vdf) 440 329 c K/s 441 zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev) 442 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 443 CALL histwrite(nid_day,"dtajs",itau_w,zx_tmp_3d, 444 . iim*jjmp1*klev,ndex3d) 445 c 330 call histwrite_phy(nid_day,.false.,"dtajs",itau_w,d_t_ajs) 446 331 c K/s 447 zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev) 448 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 449 CALL histwrite(nid_day,"dtswr",itau_w,zx_tmp_3d, 450 . iim*jjmp1*klev,ndex3d) 451 c 332 call histwrite_phy(nid_day,.false.,"dtswr",itau_w,heat) 333 c K/s 334 call histwrite_phy(nid_day,.false.,"dtlwr",itau_w,-1.*cool) 452 335 c K/s 453 zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev) 454 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 455 CALL histwrite(nid_day,"dtlwr",itau_w,zx_tmp_3d, 456 . iim*jjmp1*klev,ndex3d) 457 c K/s 458 c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev) 459 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 460 c CALL histwrite(nid_day,"dtec",itau_w,zx_tmp_3d, 461 c . iim*jjmp1*klev,ndex3d) 462 c 336 c call histwrite_phy(nid_day,.false.,"dtec",itau_w,d_t_ec) 337 463 338 ENDIF !lev_histday.GE.4 464 c 339 465 340 c------------------------------------------------------- 466 341 IF(lev_histday.GE.5) THEN 467 c 468 c 469 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d) 470 c CALL histwrite(nid_day,"taux_",itau_w, 471 c $ zx_tmp_2d,iim*jjmp1,ndex2d) 472 c 473 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d) 474 c CALL histwrite(nid_day,"tauy_",itau_w, 475 c $ zx_tmp_2d,iim*jjmp1,ndex2d) 476 c 477 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) 478 c CALL histwrite(nid_day,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 479 c 480 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) 481 c CALL histwrite(nid_day,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 482 c 342 343 c call histwrite_phy(nid_day,.false.,"taux",itau_w,fluxu) 344 c call histwrite_phy(nid_day,.false.,"tauy",itau_w,fluxv) 345 c call histwrite_phy(nid_day,.false.,"cdrm",itau_w,cdragm) 346 c call histwrite_phy(nid_day,.false.,"cdrh",itau_w,cdragh) 347 483 348 ENDIF !lev_histday.GE.5 484 349 c------------------------------------------------------- 485 c 350 486 351 if (ok_sync) then 487 352 call histsync(nid_day) -
trunk/LMDZ.TITAN/libf/phytitan/write_histins.h
r808 r1056 3 3 ! 4 4 IF (ok_instan) THEN 5 c 6 ndex2d = 0 7 ndex3d = 0 8 zx_tmp_2d = 0. 9 zx_tmp_3d = 0. 10 zx_tmp_fi2d=0. 11 zx_tmp_fi3d=0. 12 c 13 zsto = dtime * FLOAT(ecrit_ins) 14 zout = dtime * FLOAT(ecrit_ins) 5 6 zsto = dtime * REAL(ecrit_ins) 7 zout = dtime * REAL(ecrit_ins) 15 8 itau_w = itau_phy + itap 16 9 17 c18 10 c------------------------------------------------------- 19 11 IF(lev_histday.GE.1) THEN 20 c 12 21 13 ccccccccccccc 2D fields, invariables 22 c 23 CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) 24 CALL histwrite(nid_ins,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 25 C 26 CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d) 27 CALL histwrite(nid_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 28 c 14 15 call histwrite_phy(nid_ins,.false.,"phis",itau_w,pphis) 16 call histwrite_phy(nid_ins,.false.,"aire",itau_w,airephy) 17 29 18 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... 30 do j=1,jjmp1 31 do i=1,iim 32 zx_tmp_2d(i,j)=zls*180./RPI ! zls est en radians !! 33 enddo 19 do i=1,klon 20 tmpout(i,1) = zls*180./RPI 34 21 enddo 35 CALL histwrite(nid_ins,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)36 c 22 call histwrite_phy(nid_ins,.false.,"ls",itau_w,tmpout(:,1)) 23 37 24 ccccccccccccc 2D fields, variables 38 c 39 CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d) 40 CALL histwrite(nid_ins,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 41 c 42 DO i = 1, klon 43 zx_tmp_fi2d(i) = paprs(i,1) 44 ENDDO 45 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 46 CALL histwrite(nid_ins,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 47 c 48 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d) 49 c CALL histwrite(nid_ins,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 50 c 51 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d) 52 c CALL histwrite(nid_ins,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 53 c 25 26 call histwrite_phy(nid_ins,.false.,"tsol",itau_w,ftsol) 27 call histwrite_phy(nid_ins,.false.,"psol",itau_w,paprs(:,1)) 28 29 c call histwrite_phy(nid_ins,.false.,"ue",itau_w,ue) 30 c call histwrite_phy(nid_ins,.false.,"ve",itau_w,ve) 31 54 32 ENDIF !lev_histday.GE.1 55 c 33 56 34 c------------------------------------------------------- 57 35 IF(lev_histday.GE.2) THEN 58 c 36 59 37 ccccccccccccc 3D fields, basics 60 c 61 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d) 62 CALL histwrite(nid_ins,"temp",itau_w,zx_tmp_3d, 63 . iim*jjmp1*klev,ndex3d) 64 c 65 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d) 66 CALL histwrite(nid_ins,"pres",itau_w,zx_tmp_3d, 67 . iim*jjmp1*klev,ndex3d) 68 c 69 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d) 70 CALL histwrite(nid_ins,"geop",itau_w,zx_tmp_3d, 71 . iim*jjmp1*klev,ndex3d) 72 c 73 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d) 74 CALL histwrite(nid_ins,"vitu",itau_w,zx_tmp_3d, 75 . iim*jjmp1*klev,ndex3d) 76 c 77 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d) 78 CALL histwrite(nid_ins,"vitv",itau_w,zx_tmp_3d, 79 . iim*jjmp1*klev,ndex3d) 80 c 81 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d) 82 CALL histwrite(nid_ins,"vitw",itau_w,zx_tmp_3d, 83 . iim*jjmp1*klev,ndex3d) 84 c 85 CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d) 86 CALL histwrite(nid_ins,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 87 c 88 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d) 89 c CALL histwrite(nid_ins,"duvdf",itau_w,zx_tmp_3d, 90 c . iim*jjmp1*klev,ndex3d) 91 c 92 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d) 93 c CALL histwrite(nid_ins,"dudyn",itau_w,zx_tmp_3d, 94 c . iim*jjmp1*klev,ndex3d) 95 c 38 39 call histwrite_phy(nid_ins,.false.,"temp",itau_w,t_seri) 40 call histwrite_phy(nid_ins,.false.,"pres",itau_w,pplay) 41 call histwrite_phy(nid_ins,.false.,"geop",itau_w,zphi) 42 call histwrite_phy(nid_ins,.false.,"vitu",itau_w,u_seri) 43 call histwrite_phy(nid_ins,.false.,"vitv",itau_w,v_seri) 44 call histwrite_phy(nid_ins,.false.,"vitw",itau_w,omega) 45 call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw) 46 c call histwrite_phy(nid_ins,.false.,"duvdf",itau_w,d_u_vdf) 47 c call histwrite_phy(nid_ins,.false.,"dudyn",itau_w,d_u_dyn) 48 96 49 ENDIF !lev_histday.GE.2 97 c 50 98 51 c------------------------------------------------------- 99 52 IF(lev_histday.GE.3) THEN 100 c 53 101 54 cccccccccccccccccc Tracers 102 c 55 103 56 if (iflag_trac.eq.1) THEN 104 57 if (microfi.eq.1) then 105 58 DO iq=1,nmicro 106 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d) 107 CALL histwrite(nid_ins,tname(iq),itau_w,zx_tmp_3d, 108 . iim*jjmp1*klev,ndex3d) 59 call histwrite_phy(nid_ins,.false.,tname(iq), 60 . itau_w,qaer(1:klon,1:klev,iq)) 109 61 ENDDO 110 62 endif 111 63 if (nmicro.lt.nqmax) then 112 64 DO iq=nmicro+1,nqmax 113 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d) 114 CALL histwrite(nid_ins,tname(iq),itau_w,zx_tmp_3d, 115 . iim*jjmp1*klev,ndex3d) 65 call histwrite_phy(nid_ins,.false.,tname(iq), 66 . itau_w,tr_seri(1:klon,1:klev,iq)) 116 67 ENDDO 117 68 endif 118 69 endif 119 c 70 120 71 cccccccccccccccccc Radiative transfer 121 c 72 122 73 c 2D 123 c 124 CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d) 125 CALL histwrite(nid_ins,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 126 c 127 CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d) 128 CALL histwrite(nid_ins,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 129 c 130 CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d) 131 CALL histwrite(nid_ins,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 132 c 74 75 call histwrite_phy(nid_ins,.false.,"topl",itau_w,toplw) 76 call histwrite_phy(nid_ins,.false.,"sols",itau_w,solsw) 77 call histwrite_phy(nid_ins,.false.,"soll",itau_w,sollw) 78 133 79 c 3D 134 c 135 zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev) 136 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 137 CALL histwrite(nid_ins,"SWnet",itau_w,zx_tmp_3d, 138 . iim*jjmp1*klev,ndex3d) 139 c 140 zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev) 141 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 142 CALL histwrite(nid_ins,"LWnet",itau_w,zx_tmp_3d, 143 . iim*jjmp1*klev,ndex3d) 144 c 80 81 call histwrite_phy(nid_ins,.false.,"SWnet", 82 . itau_w,swnet(1:klon,1:klev)) 83 call histwrite_phy(nid_ins,.false.,"LWnet", 84 . itau_w,lwnet(1:klon,1:klev)) 85 145 86 c -------------- 146 87 c ----- OPACITE BRUME … … 151 92 enddo 152 93 enddo 153 write(str1,'(i2.2)') k 154 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 155 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 156 CALL histwrite(nid_ins,"thv"//str1,itau_w,zx_tmp_3d, 157 . iim*jjmp1*klev,ndex3d) 94 write(str2,'(i2.2)') k 95 call histwrite_phy(nid_ins,.false.,"thv"//str2,itau_w,t_tauhvd) 158 96 enddo ! fin boucle NSPECV 159 97 … … 164 102 enddo 165 103 enddo 166 write(str1,'(i2.2)') k 167 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 168 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 169 CALL histwrite(nid_ins,"thi"//str1,itau_w,zx_tmp_3d, 170 . iim*jjmp1*klev,ndex3d) 104 write(str2,'(i2.2)') k 105 call histwrite_phy(nid_ins,.false.,"thi"//str2,itau_w,t_tauhvd) 171 106 enddo ! fin boucle NSPECI 172 107 c -------------- … … 178 113 s t_khvd(i,l)=TAUHVD(i,klev-l+1,k) 179 114 s -TAUHVD(i,klev-l+1-1,k) 180 181 115 if(l.eq.klev) 182 116 s t_khvd(i,l)=TAUHVD(i,klev-l+1,k) … … 185 119 enddo 186 120 enddo 187 write(str1,'(i2.2)') k 188 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 189 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 190 CALL histwrite(nid_ins,"khv"//str1,itau_w,zx_tmp_3d, 191 . iim*jjmp1*klev,ndex3d) 121 write(str2,'(i2.2)') k 122 call histwrite_phy(nid_ins,.false.,"khv"//str2,itau_w,t_khvd) 192 123 enddo ! fin boucle NSPECV 193 124 … … 198 129 s t_khvd(i,l)=TAUHID(i,klev-l+1,k) 199 130 s -TAUHID(i,klev-l+1-1,k) 200 201 131 if(l.eq.klev) 202 132 s t_khvd(i,l)=TAUHID(i,klev-l+1,k) … … 205 135 enddo 206 136 enddo 207 write(str1,'(i2.2)') k 208 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 209 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 210 CALL histwrite(nid_ins,"khi"//str1,itau_w,zx_tmp_3d, 211 . iim*jjmp1*klev,ndex3d) 137 write(str2,'(i2.2)') k 138 call histwrite_phy(nid_ins,.false.,"khi"//str2,itau_w,t_khvd) 212 139 enddo ! fin boucle NSPECI 213 140 c -------------- … … 219 146 enddo 220 147 enddo 221 write(str1,'(i2.2)') k 222 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 223 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 224 CALL histwrite(nid_ins,"tgv"//str1,itau_w,zx_tmp_3d, 225 . iim*jjmp1*klev,ndex3d) 148 write(str2,'(i2.2)') k 149 call histwrite_phy(nid_ins,.false.,"tgv"//str2,itau_w,t_tauhvd) 226 150 enddo ! fin boucle NSPECV 227 151 … … 232 156 enddo 233 157 enddo 234 write(str1,'(i2.2)') k 235 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 236 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 237 CALL histwrite(nid_ins,"tgi"//str1,itau_w,zx_tmp_3d, 238 . iim*jjmp1*klev,ndex3d) 158 write(str2,'(i2.2)') k 159 call histwrite_phy(nid_ins,.false.,"tgi"//str2,itau_w,t_tauhvd) 239 160 enddo ! fin boucle NSPECI 240 161 c -------------- … … 246 167 s t_khvd(i,l)=TAUGVD(i,klev-l+1,k) 247 168 s -TAUGVD(i,klev-l+1-1,k) 248 249 169 if(l.eq.klev) 250 170 s t_khvd(i,l)=TAUGVD(i,klev-l+1,k) … … 253 173 enddo 254 174 enddo 255 write(str1,'(i2.2)') k 256 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 257 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 258 CALL histwrite(nid_ins,"kgv"//str1,itau_w,zx_tmp_3d, 259 . iim*jjmp1*klev,ndex3d) 175 write(str2,'(i2.2)') k 176 call histwrite_phy(nid_ins,.false.,"kgv"//str2,itau_w,t_khvd) 260 177 enddo ! fin boucle NSPECV 261 178 … … 273 190 enddo 274 191 enddo 275 write(str1,'(i2.2)') k 276 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 277 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 278 CALL histwrite(nid_ins,"kgi"//str1,itau_w,zx_tmp_3d, 279 . iim*jjmp1*klev,ndex3d) 192 write(str2,'(i2.2)') k 193 call histwrite_phy(nid_ins,.false.,"kgi"//str2,itau_w,t_khvd) 280 194 enddo ! fin boucle NSPECI 281 195 282 196 ENDIF !lev_histday.GE.3 283 c 197 284 198 c------------------------------------------------------- 285 199 IF(lev_histday.GE.4) THEN 286 c 287 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d) 288 CALL histwrite(nid_ins,"dtdyn",itau_w,zx_tmp_3d, 289 . iim*jjmp1*klev,ndex3d) 290 c 291 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d) 292 CALL histwrite(nid_ins,"dtphy",itau_w,zx_tmp_3d, 293 . iim*jjmp1*klev,ndex3d) 294 c K/s 295 zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev) 296 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 297 CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d, 298 . iim*jjmp1*klev,ndex3d) 299 c 300 c K/s 301 zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev) 302 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 303 CALL histwrite(nid_ins,"dtajs",itau_w,zx_tmp_3d, 304 . iim*jjmp1*klev,ndex3d) 305 c 306 c K/s 307 zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev) 308 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 309 CALL histwrite(nid_ins,"dtswr",itau_w,zx_tmp_3d, 310 . iim*jjmp1*klev,ndex3d) 311 c 200 201 call histwrite_phy(nid_ins,.false.,"dtdyn",itau_w,d_t_dyn) 202 call histwrite_phy(nid_ins,.false.,"dtphy",itau_w,d_t) 203 c K/s 204 call histwrite_phy(nid_ins,.false.,"dtvdf",itau_w,d_t_vdf) 205 c K/s 206 call histwrite_phy(nid_ins,.false.,"dtajs",itau_w,d_t_ajs) 207 c K/s 208 call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,heat) 209 c K/s 210 call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,-1.*cool) 312 211 c K/s 313 zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev) 314 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 315 CALL histwrite(nid_ins,"dtlwr",itau_w,zx_tmp_3d, 316 . iim*jjmp1*klev,ndex3d) 317 c K/s 318 c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev) 319 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 320 c CALL histwrite(nid_ins,"dtec",itau_w,zx_tmp_3d, 321 c . iim*jjmp1*klev,ndex3d) 322 c 323 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d) 324 c CALL histwrite(nid_ins,"dvvdf",itau_w,zx_tmp_3d, 325 c . iim*jjmp1*klev,ndex3d) 326 c 212 c call histwrite_phy(nid_ins,.false.,"dtec",itau_w,d_t_ec) 213 c call histwrite_phy(nid_ins,.false.,"dvvdf",itau_w,d_v_vdf) 214 327 215 ENDIF !lev_histday.GE.4 328 c 216 329 217 c------------------------------------------------------- 330 218 IF(lev_histday.GE.5) THEN 331 c 332 c 333 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d) 334 c CALL histwrite(nid_ins,"taux_",itau_w, 335 c $ zx_tmp_2d,iim*jjmp1,ndex2d) 336 c 337 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d) 338 c CALL histwrite(nid_ins,"tauy_",itau_w, 339 c $ zx_tmp_2d,iim*jjmp1,ndex2d) 340 c 341 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) 342 c CALL histwrite(nid_ins,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 343 c 344 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) 345 c CALL histwrite(nid_ins,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 346 c 219 220 c call histwrite_phy(nid_ins,.false.,"taux",itau_w,fluxu) 221 c call histwrite_phy(nid_ins,.false.,"tauy",itau_w,fluxv) 222 c call histwrite_phy(nid_ins,.false.,"cdrm",itau_w,cdragm) 223 c call histwrite_phy(nid_ins,.false.,"cdrh",itau_w,cdragh) 224 347 225 ENDIF !lev_histday.GE.5 348 226 c------------------------------------------------------- 349 c 227 350 228 if (ok_sync) then 351 229 call histsync(nid_ins) -
trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h
r808 r1056 1 1 IF (ok_mensuel) THEN 2 c 3 ndex2d = 0 4 ndex3d = 0 5 zx_tmp_2d = 0. 6 zx_tmp_3d = 0. 7 zx_tmp_fi2d=0. 8 zx_tmp_fi3d=0. 9 c 2 10 3 zsto = dtime 11 zout = dtime * FLOAT(ecrit_mth)4 zout = dtime * REAL(ecrit_mth) 12 5 itau_w = itau_phy + itap 13 c 6 14 7 c------------------------------------------------------- 15 8 IF(lev_histmth.GE.1) THEN 16 c 9 17 10 ccccccccccccc 2D fields, invariables 18 c 19 CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) 20 CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 21 C 22 CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d) 23 CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 24 c 11 12 call histwrite_phy(nid_mth,.false.,"phis",itau_w,pphis) 13 call histwrite_phy(nid_mth,.false.,"aire",itau_w,airephy) 14 25 15 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... 26 do j=1,jjmp1 27 do i=1,iim 28 zx_tmp_2d(i,j)=zls*180./RPI ! zls est en radians !! 29 enddo 30 enddo 31 c Correction passage de 360 à 0... Sinon probleme avec moyenne 16 c Correction passage de 360 a 0... Sinon probleme avec moyenne 32 17 if (zls.lt.zlsm1) then 33 zx_tmp_2d = zx_tmp_2d+360. 18 do i=1,klon 19 tmpout(i,1) = zls*180./RPI+360. 20 enddo 34 21 zlsm1 = 2.*RPI 35 22 else 23 do i=1,klon 24 tmpout(i,1) = zls*180./RPI 25 enddo 36 26 zlsm1 = zls 37 27 endif 38 CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)39 c 28 call histwrite_phy(nid_mth,.false.,"ls",itau_w,tmpout(:,1)) 29 40 30 ccccccccccccc 2D fields, variables 41 c 42 CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d) 43 CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 44 c 45 DO i = 1, klon 46 zx_tmp_fi2d(i) = paprs(i,1) 47 ENDDO 48 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 49 CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 50 c 51 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d) 52 c CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 53 c 54 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d) 55 c CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 56 c 57 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) 58 c CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 59 c 60 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) 61 c CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 62 c 31 32 call histwrite_phy(nid_mth,.false.,"tsol",itau_w,ftsol) 33 call histwrite_phy(nid_mth,.false.,"psol",itau_w,paprs(:,1)) 34 35 c call histwrite_phy(nid_mth,.false.,"ue",itau_w,ue) 36 c call histwrite_phy(nid_mth,.false.,"ve",itau_w,ve) 37 63 38 ENDIF !lev_histmth.GE.1 64 c 39 65 40 c------------------------------------------------------- 66 41 IF(lev_histmth.GE.2) THEN 67 c 42 68 43 ccccccccccccc 3D fields, basics 69 c 70 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d) 71 CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d, 72 . iim*jjmp1*klev,ndex3d) 73 c 74 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d) 75 CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d, 76 . iim*jjmp1*klev,ndex3d) 77 c 78 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d) 79 CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d, 80 . iim*jjmp1*klev,ndex3d) 81 c 82 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d) 83 CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d, 84 . iim*jjmp1*klev,ndex3d) 85 c 86 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d) 87 CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d, 88 . iim*jjmp1*klev,ndex3d) 89 c 90 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d) 91 CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d, 92 . iim*jjmp1*klev,ndex3d) 93 c 94 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d) 95 c CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d, 96 c . iim*jjmp1*klev,ndex3d) 97 c 98 CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d) 99 CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 100 c 44 45 call histwrite_phy(nid_mth,.false.,"temp",itau_w,t_seri) 46 call histwrite_phy(nid_mth,.false.,"pres",itau_w,pplay) 47 call histwrite_phy(nid_mth,.false.,"geop",itau_w,zphi) 48 call histwrite_phy(nid_mth,.false.,"vitu",itau_w,u_seri) 49 call histwrite_phy(nid_mth,.false.,"vitv",itau_w,v_seri) 50 call histwrite_phy(nid_mth,.false.,"vitw",itau_w,omega) 51 c call histwrite_phy(nid_mth,.false.,"Kz",itau_w,ycoefh) 52 call histwrite_phy(nid_mth,.false.,"tops",itau_w,topsw) 53 call histwrite_phy(nid_mth,.false.,"duvdf",itau_w,d_u_vdf) 54 call histwrite_phy(nid_mth,.false.,"dudyn",itau_w,d_u_dyn) 55 101 56 cccccccccccccccccc Tracers 102 c 57 103 58 if (iflag_trac.eq.1) THEN 104 59 if (microfi.ge.1) then 105 60 c DO iq=1,nmicro 106 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 107 c . qaer(1:klon,1:klev,iq), zx_tmp_3d) 108 c CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d, 109 c . iim*jjmp1*klev,ndex3d) 61 c call histwrite_phy(nid_mth,.false.,tname(iq), 62 c . itau_w,qaer(1:klon,1:klev,iq)) 110 63 c ENDDO 111 64 c ------- NB AER TOT 112 65 do i=1,klon 113 66 do j=1,klev 114 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad)) 115 enddo 116 enddo 117 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 118 CALL histwrite(nid_mth,"qaer",itau_w,zx_tmp_3d, 119 . iim*jjmp1*klev,ndex3d) 67 tmpout(i,j)= SUM(qaer(i,j,1:nrad)) 68 enddo 69 enddo 70 call histwrite_phy(nid_mth,.false.,"qaer",itau_w,tmpout) 120 71 121 72 if (clouds.eq.1) then … … 123 74 do i=1,klon 124 75 do j=1,klev 125 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad)) 126 enddo 127 enddo 128 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 129 CALL histwrite(nid_mth,"qnoy",itau_w,zx_tmp_3d, 130 . iim*jjmp1*klev,ndex3d) 76 tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad)) 77 enddo 78 enddo 79 call histwrite_phy(nid_mth,.false.,"qnoy",itau_w,tmpout) 131 80 c ------- V GLA1 TOT 132 81 do i=1,klon 133 82 do j=1,klev 134 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad)) 135 enddo 136 enddo 137 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 138 CALL histwrite(nid_mth,"qgl1",itau_w,zx_tmp_3d, 139 . iim*jjmp1*klev,ndex3d) 83 tmpout(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad)) 84 enddo 85 enddo 86 call histwrite_phy(nid_mth,.false.,"qgl1",itau_w,tmpout) 140 87 c ------- V GLA2 TOT 141 88 do i=1,klon 142 89 do j=1,klev 143 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad)) 144 enddo 145 enddo 146 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 147 CALL histwrite(nid_mth,"qgl2",itau_w,zx_tmp_3d, 148 . iim*jjmp1*klev,ndex3d) 90 tmpout(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad)) 91 enddo 92 enddo 93 call histwrite_phy(nid_mth,.false.,"qgl2",itau_w,tmpout) 149 94 c ------- V GLA3 TOT 150 95 do i=1,klon 151 96 do j=1,klev 152 zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad)) 153 enddo 154 enddo 155 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 156 CALL histwrite(nid_mth,"qgl3",itau_w,zx_tmp_3d, 157 . iim*jjmp1*klev,ndex3d) 97 tmpout(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad)) 98 enddo 99 enddo 100 call histwrite_phy(nid_mth,.false.,"qgl3",itau_w,tmpout) 158 101 c -------------- 159 102 c ----- SATURATION ESP NUAGES 160 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d) 161 CALL histwrite(nid_mth,"ch4sat", itau_w, zx_tmp_3d, 162 . iim*jjmp1*klev,ndex3d) 163 164 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d) 165 CALL histwrite(nid_mth,"c2h6sat", itau_w, zx_tmp_3d, 166 . iim*jjmp1*klev,ndex3d) 167 168 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d) 169 CALL histwrite(nid_mth,"c2h2sat", itau_w, zx_tmp_3d, 170 . iim*jjmp1*klev,ndex3d) 103 call histwrite_phy(nid_mth,.false.,"ch4sat",itau_w,satch4) 104 call histwrite_phy(nid_mth,.false.,"c2h6sat",itau_w,satc2h6) 105 call histwrite_phy(nid_mth,.false.,"c2h2sat",itau_w,satc2h2) 171 106 c -------------- 172 107 c ----- RESERVOIR DE SURFACE 173 CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d) 174 CALL histwrite(nid_mth,"reserv",itau_w,zx_tmp_2d, 175 . iim*jjmp1,ndex2d) 108 call histwrite_phy(nid_mth,.false.,"reserv",itau_w,reservoir) 176 109 c -------------- 177 110 c ----- ECHANGE GAZ SURF/ATM (evaporation) 178 CALL gr_fi_ecrit(1, klon,iim,jjmp1,evapch4,zx_tmp_2d) 179 CALL histwrite(nid_mth,"evapch4",itau_w,zx_tmp_2d, 180 . iim*jjmp1,ndex2d) 111 call histwrite_phy(nid_mth,.false.,"evapch4",itau_w,evapch4) 181 112 c -------------- 182 113 c ----- PRECIPITATIONS 183 114 c ----- CH4 184 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d) 185 CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d, 186 . iim*jjmp1,ndex2d) 115 call histwrite_phy(nid_mth,.false.,"prech4", 116 . itau_w,precip(1:klon,1)) 187 117 c ----- C2H6 188 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d) 189 CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d, 190 . iim*jjmp1,ndex2d) 118 call histwrite_phy(nid_mth,.false.,"prec2h6", 119 . itau_w,precip(1:klon,2)) 191 120 c ----- C2H2 192 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d) 193 CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d, 194 . iim*jjmp1,ndex2d) 195 c 121 call histwrite_phy(nid_mth,.false.,"prec2h2", 122 . itau_w,precip(1:klon,3)) 196 123 c ----- NOY 197 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,4),zx_tmp_2d) 198 CALL histwrite(nid_mth,"prenoy",itau_w,zx_tmp_2d, 199 . iim*jjmp1,ndex2d) 124 call histwrite_phy(nid_mth,.false.,"prenoy", 125 . itau_w,precip(1:klon,4)) 200 126 c ----- AER 201 CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,5),zx_tmp_2d) 202 CALL histwrite(nid_mth,"preaer",itau_w,zx_tmp_2d, 203 . iim*jjmp1,ndex2d) 127 call histwrite_phy(nid_mth,.false.,"preaer", 128 . itau_w,precip(1:klon,5)) 204 129 c -------------- 205 130 c ----- FLUX GLACE 206 131 c ----- CH4 207 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 208 . flxesp_i(1:klon,1:klev,1),zx_tmp_3d) 209 CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d, 210 . iim*jjmp1*klev,ndex3d) 132 call histwrite_phy(nid_mth,.false.,"flxgl1", 133 . itau_w,flxesp_i(1:klon,1:klev,1)) 211 134 c ----- C2H6 212 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 213 . flxesp_i(1:klon,1:klev,2),zx_tmp_3d) 214 CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d, 215 . iim*jjmp1*klev,ndex3d) 135 call histwrite_phy(nid_mth,.false.,"flxgl2", 136 . itau_w,flxesp_i(1:klon,1:klev,2)) 216 137 c ----- C2H2 217 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 218 . flxesp_i(1:klon,1:klev,3),zx_tmp_3d) 219 CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d, 220 . iim*jjmp1*klev,ndex3d) 138 call histwrite_phy(nid_mth,.false.,"flxgl3", 139 . itau_w,flxesp_i(1:klon,1:klev,3)) 221 140 c -------------- 222 141 c ----- Source/puits GLACE 223 142 c ----- CH4 224 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 225 . solesp(1:klon,1:klev,1),zx_tmp_3d) 226 CALL histwrite(nid_mth,"solch4", itau_w, zx_tmp_3d, 227 . iim*jjmp1*klev,ndex3d) 143 call histwrite_phy(nid_mth,.false.,"solch4", 144 . itau_w,solesp(1:klon,1:klev,1)) 228 145 c ----- C2H6 229 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 230 . solesp(1:klon,1:klev,2),zx_tmp_3d) 231 CALL histwrite(nid_mth,"solc2h6", itau_w, zx_tmp_3d, 232 . iim*jjmp1*klev,ndex3d) 146 call histwrite_phy(nid_mth,.false.,"solc2h6", 147 . itau_w,solesp(1:klon,1:klev,2)) 233 148 c ----- C2H2 234 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 235 . solesp(1:klon,1:klev,3),zx_tmp_3d) 236 CALL histwrite(nid_mth,"solc2h2", itau_w, zx_tmp_3d, 237 . iim*jjmp1*klev,ndex3d) 238 c 149 call histwrite_phy(nid_mth,.false.,"solc2h2", 150 . itau_w,solesp(1:klon,1:klev,3)) 239 151 c -------------- 240 152 c ----- RAYON MOYEN GOUTTE 241 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d) 242 CALL histwrite(nid_mth,"rcldbar", itau_w, zx_tmp_3d, 243 . iim*jjmp1*klev,ndex3d) 244 c 153 call histwrite_phy(nid_mth,.false.,"rcldbar",itau_w,rmcloud) 154 245 155 endif 246 156 endif 247 c 157 248 158 c -------------- 249 159 c ----- TRACEURS CHIMIQUES 250 160 if (nmicro.lt.nqmax) then 251 161 DO iq=nmicro+1,nqmax 252 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d) 253 CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d, 254 . iim*jjmp1*klev,ndex3d) 162 call histwrite_phy(nid_mth,.false.,tname(iq), 163 . itau_w,tr_seri(1:klon,1:klev,iq)) 255 164 ENDDO 256 165 c Condensation: 257 166 c DO iq=nmicro+1,nqmax 258 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d) 259 c CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d, 260 c . iim*jjmp1*klev,ndex3d) 167 c call histwrite_phy(nid_mth,.false.,"c_"//tname(iq), 168 c . itau_w,d_tr_mph(1:klon,1:klev,iq)) 261 169 c ENDDO 262 170 endif 263 171 endif 264 c 172 265 173 ENDIF !lev_histmth.GE.2 266 c 174 267 175 c------------------------------------------------------- 268 176 IF(lev_histmth.GE.3) THEN 269 c 177 270 178 cccccccccccccccccc Radiative transfer 271 c 179 272 180 c 2D 273 c 274 CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d) 275 CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 276 c 277 CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d) 278 CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 279 c 280 CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d) 281 CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 282 c 181 182 call histwrite_phy(nid_mth,.false.,"topl",itau_w,toplw) 183 call histwrite_phy(nid_mth,.false.,"sols",itau_w,solsw) 184 call histwrite_phy(nid_mth,.false.,"soll",itau_w,sollw) 185 283 186 c 3D 284 c 285 zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev) 286 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 287 CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d, 288 . iim*jjmp1*klev,ndex3d) 289 c 290 zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev) 291 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 292 CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d, 293 . iim*jjmp1*klev,ndex3d) 294 c 187 188 call histwrite_phy(nid_mth,.false.,"SWnet", 189 . itau_w,swnet(1:klon,1:klev)) 190 call histwrite_phy(nid_mth,.false.,"LWnet", 191 . itau_w,lwnet(1:klon,1:klev)) 192 295 193 c -------------- 296 194 c ----- OPACITE BRUME … … 301 199 enddo 302 200 enddo 303 write(str1,'(i2.2)') k 304 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 305 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 306 CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d, 307 . iim*jjmp1*klev,ndex3d) 201 write(str2,'(i2.2)') k 202 call histwrite_phy(nid_mth,.false.,"thv"//str2,itau_w,t_tauhvd) 308 203 enddo ! fin boucle NSPECV 309 204 … … 314 209 enddo 315 210 enddo 316 write(str1,'(i2.2)') k 317 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 318 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 319 CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d, 320 . iim*jjmp1*klev,ndex3d) 211 write(str2,'(i2.2)') k 212 call histwrite_phy(nid_mth,.false.,"thi"//str2,itau_w,t_tauhvd) 321 213 enddo ! fin boucle NSPECI 322 c323 214 c -------------- 324 215 c ----- EXTINCTION BRUME … … 335 226 enddo 336 227 enddo 337 write(str1,'(i2.2)') k 338 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 339 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 340 CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d, 341 . iim*jjmp1*klev,ndex3d) 228 write(str2,'(i2.2)') k 229 call histwrite_phy(nid_mth,.false.,"khv"//str2,itau_w,t_khvd) 342 230 enddo ! fin boucle NSPECV 343 231 … … 354 242 enddo 355 243 enddo 356 write(str1,'(i2.2)') k 357 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 358 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 359 CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d, 360 . iim*jjmp1*klev,ndex3d) 244 write(str2,'(i2.2)') k 245 call histwrite_phy(nid_mth,.false.,"khi"//str2,itau_w,t_khvd) 361 246 enddo ! fin boucle NSPECI 362 c363 247 c -------------- 364 248 c ----- OPACITE GAZ … … 369 253 enddo 370 254 enddo 371 write(str1,'(i2.2)') k 372 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 373 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 374 CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d, 375 . iim*jjmp1*klev,ndex3d) 255 write(str2,'(i2.2)') k 256 call histwrite_phy(nid_mth,.false.,"tgv"//str2,itau_w,t_tauhvd) 376 257 enddo ! fin boucle NSPECV 377 258 … … 382 263 enddo 383 264 enddo 384 write(str1,'(i2.2)') k 385 zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev) 386 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 387 CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d, 388 . iim*jjmp1*klev,ndex3d) 265 write(str2,'(i2.2)') k 266 call histwrite_phy(nid_mth,.false.,"tgi"//str2,itau_w,t_tauhvd) 389 267 enddo ! fin boucle NSPECI 390 c391 268 c -------------- 392 269 c ----- EXTINCTION GAZ … … 403 280 enddo 404 281 enddo 405 write(str1,'(i2.2)') k 406 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 407 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 408 CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d, 409 . iim*jjmp1*klev,ndex3d) 282 write(str2,'(i2.2)') k 283 call histwrite_phy(nid_mth,.false.,"kgv"//str2,itau_w,t_khvd) 410 284 enddo ! fin boucle NSPECV 411 285 … … 423 297 enddo 424 298 enddo 425 write(str1,'(i2.2)') k 426 zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev) 427 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 428 CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d, 429 . iim*jjmp1*klev,ndex3d) 299 write(str2,'(i2.2)') k 300 call histwrite_phy(nid_mth,.false.,"kgi"//str2,itau_w,t_khvd) 430 301 enddo ! fin boucle NSPECI 431 302 432 303 c -------------- 304 if (clouds.eq.1) then 305 c -------------- 433 306 c ----- OPACITE NUAGES (ATTENTION PROXY) 434 if (clouds.eq.1) then 435 zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev) 436 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 437 CALL histwrite(nid_mth,"tcld",itau_w,zx_tmp_3d, 438 . iim*jjmp1*klev,ndex3d) 307 call histwrite_phy(nid_mth,.false.,"tcld",itau_w,occcld) 439 308 c -------------- 440 309 c ----- EXTINCTION NUAGES (ATTENTION PROXY) … … 447 316 enddo 448 317 enddo 449 zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev) 450 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 451 CALL histwrite(nid_mth,"kcld",itau_w,zx_tmp_3d, 452 . iim*jjmp1*klev,ndex3d) 453 c 318 call histwrite_phy(nid_mth,.false.,"kcld",itau_w,t_kcld) 454 319 c -------------- 455 320 c ----- OCCURENCE NUAGES 456 321 do k=1,12 457 write(str1,'(i2.2)') k 458 zx_tmp_fi3d(1:klon,1:klev)=occcld_m(1:klon,1:klev,k) 459 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 460 CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d, 461 . iim*jjmp1*klev,ndex3d) 322 write(str2,'(i2.2)') k 323 call histwrite_phy(nid_mth,.false.,"occcld"//str2, 324 . itau_w,occcld_m(1:klon,1:klev,k)) 462 325 enddo 463 c 326 c -------------- 464 327 endif 465 c 328 c -------------- 329 466 330 ENDIF !lev_histmth.GE.3 467 c 331 468 332 c------------------------------------------------------- 469 333 IF(lev_histmth.GE.4) THEN 470 c 471 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d) 472 CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d, 473 . iim*jjmp1*klev,ndex3d) 474 c 475 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d) 476 CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d, 477 . iim*jjmp1*klev,ndex3d) 334 335 call histwrite_phy(nid_mth,.false.,"dtdyn",itau_w,d_t_dyn) 336 call histwrite_phy(nid_mth,.false.,"dtphy",itau_w,d_t) 478 337 c K/s 479 zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev) 480 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 481 CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d, 482 . iim*jjmp1*klev,ndex3d) 483 c 338 call histwrite_phy(nid_mth,.false.,"dtvdf",itau_w,d_t_vdf) 484 339 c K/s 485 zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev) 486 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 487 CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d, 488 . iim*jjmp1*klev,ndex3d) 489 c 340 call histwrite_phy(nid_mth,.false.,"dtajs",itau_w,d_t_ajs) 490 341 c K/s 491 zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev) 492 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 493 CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d, 494 . iim*jjmp1*klev,ndex3d) 495 c 342 call histwrite_phy(nid_mth,.false.,"dtswr",itau_w,heat) 343 c K/s 344 call histwrite_phy(nid_mth,.false.,"dtlwr",itau_w,-1.*cool) 496 345 c K/s 497 zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev) 498 CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 499 CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d, 500 . iim*jjmp1*klev,ndex3d) 501 c K/s 502 c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev) 503 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d) 504 c CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d, 505 c . iim*jjmp1*klev,ndex3d) 506 c 507 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d) 508 CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d, 509 . iim*jjmp1*klev,ndex3d) 510 c 511 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d) 512 CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d, 513 . iim*jjmp1*klev,ndex3d) 514 c 515 c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d) 516 c CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d, 517 c . iim*jjmp1*klev,ndex3d) 518 c 346 c call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec) 347 c call histwrite_phy(nid_mth,.false.,"dvvdf",itau_w,d_v_vdf) 348 519 349 ENDIF !lev_histmth.GE.4 520 350 c 521 351 c------------------------------------------------------- 522 352 IF(lev_histmth.GE.5) THEN 523 c 524 c 525 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d) 526 c CALL histwrite(nid_mth,"taux_",itau_w, 527 c $ zx_tmp_2d,iim*jjmp1,ndex2d) 528 c 529 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d) 530 c CALL histwrite(nid_mth,"tauy_",itau_w, 531 c $ zx_tmp_2d,iim*jjmp1,ndex2d) 532 c 533 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d) 534 c CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 535 c 536 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d) 537 c CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 538 c 353 354 c call histwrite_phy(nid_mth,.false.,"taux",itau_w,fluxu) 355 c call histwrite_phy(nid_mth,.false.,"tauy",itau_w,fluxv) 356 c call histwrite_phy(nid_mth,.false.,"cdrm",itau_w,cdragm) 357 c call histwrite_phy(nid_mth,.false.,"cdrh",itau_w,cdragh) 358 539 359 ENDIF !lev_histmth.GE.5 540 360 c------------------------------------------------------- 541 c 361 542 362 if (ok_sync) then 543 363 call histsync(nid_mth) -
trunk/LMDZ.TITAN/libf/phytitan/writerestartphy.F
r779 r1056 4 4 . solsw, sollw,fder, 5 5 . radsol, 6 . zmea, zstd, zsig, zgam, zthe, zpic, zval, 6 7 . t_ancien) 7 8 … … 27 28 real fder(klon) 28 29 REAL radsol(klon) 30 REAL zmea(klon), zstd(klon) 31 REAL zsig(klon), zgam(klon), zthe(klon) 32 REAL zpic(klon), zval(klon) 29 33 REAL t_ancien(klon,klev) 30 34 c … … 218 222 ierr = NF_REDEF (nid) 219 223 #ifdef NC_DOUBLE 224 ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid) 225 #else 226 ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid) 227 #endif 228 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 229 . "zmea Orographie sous-maille") 230 ierr = NF_ENDDEF(nid) 231 #ifdef NC_DOUBLE 232 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea) 233 #else 234 ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea) 235 #endif 236 c 237 ierr = NF_REDEF (nid) 238 #ifdef NC_DOUBLE 239 ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid) 240 #else 241 ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid) 242 #endif 243 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 244 . "zstd Orographie sous-maille") 245 ierr = NF_ENDDEF(nid) 246 #ifdef NC_DOUBLE 247 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd) 248 #else 249 ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd) 250 #endif 251 c 252 ierr = NF_REDEF (nid) 253 #ifdef NC_DOUBLE 254 ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid) 255 #else 256 ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid) 257 #endif 258 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 259 . "zsig Orographie sous-maille") 260 ierr = NF_ENDDEF(nid) 261 #ifdef NC_DOUBLE 262 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig) 263 #else 264 ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig) 265 #endif 266 c 267 ierr = NF_REDEF (nid) 268 #ifdef NC_DOUBLE 269 ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid) 270 #else 271 ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid) 272 #endif 273 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 274 . "zgam Orographie sous-maille") 275 ierr = NF_ENDDEF(nid) 276 #ifdef NC_DOUBLE 277 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam) 278 #else 279 ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam) 280 #endif 281 c 282 ierr = NF_REDEF (nid) 283 #ifdef NC_DOUBLE 284 ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid) 285 #else 286 ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid) 287 #endif 288 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 289 . "zthe Orographie sous-maille") 290 ierr = NF_ENDDEF(nid) 291 #ifdef NC_DOUBLE 292 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe) 293 #else 294 ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe) 295 #endif 296 c 297 ierr = NF_REDEF (nid) 298 #ifdef NC_DOUBLE 299 ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid) 300 #else 301 ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid) 302 #endif 303 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 304 . "zpic Orographie sous-maille") 305 ierr = NF_ENDDEF(nid) 306 #ifdef NC_DOUBLE 307 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic) 308 #else 309 ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic) 310 #endif 311 c 312 ierr = NF_REDEF (nid) 313 #ifdef NC_DOUBLE 314 ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid) 315 #else 316 ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid) 317 #endif 318 ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, 319 . "zval Orographie sous-maille") 320 ierr = NF_ENDDEF(nid) 321 #ifdef NC_DOUBLE 322 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval) 323 #else 324 ierr = NF_PUT_VAR_REAL (nid,nvarid,zval) 325 #endif 326 c 327 ierr = NF_REDEF (nid) 328 #ifdef NC_DOUBLE 220 329 ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid) 221 330 #else
Note: See TracChangeset
for help on using the changeset viewer.
