Ignore:
Timestamp:
Apr 4, 2016, 5:35:23 PM (8 years ago)
Author:
oboucher
Message:

moved the water vapour mass fixer for the physics before q_seri is copied in q_ancien

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/physiq_mod.F90

    r2485 r2489  
    43774377    !
    43784378
    4379     ! Sauvegarder les valeurs de t et q a la fin de la physique:
    4380     !
    4381     DO k = 1, klev
    4382        DO i = 1, klon
    4383           u_ancien(i,k) = u_seri(i,k)
    4384           v_ancien(i,k) = v_seri(i,k)
    4385           t_ancien(i,k) = t_seri(i,k)
    4386           q_ancien(i,k) = q_seri(i,k)
    4387        ENDDO
    4388     ENDDO
    4389 
    4390     ! !! RomP >>>
    4391     !CR: nb de traceurs eau: nqo
    4392     !  IF (nqtot.GE.3) THEN
    4393     IF (nqtot.GE.(nqo+1)) THEN
    4394        !     DO iq = 3, nqtot
    4395        DO iq = nqo+1, nqtot
    4396           DO k = 1, klev
    4397              DO i = 1, klon
    4398                 !              tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2)
    4399                 tr_ancien(i,k,iq-nqo) = tr_seri(i,k,iq-nqo)
    4400              ENDDO
    4401           ENDDO
    4402        ENDDO
    4403     ENDIF
    4404     ! !! RomP <<<
    4405     !==========================================================================
    4406     ! Sorties des tendances pour un point particulier
    4407     ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
    4408     ! pour le debug
    4409     ! La valeur de igout est attribuee plus haut dans le programme
    4410     !==========================================================================
    4411 
    4412     if (prt_level.ge.1) then
    4413        write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    4414        write(lunout,*) &
    4415             'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
    4416        write(lunout,*) &
    4417             nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
    4418             pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
    4419             pctsrf(igout,is_sic)
    4420        write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
    4421        do k=1,klev
    4422           write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
    4423                d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
    4424                d_t_eva(igout,k)
    4425        enddo
    4426        write(lunout,*) 'cool,heat'
    4427        do k=1,klev
    4428           write(lunout,*) cool(igout,k),heat(igout,k)
    4429        enddo
    4430 
    4431        !jyg<     (En attendant de statuer sur le sort de d_t_oli)
    4432        !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    4433        !jyg!     do k=1,klev
    4434        !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
    4435        !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    4436        !jyg!     enddo
    4437        write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    4438        do k=1,klev
    4439           write(lunout,*) d_t_vdf(igout,k), &
    4440                d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    4441        enddo
    4442        !>jyg
    4443 
    4444        write(lunout,*) 'd_ps ',d_ps(igout)
    4445        write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
    4446        do k=1,klev
    4447           write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
    4448                d_qx(igout,k,1),d_qx(igout,k,2)
    4449        enddo
    4450     endif
    4451 
    4452     !==========================================================================
    4453 
    4454     !============================================================
    4455     !   Calcul de la temperature potentielle
    4456     !============================================================
    4457     DO k = 1, klev
    4458        DO i = 1, klon
    4459           !JYG/IM theta en debut du pas de temps
    4460           !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
    4461           !JYG/IM theta en fin de pas de temps de physique
    4462           theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
    4463           ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
    4464           !     MPL 20130625
    4465           ! fth_fonctions.F90 et parkind1.F90
    4466           ! sinon thetal=theta
    4467           !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
    4468           !    :         ql_seri(i,k))
    4469           thetal(i,k)=theta(i,k)
    4470        ENDDO
    4471     ENDDO
    4472     !
    4473 
    4474     ! 22.03.04 BEG
    4475     !=============================================================
    4476     !   Ecriture des sorties
    4477     !=============================================================
    4478 #ifdef CPP_IOIPSL
    4479 
    4480     ! Recupere des varibles calcule dans differents modules
    4481     ! pour ecriture dans histxxx.nc
    4482 
    4483     ! Get some variables from module fonte_neige_mod
    4484     CALL fonte_neige_get_vars(pctsrf,  &
    4485          zxfqcalving, zxfqfonte, zxffonte)
    4486 
    4487 
    4488 
    4489 
    4490     !=============================================================
    4491     ! Separation entre thermiques et non thermiques dans les sorties
    4492     ! de fisrtilp
    4493     !=============================================================
    4494 
    4495     if (iflag_thermals>=1) then
    4496        d_t_lscth=0.
    4497        d_t_lscst=0.
    4498        d_q_lscth=0.
    4499        d_q_lscst=0.
    4500        do k=1,klev
    4501           do i=1,klon
    4502              if (ptconvth(i,k)) then
    4503                 d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    4504                 d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4505              else
    4506                 d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    4507                 d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4508              endif
    4509           enddo
    4510        enddo
    4511 
    4512        do i=1,klon
    4513           plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
    4514           plul_th(i)=prfl(i,1)+psfl(i,1)
    4515        enddo
    4516     endif
    4517 
    4518 
    4519     !On effectue les sorties:
    4520 
    4521     CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
    4522          pplay, lmax_th, aerosol_couple,                 &
    4523          ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
    4524          ptconv, read_climoz, clevSTD,                   &
    4525          ptconvth, d_t, qx, d_qx, zmasse,                &
    4526          flag_aerosol, flag_aerosol_strat, ok_cdnc)
    4527 
    4528 
    4529 
    4530     include "write_histday_seri.h"
    4531 
    4532     include "write_paramLMDZ_phy.h"
    4533 
    4534 #endif
    4535 
    4536 
    4537     !====================================================================
    4538     ! Arret du modele apres hgardfou en cas de detection d'un
    4539     ! plantage par hgardfou
    4540     !====================================================================
    4541 
    4542     IF (abortphy==1) THEN
    4543        abort_message ='Plantage hgardfou'
    4544        CALL abort_physic (modname,abort_message,1)
    4545     ENDIF
    4546 
    45474379    !--OB mass fixer
    45484380    !--profile is corrected to force mass conservation of water
    … …  
    45654397    !--fin mass fixer
    45664398
     4399    ! Sauvegarder les valeurs de t et q a la fin de la physique:
     4400    !
     4401    DO k = 1, klev
     4402       DO i = 1, klon
     4403          u_ancien(i,k) = u_seri(i,k)
     4404          v_ancien(i,k) = v_seri(i,k)
     4405          t_ancien(i,k) = t_seri(i,k)
     4406          q_ancien(i,k) = q_seri(i,k)
     4407       ENDDO
     4408    ENDDO
     4409
     4410    ! !! RomP >>>
     4411    !CR: nb de traceurs eau: nqo
     4412    !  IF (nqtot.GE.3) THEN
     4413    IF (nqtot.GE.(nqo+1)) THEN
     4414       !     DO iq = 3, nqtot
     4415       DO iq = nqo+1, nqtot
     4416          DO k = 1, klev
     4417             DO i = 1, klon
     4418                !              tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2)
     4419                tr_ancien(i,k,iq-nqo) = tr_seri(i,k,iq-nqo)
     4420             ENDDO
     4421          ENDDO
     4422       ENDDO
     4423    ENDIF
     4424    ! !! RomP <<<
     4425    !==========================================================================
     4426    ! Sorties des tendances pour un point particulier
     4427    ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
     4428    ! pour le debug
     4429    ! La valeur de igout est attribuee plus haut dans le programme
     4430    !==========================================================================
     4431
     4432    if (prt_level.ge.1) then
     4433       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
     4434       write(lunout,*) &
     4435            'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
     4436       write(lunout,*) &
     4437            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
     4438            pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
     4439            pctsrf(igout,is_sic)
     4440       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
     4441       do k=1,klev
     4442          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
     4443               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
     4444               d_t_eva(igout,k)
     4445       enddo
     4446       write(lunout,*) 'cool,heat'
     4447       do k=1,klev
     4448          write(lunout,*) cool(igout,k),heat(igout,k)
     4449       enddo
     4450
     4451       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
     4452       !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
     4453       !jyg!     do k=1,klev
     4454       !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
     4455       !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
     4456       !jyg!     enddo
     4457       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
     4458       do k=1,klev
     4459          write(lunout,*) d_t_vdf(igout,k), &
     4460               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
     4461       enddo
     4462       !>jyg
     4463
     4464       write(lunout,*) 'd_ps ',d_ps(igout)
     4465       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
     4466       do k=1,klev
     4467          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
     4468               d_qx(igout,k,1),d_qx(igout,k,2)
     4469       enddo
     4470    endif
     4471
     4472    !==========================================================================
     4473
     4474    !============================================================
     4475    !   Calcul de la temperature potentielle
     4476    !============================================================
     4477    DO k = 1, klev
     4478       DO i = 1, klon
     4479          !JYG/IM theta en debut du pas de temps
     4480          !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
     4481          !JYG/IM theta en fin de pas de temps de physique
     4482          theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
     4483          ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
     4484          !     MPL 20130625
     4485          ! fth_fonctions.F90 et parkind1.F90
     4486          ! sinon thetal=theta
     4487          !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
     4488          !    :         ql_seri(i,k))
     4489          thetal(i,k)=theta(i,k)
     4490       ENDDO
     4491    ENDDO
     4492    !
     4493
     4494    ! 22.03.04 BEG
     4495    !=============================================================
     4496    !   Ecriture des sorties
     4497    !=============================================================
     4498#ifdef CPP_IOIPSL
     4499
     4500    ! Recupere des varibles calcule dans differents modules
     4501    ! pour ecriture dans histxxx.nc
     4502
     4503    ! Get some variables from module fonte_neige_mod
     4504    CALL fonte_neige_get_vars(pctsrf,  &
     4505         zxfqcalving, zxfqfonte, zxffonte)
     4506
     4507
     4508
     4509
     4510    !=============================================================
     4511    ! Separation entre thermiques et non thermiques dans les sorties
     4512    ! de fisrtilp
     4513    !=============================================================
     4514
     4515    if (iflag_thermals>=1) then
     4516       d_t_lscth=0.
     4517       d_t_lscst=0.
     4518       d_q_lscth=0.
     4519       d_q_lscst=0.
     4520       do k=1,klev
     4521          do i=1,klon
     4522             if (ptconvth(i,k)) then
     4523                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
     4524                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
     4525             else
     4526                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
     4527                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
     4528             endif
     4529          enddo
     4530       enddo
     4531
     4532       do i=1,klon
     4533          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
     4534          plul_th(i)=prfl(i,1)+psfl(i,1)
     4535       enddo
     4536    endif
     4537
     4538
     4539    !On effectue les sorties:
     4540
     4541    CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
     4542         pplay, lmax_th, aerosol_couple,                 &
     4543         ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
     4544         ptconv, read_climoz, clevSTD,                   &
     4545         ptconvth, d_t, qx, d_qx, zmasse,                &
     4546         flag_aerosol, flag_aerosol_strat, ok_cdnc)
     4547
     4548
     4549
     4550    include "write_histday_seri.h"
     4551
     4552    include "write_paramLMDZ_phy.h"
     4553
     4554#endif
     4555
     4556
     4557    !====================================================================
     4558    ! Arret du modele apres hgardfou en cas de detection d'un
     4559    ! plantage par hgardfou
     4560    !====================================================================
     4561
     4562    IF (abortphy==1) THEN
     4563       abort_message ='Plantage hgardfou'
     4564       CALL abort_physic (modname,abort_message,1)
     4565    ENDIF
     4566
    45674567    ! 22.03.04 END
    45684568    !
Note: See TracChangeset for help on using the changeset viewer.