Changeset 2187 for LMDZ5/branches/testing/libf/phylmd/lmdz1d.F90

Timestamp:

Jan 30, 2015, 2:57:13 PM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes -r2158:2186 into testing branch.

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/lmdz1d.F90 (modified) (10 diffs)

LMDZ5/branches/testing/libf/phylmd/lmdz1d.F90

@@ -138 +138 @@
 !
 !---------------------------------------------------------------------
+!  Declarations related to nudging
+!---------------------------------------------------------------------
+     integer :: nudge_max
+     parameter (nudge_max=9)
+     integer :: inudge_RHT=1
+     integer :: inudge_UV=2
+     logical :: nudge(nudge_max)
+     real :: t_targ(llm)
+     real :: rh_targ(llm)
+     real :: u_targ(llm)
+     real :: v_targ(llm)
+!
+!---------------------------------------------------------------------
 !  Declarations related to vertical discretization:
 !---------------------------------------------------------------------
@@ -156 +169 @@
       real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
       real :: dt_dyn(llm)
-      real :: dt_cooling(llm),d_th_adv(llm)
+      real :: dt_cooling(llm),d_th_adv(llm),d_t_nudge(llm)
+      real :: d_u_nudge(llm),d_v_nudge(llm)
       real :: alpha
       real :: ttt
@@ -164 +178 @@
       REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
       REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
-!     REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
+!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
 
 !---------------------------------------------------------------------
@@ -211 +226 @@
 !---------------------------------------------------------------------
       integer :: k,l,i,it=1,mxcalc
+      integer jcode
       integer jjmp1
       parameter (jjmp1=jjm+1-1/jjm)
@@ -330 +346 @@
         if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
      &    type_ts_forcing = 1
-
+!
+! Initialization of the logical switch for nudging
+     jcode = iflag_nudge
+     do i = 1,nudge_max
+       nudge(i) = mod(jcode,10) .ge. 1
+       jcode = jcode/10
+     enddo
 !---------------------------------------------------------------------
 !  Definition of the run
@@ -444 +466 @@
       allocate(dq_dyn(llm,nqtot)) 
       allocate(d_q_adv(llm,nqtot)) 
-!     allocate(d_th_adv(llm)) 
+      allocate(d_q_nudge(llm,nqtot)) 
+!      allocate(d_th_adv(llm)) 
 
 !
@@ -751 +774 @@
          open(97,file='div_slab.dat',STATUS='OLD')
        endif
+!
+!---------------------------------------------------------------------
+!    Initialize target profile for RHT nudging if needed
+!---------------------------------------------------------------------
+      if (nudge(inudge_RHT)) then
+        call nudge_RHT_init(plev,play,temp,q(:,1),t_targ,rh_targ)
+      endif
+      if (nudge(inudge_UV)) then
+        call nudge_UV_init(plev,play,u,v,u_targ,v_targ)
+      endif
+!
 !=====================================================================
 ! START OF THE TEMPORAL LOOP :
@@ -876 +910 @@
 !!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
 !
+!!!!!!!!!!!!!!!!!!!!!!!!
+!  Nudging
+!!!!!!!!!!!!!!!!!!!!!!!!
+      d_t_nudge(:) = 0.
+      d_q_nudge(:,:) = 0.
+      d_u_nudge(:) = 0.
+      d_v_nudge(:) = 0.
+      if (nudge(inudge_RHT)) then
+        call nudge_RHT(timestep,plev,play,t_targ,rh_targ,temp,q(:,1),     &
+    &                  d_t_nudge,d_q_nudge(:,1))
+      endif
+      if (nudge(inudge_UV)) then
+        call nudge_UV(timestep,plev,play,u_targ,v_targ,u,v,     &
+    &                  d_u_nudge,d_v_nudge)
+      endif
+!
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !         call  writefield_phy('dv_age' ,dv_age,llm)
@@ -893 +943 @@
         u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
      &              du_phys(1:mxcalc)                                       &
-     &             +du_age(1:mxcalc) )            
+     &             +du_age(1:mxcalc)                                        &
+     &             +d_u_nudge(1:mxcalc) )            
         v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
      &              dv_phys(1:mxcalc)                                       &
-     &             +dv_age(1:mxcalc) )
+     &             +dv_age(1:mxcalc)                                        &
+     &             +d_v_nudge(1:mxcalc) )
         q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
      &                dq(1:mxcalc,:)                                        &
-     &               +d_q_adv(1:mxcalc,:) )
+     &               +d_q_adv(1:mxcalc,:)                                   &
+     &               +d_q_nudge(1:mxcalc,:) )
 
         if (prt_level.ge.1) then
@@ -913 +966 @@
      &              dt_phys(1:mxcalc)                                       &
      &             +d_th_adv(1:mxcalc)                                      &
+     &             +d_t_nudge(1:mxcalc)                                      &
      &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.