Changeset 2730 for LMDZ5/trunk/libf/phylmd/physiq_mod.F90

Timestamp:

Dec 14, 2016, 1:10:32 PM (7 years ago)

Author:

jyg

Message:

New input parameter: nbapp_wk = number of calls to
wake routines per day. If =0, call at every physic
time step.

File:

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

LMDZ5/trunk/libf/phylmd/physiq_mod.F90

@@ -139 +139 @@
        kh, kh_x, kh_w, &
        !
+       wake_k, &
        ale_wake, alp_wake, & 
        wake_h, wake_omg, &
@@ -564 +565 @@
     !pourquoi y'a pas de save??
     !
-    INTEGER wake_k(klon)            ! Wake sommet
+!!!    INTEGER, SAVE, DIMENSION(klon)   :: wake_k
+!!!    !$OMP THREADPRIVATE(wake_k) 
     !
     !jyg<
@@ -782 +784 @@
     !ym      SAVE  
     !
-    INTEGER itapcv
-    SAVE itapcv
-    !$OMP THREADPRIVATE(itapcv)
+    INTEGER itapcv, itapwk
+    SAVE itapcv, itapwk
+    !$OMP THREADPRIVATE(itapcv, itapwk)
 
     !KE43
@@ -1285 +1287 @@
        itaprad = 0
        itapcv = 0
+       itapwk = 0
 
        ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1313 +1316 @@
        ENDIF
        IF (nbapp_cv .EQ. 0) nbapp_cv=86400./dtime
-       print *,'physiq, nbapp_cv ',nbapp_cv
+       IF (nbapp_wk .EQ. 0) nbapp_wk=86400./dtime
+       print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk
        IF (MOD(INT(86400./dtime),nbapp_cv).EQ.0) THEN
           cvpas = NINT( 86400./dtime/nbapp_cv)
@@ -1324 +1328 @@
           abort_message='nbre de pas de temps physique n est pas multiple ' &
                // 'de nbapp_cv'
+          call abort_physic(modname,abort_message,1)
+       ENDIF
+       IF (MOD(INT(86400./dtime),nbapp_wk).EQ.0) THEN
+          wkpas = NINT( 86400./dtime/nbapp_wk)
+       print *,'physiq, wkpas ',wkpas
+       ELSE 
+          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
+               'multiple de nbapp_wk'
+          WRITE(lunout,*) 'changer nbapp_wk ou alors commenter ce test ', &
+               'mais 1+1<>2'
+          abort_message='nbre de pas de temps physique n est pas multiple ' &
+               // 'de nbapp_wk'
           call abort_physic(modname,abort_message,1)
        ENDIF
@@ -2317 +2333 @@
     IF (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
          omega(igout, :)
-
     !
     ! Appel de la convection tous les "cvpas"
@@ -2574 +2589 @@
     !    .              d_u_con, d_v_con)
 
+!jyg    Reinitialize proba_notrig and itapcv when convection has been called
+    proba_notrig(:) = 1.
     itapcv = 0
     ENDIF !  (MOD(itapcv,cvpas).EQ.0)
+!
     itapcv = itapcv+1
 
@@ -2640 +2658 @@
     IF (iflag_wake>=1) THEN
        !
-       !  Call wakes only when convection has been called
-       IF (itapcv .EQ. 1) THEN
-       !
-       DO k=1,klev
-          DO i=1,klon
-             dt_dwn(i,k)  = ftd(i,k) 
-             dq_dwn(i,k)  = fqd(i,k) 
-             M_dwn(i,k)   = dnwd0(i,k)
-             M_up(i,k)    = upwd(i,k)
-             dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k) 
-             dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
-          ENDDO
-       ENDDO
-
-       IF (iflag_wake==2) THEN
-          ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
-          DO k = 1,klev
-             dt_dwn(:,k)= dt_dwn(:,k)+ &
-                  ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime
-             dq_dwn(:,k)= dq_dwn(:,k)+ &
-                  ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime
-          ENDDO
-       ELSEIF (iflag_wake==3) THEN
-          ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
-          DO k = 1,klev
+       !
+       ! Call wakes every "wkpas" step
+       !
+       IF (MOD(itapwk,wkpas).EQ.0) THEN
+          !
+          DO k=1,klev
              DO i=1,klon
-                IF (rneb(i,k)==0.) THEN
-                   ! On ne tient compte des tendances qu'en dehors des
-                   ! nuages (c'est-\`a-dire a priri dans une region ou
-                   ! l'eau se reevapore).
-                   dt_dwn(i,k)= dt_dwn(i,k)+ &
-                        ok_wk_lsp(i)*d_t_lsc(i,k)/dtime
-                   dq_dwn(i,k)= dq_dwn(i,k)+ &
-                        ok_wk_lsp(i)*d_q_lsc(i,k)/dtime
-                ENDIF
+                dt_dwn(i,k)  = ftd(i,k) 
+                dq_dwn(i,k)  = fqd(i,k) 
+                M_dwn(i,k)   = dnwd0(i,k)
+                M_up(i,k)    = upwd(i,k)
+                dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k) 
+                dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
              ENDDO
           ENDDO
-       ENDIF
-
-       !
-       !calcul caracteristiques de la poche froide
-       CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
-            t_seri, q_seri, omega,  &
-            dt_dwn, dq_dwn, M_dwn, M_up,  &
-            dt_a, dq_a,  &
-            sigd,  &
-            wake_deltat, wake_deltaq, wake_s, wake_dens,  &
-            wake_dth, wake_h,  &
-            wake_pe, wake_fip, wake_gfl,  &
-            d_t_wake, d_q_wake,  &
-            wake_k, t_x, q_x,  &
-            wake_omgbdth, wake_dp_omgb,  &
-            wake_dtKE, wake_dqKE,  &
-            wake_omg, wake_dp_deltomg,  &
-            wake_spread, wake_Cstar, d_deltat_wk_gw,  &
-            d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_wk)
-         !
-       ENDIF  ! (mod(itapcv,cvpas) .EQ. 1)
+         
+          IF (iflag_wake==2) THEN
+             ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
+             DO k = 1,klev
+                dt_dwn(:,k)= dt_dwn(:,k)+ &
+                     ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime
+                dq_dwn(:,k)= dq_dwn(:,k)+ &
+                     ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime
+             ENDDO
+          ELSEIF (iflag_wake==3) THEN
+             ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
+             DO k = 1,klev
+                DO i=1,klon
+                   IF (rneb(i,k)==0.) THEN
+                      ! On ne tient compte des tendances qu'en dehors des
+                      ! nuages (c'est-\`a-dire a priri dans une region ou
+                      ! l'eau se reevapore).
+                      dt_dwn(i,k)= dt_dwn(i,k)+ &
+                           ok_wk_lsp(i)*d_t_lsc(i,k)/dtime
+                      dq_dwn(i,k)= dq_dwn(i,k)+ &
+                           ok_wk_lsp(i)*d_q_lsc(i,k)/dtime
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+         
+          !
+          !calcul caracteristiques de la poche froide
+          CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
+               t_seri, q_seri, omega,  &
+               dt_dwn, dq_dwn, M_dwn, M_up,  &
+               dt_a, dq_a,  &
+               sigd,  &
+               wake_deltat, wake_deltaq, wake_s, wake_dens,  &
+               wake_dth, wake_h,  &
+               wake_pe, wake_fip, wake_gfl,  &
+               d_t_wake, d_q_wake,  &
+               wake_k, t_x, q_x,  &
+               wake_omgbdth, wake_dp_omgb,  &
+               wake_dtKE, wake_dqKE,  &
+               wake_omg, wake_dp_deltomg,  &
+               wake_spread, wake_Cstar, d_deltat_wk_gw,  &
+               d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_wk)
+          !
+          !jyg    Reinitialize itapwk when wakes have been called
+          itapwk = 0
+       ENDIF !  (MOD(itapwk,wkpas).EQ.0)
+       !
+       itapwk = itapwk+1
        !
        !-----------------------------------------------------------------------
@@ -2705 +2729 @@
        !------------------------------------------------------------------------
 
-!       Increment Wake state variables
+       ! Increment Wake state variables
        IF (iflag_wake_tend .GT. 0.) THEN