Changeset 1999 for LMDZ5/branches/testing/libf/phy1d/lmdz1d.F

Timestamp:

Mar 20, 2014, 10:57:19 AM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r1920:1997 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phy1d/lmdz1d.F (modified) (14 diffs)

LMDZ5/branches/testing/libf/phy1d/lmdz1d.F

@@ -81 +81 @@
       integer :: an
  
-!
-      real :: paire    = 1.     ! aire de la maille
-!**      common /flux_arp/fsens,flat,ok_flux_surf
-
 !---------------------------------------------------------------------
 !  Declarations related to forcing and initial profiles 
@@ -90 +86 @@
 
         integer :: kmax = llm
-        integer nlev_max,llm700
-        parameter (nlev_max = 1000)
-        real timestep, frac, timeit
+        integer llm700,nq1,nq2
+        INTEGER, PARAMETER :: nlev_max=1000, nqmx=1000
+        real timestep, frac
         real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max),
      .              uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),
      .              ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),
      .              dqtdxls(nlev_max),dqtdyls(nlev_max),
-     .              dqtdtls(nlev_max),thlpcar(nlev_max)
-
-        real    :: fff
+     .              dqtdtls(nlev_max),thlpcar(nlev_max),
+     .              qprof(nlev_max,nqmx)
+
 c        integer :: forcing_type
         logical :: forcing_les     = .false.
@@ -143 +139 @@
 !---------------------------------------------------------------------
 
-      integer :: iq
       real :: phi(llm)
       real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
@@ -151 +146 @@
       real :: sfdt, cfdt
       real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
-      real :: du_dyn(llm),dv_dyn(llm),dt_dyn(llm)
-      real :: dt_cooling(llm),d_t_cool(llm),d_th_adv(llm)
-      real :: dq_cooling(llm),d_q_cool(llm)
-      real :: tmpvar(llm)
+      real :: dt_dyn(llm)
+      real :: dt_cooling(llm),d_th_adv(llm)
       real :: alpha
+      real :: ttt
 
       REAL, ALLOCATABLE, DIMENSION(:,:):: q
@@ -161 +155 @@
       REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
       REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
+!     REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
 
 !---------------------------------------------------------------------
@@ -204 +199 @@
 !  Fichiers et d'autres variables
 !---------------------------------------------------------------------
-      real ttt,bow,q1
-      integer :: ierr,k,l,i,it=1,mxcalc
+      integer :: k,l,i,it=1,mxcalc
       integer jjmp1
       parameter (jjmp1=jjm+1-1/jjm)
@@ -230 +224 @@
 !---------------------------------------------------------------------
 cAl1
-        call conf_unicol(99)
+        call conf_unicol
 cAl1 moves this gcssold var from common fcg_gcssold to 
         Turb_fcg_gcssold = xTurb_fcg_gcssold
@@ -357 +351 @@
 c      Le numero du jour est dans "day". L heure est traitee separement.
 c      La date complete est dans "daytime" (l'unite est le jour).
-      fnday=nday
+      if (nday>0) then
+         fnday=nday
+      else
+         fnday=-nday/float(day_step)
+      endif
+
 c Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
       IF(forcing_type .EQ. 61) fnday=53100./86400.
@@ -369 +368 @@
       itau_phy = 0
       call ymds2ju(annee_ref,mois,day_ref,heure,day)
-      day_ini = day
-      day_end = day_ini + nday
+      day_ini = int(day)
+      day_end = day_ini + fnday
 
       IF (forcing_type .eq.2) THEN
@@ -422 +421 @@
       call infotrac_init 
 
+      if (nqtot>nqmx) STOP'Augmenter nqmx dans lmdz1d.F'
       allocate(q(llm,nqtot)) ; q(:,:)=0.
       allocate(dq(llm,nqtot)) 
       allocate(dq_dyn(llm,nqtot)) 
       allocate(d_q_adv(llm,nqtot)) 
+!     allocate(d_th_adv(llm)) 
 
 c
@@ -463 +464 @@
 !! mpl et jyg le 22/08/2012 : 
 !!  pour que les cas a flux de surface imposes marchent
-      IF(.NOT.ok_flux_surf) THEN
+      IF(.NOT.ok_flux_surf.or.max(abs(wtsurf),abs(wqsurf))>0.) THEN
        fsens=-wtsurf*rcpd*rho(1)
        flat=-wqsurf*rlvtt*rho(1)
        print *,'Flux: ok_flux wtsurf wqsurf',ok_flux_surf,wtsurf,wqsurf
       ENDIF
+      print*,'Flux sol ',fsens,flat
 !!      ok_flux_surf=.false.
 !!      fsens=-wtsurf*rcpd*rho(1)
@@ -851 +853 @@
 !
         du_age(1:mxcalc)= -2.*sfdt/timestep*
-     :          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -
-     :           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+     s          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -
+     s           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
 !!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
 !
        dv_age(1:mxcalc)= -2.*sfdt/timestep*
-     :          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +
-     :           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+     s          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +
+     s           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
 !!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
 !
@@ -870 +872 @@
 !! Increment state variables
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
+! au dessus de 700hpa, on relaxe vers les profils initiaux
+      if (forcing_sandu .OR. forcing_astex) then
+#include "1D_nudge_sandu_astex.h"
+      else
         u(1:mxcalc)=u(1:mxcalc) + timestep*(
-     :              du_phys(1:mxcalc)
-     :             +du_age(1:mxcalc) )            
+     s              du_phys(1:mxcalc)
+     s             +du_age(1:mxcalc) )            
         v(1:mxcalc)=v(1:mxcalc) + timestep*(
-     :               dv_phys(1:mxcalc)
-     :             +dv_age(1:mxcalc) )
+     s              dv_phys(1:mxcalc)
+     s             +dv_age(1:mxcalc) )
         q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(
-     :                dq(1:mxcalc,:)
-     :               +d_q_adv(1:mxcalc,:) )
+     s                dq(1:mxcalc,:)
+     s               +d_q_adv(1:mxcalc,:) )
 
         if (prt_level.ge.1) then
@@ -893 +900 @@
      .             +d_th_adv(1:mxcalc)
      .             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+      endif  ! forcing_sandu or forcing_astex
 
         teta=temp*(pzero/play)**rkappa