Changeset 2187 for LMDZ5/branches/testing/libf/phylmd/1DUTILS.h

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/1DUTILS.h (modified) (2 diffs)

LMDZ5/branches/testing/libf/phylmd/1DUTILS.h

@@ -133 +133 @@
         ENDIF
 
+!Config  Key  = iflag_nudge
+!Config  Desc = atmospheric nudging ttype (decimal code)
+!Config  Def  = 0
+!Config  Help = 0 ==> no nudging
+!  If digit number n of iflag_nudge is set, then nudging of type n is on
+!  If digit number n of iflag_nudge is not set, then nudging of type n is off
+!   (digits are numbered from the right)
+       iflag_nudge = 0
+       CALL getin('iflag_nudge',iflag_nudge)
+
 !Config  Key  = ok_flux_surf
 !Config  Desc = forcage ou non par les flux de surface
@@ -3980 +3990 @@
 !=====================================================================
 
+!  Subroutines for nudging
+
+      Subroutine Nudge_RHT_init (paprs,pplay,t,q,t_targ,rh_targ)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL t(klon,klev)
+      REAL q(klon,klev)
+!
+!   Profiles cible
+      REAL t_targ(klon,klev)
+      REAL rh_targ(klon,klev)
+!
+   INTEGER k,i
+   REAL zx_qs
+
+! Declaration des constantes et des fonctions thermodynamiques
+!
+include "YOMCST.h"
+include "YOETHF.h"
+!
+!  ----------------------------------------
+!  Statement functions
+include "FCTTRE.h"
+!  ----------------------------------------
+!
+        DO k = 1,klev
+         DO i = 1,klon
+           t_targ(i,k) = t(i,k)
+           IF (t(i,k).LT.RTT) THEN
+              zx_qs = qsats(t(i,k))/(pplay(i,k))
+           ELSE
+              zx_qs = qsatl(t(i,k))/(pplay(i,k))
+           ENDIF
+           rh_targ(i,k) = q(i,k)/zx_qs
+         ENDDO
+        ENDDO
+      print *, 't_targ',t_targ
+      print *, 'rh_targ',rh_targ
+!
+!
+      RETURN
+      END
+
+      Subroutine Nudge_UV_init (paprs,pplay,u,v,u_targ,v_targ)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+!
+!   Profiles cible
+      REAL u_targ(klon,klev)
+      REAL v_targ(klon,klev)
+!
+   INTEGER k,i
+!
+        DO k = 1,klev
+         DO i = 1,klon
+           u_targ(i,k) = u(i,k)
+           v_targ(i,k) = v(i,k)
+         ENDDO
+        ENDDO
+      print *, 'u_targ',u_targ
+      print *, 'v_targ',v_targ
+!
+!
+      RETURN
+      END
+
+      Subroutine Nudge_RHT (dtime,paprs,pplay,t_targ,rh_targ,t,q,          &
+     &                      d_t,d_q)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL dtime
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL t(klon,klev)
+      REAL q(klon,klev)
+!
+! Tendances
+      REAL d_t(klon,klev)
+      REAL d_q(klon,klev)
+!
+!   Profiles cible
+      REAL t_targ(klon,klev)
+      REAL rh_targ(klon,klev)
+!
+!   Temps de relaxation
+      REAL tau
+!c      DATA tau /3600./
+!!      DATA tau /5400./
+      DATA tau /1800./
+!
+   INTEGER k,i
+   REAL zx_qs, rh, tnew, d_rh
+
+! Declaration des constantes et des fonctions thermodynamiques
+!
+include "YOMCST.h"
+include "YOETHF.h"
+!
+!  ----------------------------------------
+!  Statement functions
+include "FCTTRE.h"
+!  ----------------------------------------
+!
+        print *,'dtime, tau ',dtime,tau
+        print *, 't_targ',t_targ
+        print *, 'rh_targ',rh_targ
+        print *,'temp ',t
+        print *,'hum ',q
+        DO k = 1,klev
+         DO i = 1,klon
+!!           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
+            IF (t(i,k).LT.RTT) THEN
+               zx_qs = qsats(t(i,k))/(pplay(i,k))
+            ELSE
+               zx_qs = qsatl(t(i,k))/(pplay(i,k))
+            ENDIF
+            rh = q(i,k)/zx_qs
+!
+            d_t(i,k) = d_t(i,k) + 1./tau*(t_targ(i,k)-t(i,k))
+            d_rh = 1./tau*(rh_targ(i,k)-rh)
+!
+            tnew = t(i,k)+d_t(i,k)
+            IF (tnew.LT.RTT) THEN
+               zx_qs = qsats(tnew)/(pplay(i,k))
+            ELSE
+               zx_qs = qsatl(tnew)/(pplay(i,k))
+            ENDIF
+            d_q(i,k) = d_q(i,k) + d_rh*zx_qs
+!
+            print *,' k,d_t,rh,d_rh,d_q ',    &
+                      k,d_t(i,k),rh,d_rh,d_q(i,k)
+!!           ENDIF
+!
+         ENDDO
+        ENDDO
+!
+      RETURN
+      END
+
+      Subroutine Nudge_UV (dtime,paprs,pplay,u_targ,v_targ,u,v,          &
+     &                      d_u,d_v)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL dtime
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+!
+! Tendances
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+!
+!   Profiles cible
+      REAL u_targ(klon,klev)
+      REAL v_targ(klon,klev)
+!
+!   Temps de relaxation
+      REAL tau
+!c      DATA tau /3600./
+      DATA tau /5400./
+!
+   INTEGER k,i
+
+!
+        print *,'dtime, tau ',dtime,tau
+        print *, 'u_targ',u_targ
+        print *, 'v_targ',v_targ
+        print *,'zonal velocity ',u
+        print *,'meridional velocity ',v
+        DO k = 1,klev
+         DO i = 1,klon
+           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
+!
+            d_u(i,k) = d_u(i,k) + 1./tau*(u_targ(i,k)-u(i,k))
+            d_v(i,k) = d_v(i,k) + 1./tau*(v_targ(i,k)-v(i,k))
+!
+            print *,' k,u,d_u,v,d_v ',    &
+                      k,u(i,k),d_u(i,k),v(i,k),d_v(i,k)
+           ENDIF
+!
+         ENDDO
+        ENDDO
+!
+      RETURN
+      END
+