Changeset 2489 for LMDZ5/trunk

Timestamp:

Apr 4, 2016, 5:35:23 PM (9 years ago)

Author:

oboucher

Message:

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

File:

• LMDZ5/trunk/libf/phylmd/physiq_mod.F90 (modified) (2 diffs)

LMDZ5/trunk/libf/phylmd/physiq_mod.F90

@@ -4377 +4377 @@
     !
 
-    ! Sauvegarder les valeurs de t et q a la fin de la physique:
-    !
-    DO k = 1, klev
-       DO i = 1, klon
-          u_ancien(i,k) = u_seri(i,k)
-          v_ancien(i,k) = v_seri(i,k)
-          t_ancien(i,k) = t_seri(i,k)
-          q_ancien(i,k) = q_seri(i,k)
-       ENDDO
-    ENDDO
-
-    ! !! RomP >>>
-    !CR: nb de traceurs eau: nqo
-    !  IF (nqtot.GE.3) THEN
-    IF (nqtot.GE.(nqo+1)) THEN
-       !     DO iq = 3, nqtot
-       DO iq = nqo+1, nqtot
-          DO k = 1, klev
-             DO i = 1, klon
-                !              tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2)
-                tr_ancien(i,k,iq-nqo) = tr_seri(i,k,iq-nqo)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-    ! !! RomP <<<
-    !==========================================================================
-    ! Sorties des tendances pour un point particulier
-    ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
-    ! pour le debug
-    ! La valeur de igout est attribuee plus haut dans le programme
-    !==========================================================================
-
-    if (prt_level.ge.1) then
-       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
-       write(lunout,*) &
-            'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
-       write(lunout,*) &
-            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
-            pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
-            pctsrf(igout,is_sic)
-       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
-       do k=1,klev
-          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
-               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
-               d_t_eva(igout,k)
-       enddo
-       write(lunout,*) 'cool,heat'
-       do k=1,klev
-          write(lunout,*) cool(igout,k),heat(igout,k)
-       enddo
-
-       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
-       !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
-       !jyg!     do k=1,klev
-       !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
-       !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
-       !jyg!     enddo
-       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
-       do k=1,klev
-          write(lunout,*) d_t_vdf(igout,k), &
-               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
-       enddo
-       !>jyg
-
-       write(lunout,*) 'd_ps ',d_ps(igout)
-       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
-       do k=1,klev
-          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
-               d_qx(igout,k,1),d_qx(igout,k,2)
-       enddo
-    endif
-
-    !==========================================================================
-
-    !============================================================
-    !   Calcul de la temperature potentielle
-    !============================================================
-    DO k = 1, klev
-       DO i = 1, klon
-          !JYG/IM theta en debut du pas de temps
-          !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
-          !JYG/IM theta en fin de pas de temps de physique
-          theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
-          ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
-          !     MPL 20130625
-          ! fth_fonctions.F90 et parkind1.F90
-          ! sinon thetal=theta
-          !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
-          !    :         ql_seri(i,k))
-          thetal(i,k)=theta(i,k)
-       ENDDO
-    ENDDO
-    !
-
-    ! 22.03.04 BEG
-    !=============================================================
-    !   Ecriture des sorties
-    !=============================================================
-#ifdef CPP_IOIPSL
-
-    ! Recupere des varibles calcule dans differents modules
-    ! pour ecriture dans histxxx.nc 
-
-    ! Get some variables from module fonte_neige_mod
-    CALL fonte_neige_get_vars(pctsrf,  &
-         zxfqcalving, zxfqfonte, zxffonte)
-
-
-
-
-    !=============================================================
-    ! Separation entre thermiques et non thermiques dans les sorties
-    ! de fisrtilp
-    !=============================================================
-
-    if (iflag_thermals>=1) then
-       d_t_lscth=0.
-       d_t_lscst=0.
-       d_q_lscth=0.
-       d_q_lscst=0.
-       do k=1,klev
-          do i=1,klon
-             if (ptconvth(i,k)) then
-                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
-                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
-             else
-                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
-                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
-             endif
-          enddo
-       enddo
-
-       do i=1,klon
-          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
-          plul_th(i)=prfl(i,1)+psfl(i,1)
-       enddo
-    endif
-
-
-    !On effectue les sorties:
-
-    CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
-         pplay, lmax_th, aerosol_couple,                 &
-         ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
-         ptconv, read_climoz, clevSTD,                   &
-         ptconvth, d_t, qx, d_qx, zmasse,                &
-         flag_aerosol, flag_aerosol_strat, ok_cdnc)
-
-
-
-    include "write_histday_seri.h"
-
-    include "write_paramLMDZ_phy.h"
-
-#endif
-
-
-    !====================================================================
-    ! Arret du modele apres hgardfou en cas de detection d'un
-    ! plantage par hgardfou
-    !====================================================================
-
-    IF (abortphy==1) THEN
-       abort_message ='Plantage hgardfou'
-       CALL abort_physic (modname,abort_message,1)
-    ENDIF
-
     !--OB mass fixer 
     !--profile is corrected to force mass conservation of water
@@ -4565 +4397 @@
     !--fin mass fixer
 
+    ! Sauvegarder les valeurs de t et q a la fin de la physique:
+    !
+    DO k = 1, klev
+       DO i = 1, klon
+          u_ancien(i,k) = u_seri(i,k)
+          v_ancien(i,k) = v_seri(i,k)
+          t_ancien(i,k) = t_seri(i,k)
+          q_ancien(i,k) = q_seri(i,k)
+       ENDDO
+    ENDDO
+
+    ! !! RomP >>>
+    !CR: nb de traceurs eau: nqo
+    !  IF (nqtot.GE.3) THEN
+    IF (nqtot.GE.(nqo+1)) THEN
+       !     DO iq = 3, nqtot
+       DO iq = nqo+1, nqtot
+          DO k = 1, klev
+             DO i = 1, klon
+                !              tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2)
+                tr_ancien(i,k,iq-nqo) = tr_seri(i,k,iq-nqo)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+    ! !! RomP <<<
+    !==========================================================================
+    ! Sorties des tendances pour un point particulier
+    ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
+    ! pour le debug
+    ! La valeur de igout est attribuee plus haut dans le programme
+    !==========================================================================
+
+    if (prt_level.ge.1) then
+       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
+       write(lunout,*) &
+            'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
+       write(lunout,*) &
+            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
+            pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
+            pctsrf(igout,is_sic)
+       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
+       do k=1,klev
+          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
+               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
+               d_t_eva(igout,k)
+       enddo
+       write(lunout,*) 'cool,heat'
+       do k=1,klev
+          write(lunout,*) cool(igout,k),heat(igout,k)
+       enddo
+
+       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
+       !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
+       !jyg!     do k=1,klev
+       !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
+       !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
+       !jyg!     enddo
+       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
+       do k=1,klev
+          write(lunout,*) d_t_vdf(igout,k), &
+               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
+       enddo
+       !>jyg
+
+       write(lunout,*) 'd_ps ',d_ps(igout)
+       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
+       do k=1,klev
+          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
+               d_qx(igout,k,1),d_qx(igout,k,2)
+       enddo
+    endif
+
+    !==========================================================================
+
+    !============================================================
+    !   Calcul de la temperature potentielle
+    !============================================================
+    DO k = 1, klev
+       DO i = 1, klon
+          !JYG/IM theta en debut du pas de temps
+          !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
+          !JYG/IM theta en fin de pas de temps de physique
+          theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
+          ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
+          !     MPL 20130625
+          ! fth_fonctions.F90 et parkind1.F90
+          ! sinon thetal=theta
+          !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
+          !    :         ql_seri(i,k))
+          thetal(i,k)=theta(i,k)
+       ENDDO
+    ENDDO
+    !
+
+    ! 22.03.04 BEG
+    !=============================================================
+    !   Ecriture des sorties
+    !=============================================================
+#ifdef CPP_IOIPSL
+
+    ! Recupere des varibles calcule dans differents modules
+    ! pour ecriture dans histxxx.nc 
+
+    ! Get some variables from module fonte_neige_mod
+    CALL fonte_neige_get_vars(pctsrf,  &
+         zxfqcalving, zxfqfonte, zxffonte)
+
+
+
+
+    !=============================================================
+    ! Separation entre thermiques et non thermiques dans les sorties
+    ! de fisrtilp
+    !=============================================================
+
+    if (iflag_thermals>=1) then
+       d_t_lscth=0.
+       d_t_lscst=0.
+       d_q_lscth=0.
+       d_q_lscst=0.
+       do k=1,klev
+          do i=1,klon
+             if (ptconvth(i,k)) then
+                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
+                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
+             else
+                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
+                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
+             endif
+          enddo
+       enddo
+
+       do i=1,klon
+          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
+          plul_th(i)=prfl(i,1)+psfl(i,1)
+       enddo
+    endif
+
+
+    !On effectue les sorties:
+
+    CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
+         pplay, lmax_th, aerosol_couple,                 &
+         ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
+         ptconv, read_climoz, clevSTD,                   &
+         ptconvth, d_t, qx, d_qx, zmasse,                &
+         flag_aerosol, flag_aerosol_strat, ok_cdnc)
+
+
+
+    include "write_histday_seri.h"
+
+    include "write_paramLMDZ_phy.h"
+
+#endif
+
+
+    !====================================================================
+    ! Arret du modele apres hgardfou en cas de detection d'un
+    ! plantage par hgardfou
+    !====================================================================
+
+    IF (abortphy==1) THEN
+       abort_message ='Plantage hgardfou'
+       CALL abort_physic (modname,abort_message,1)
+    ENDIF
+
     ! 22.03.04 END
     !