Changeset 878 for LMDZ4/trunk/libf/phylmd/phyredem.F

Timestamp:

Jan 14, 2008, 1:03:39 PM (16 years ago)

Author:

Laurent Fairhead

Message:

Bascule de la physique du LMD vers la physique avec thermiques
LF

File:

• LMDZ4/trunk/libf/phylmd/phyredem.F (modified) (6 diffs)

LMDZ4/trunk/libf/phylmd/phyredem.F

@@ -9 +9 @@
      .           radsol_p,zmea_p,zstd_p,zsig_p,
      .           zgam_p,zthe_p,zpic_p,zval_p,rugsrel_p,
-     .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p)
+     .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p,
+     .           pbl_tke_p)
 
       USE dimphy
@@ -29 +30 @@
 #include "control.h"
 #include "temps.h"
+#include "thermcell.h"
+#include "compbl.h"
 c======================================================================
       CHARACTER*(*) fichnom
@@ -35 +38 @@
       REAL rlat_p(klon), rlon_p(klon)
       REAL tsol_p(klon,nbsrf)
+      REAL pbl_tke_p(klon,klev,nbsrf)
       REAL tsoil_p(klon,nsoilmx,nbsrf)
       CHARACTER*6 ocean
@@ -70 +74 @@
       REAL rlat(klon_glo), rlon(klon_glo)
       REAL tsol(klon_glo,nbsrf)
+      REAL pbl_tke(klon_glo,klev,nbsrf)
       REAL tsoil(klon_glo,nsoilmx,nbsrf)
       REAL tslab(klon_glo), seaice(klon_glo)
@@ -135 +140 @@
       call Gather( rlon_p,rlon)
       call Gather( tsol_p,tsol)
+      call Gather( pbl_tke_p,pbl_tke)
       call Gather( tsoil_p,tsoil)
       call Gather( tslab_p,tslab)
@@ -899 +905 @@
 c
 c
+!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
+c
+      IF (iflag_pbl>1) then
+      DO nsrf = 1, nbsrf
+        IF (nsrf.LE.99) THEN
+            WRITE(str2,'(i2.2)') nsrf
+            ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+            ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_DOUBLE,1,idim3
+     $          ,nvarid)
+#else
+            ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_FLOAT,1,idim3
+     $          ,nvarid)
+#endif
+            ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
+     .                        "Energ. Cineti. Turb."//str2)
+            ierr = NF_ENDDEF(nid)
+        ELSE
+            PRINT*, "Trop de sous-mailles"
+            CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pbl_tke(:,:,nsrf))
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pbl_tke(:,:,nsrf))
+#endif
+      ENDDO
+      ENDIF
+
+!!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
+c
       ierr = NF_CLOSE(nid)
 c