Changeset 108 for trunk/libf/dyn3d/inidissip.F

Timestamp:

Apr 12, 2011, 11:16:02 AM (14 years ago)

Author:

slebonnois

Message:

Sebastien Lebonnois: sponge layer et dissip horizontale.

File:

• trunk/libf/dyn3d/inidissip.F (modified) (2 diffs)

trunk/libf/dyn3d/inidissip.F

@@ -31 +31 @@
       INTEGER l,ij,idum,ii
       REAL tetamin
-      REAL pseudoz
+      REAL Pup
 
       REAL ran1
@@ -177 +177 @@
 c   --------------------------------------------------
 
-      if (ok_strato .and. llm==39) then
-         do l=1,llm
-            pseudoz=8.*log(preff/presnivs(l))
-            zvert(l)=1+
-     s      (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2.
-     s      *(dissip_factz-1.)
-         enddo 
-      else
-         DO l=1,llm
-            zvert(l)=1.
-         ENDDO
-         fact=2.
-         DO l = 1, llm
-            zz      = 1. - preff/presnivs(l)
-            zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
-         ENDDO
+c First step: going from 1 to dissip_fac_mid (in gcm.def)
+c============
+      DO l=1,llm
+         zz      = 1. - preff/presnivs(l)
+         zvert(l)= dissip_fac_mid -( dissip_fac_mid-1.)/( 1.+zz*zz )
+      ENDDO
+
+         write(*,*) 'Dissipation : '
+         write(*,*) 'Multiplication de la dissipation en altitude :',
+         write(*,*) '  dissip_fac_mid =', dissip_fac_mid
+
+c Second step if ok_strato:  from dissip_fac_mid to dissip_fac_up (in gcm.def)
+c==========================
+c Utilisation de la fonction tangente hyperbolique pour augmenter
+c arbitrairement la dissipation et donc la stabilite du modele a 
+c partir d'une certaine altitude.
+
+c   Le facteur multiplicatif de basse atmosphere etant deja pris 
+c   en compte, il faut diviser le facteur multiplicatif de haute 
+c   atmosphere par celui-ci.
+
+      if (ok_strato) then
+
+       Pup = dissip_pupstart*exp(-0.5*dissip_deltaz/dissip_hdelta)
+       do l=1,llm
+         zvert(l)= zvert(l)*(1.0+( (dissip_fac_up/dissip_fac_mid-1)
+     &   *(1-(0.5*(1+tanh(-6./dissip_deltaz*
+     &    (-dissip_hdelta*log(presnivs(l)/Pup))  ))))  ))
+       enddo 
+
+         write(*,*) '  dissip_fac_up =', dissip_fac_up
+         write(*,*) 'Transition mid /up:  Pupstart,delta =',
+     &             dissip_pupstart,'Pa', dissip_deltaz , '(km)'
+
       endif